From 9785356413162730899028bbb6cd77db38a9fb17 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Thu, 7 Sep 2017 12:06:21 +0200 Subject: [PATCH 001/692] Make sure all actions on open list are locked As discussed: https://irclog.perlgeek.de/perl6-dev/2017-09-07#i_15129408 --- src/core/IO/Handle.pm | 50 ++++++++++++++++++++++++++----------------- 1 file changed, 30 insertions(+), 20 deletions(-) diff --git a/src/core/IO/Handle.pm b/src/core/IO/Handle.pm index ab06599b08f..cee1316f06b 100644 --- a/src/core/IO/Handle.pm +++ b/src/core/IO/Handle.pm @@ -21,8 +21,28 @@ my class IO::Handle { # Make sure we close any open files on exit my $opened := nqp::list; - my $opened-sizer = Lock.new; - END { + my $opened-locker = Lock.new; + method !remember-to-close(--> Nil) { + $opened-locker.protect: { + nqp::stmts( + nqp::if( + nqp::isge_i( + (my int $fileno = nqp::filenofh($!PIO)), + (my int $elems = nqp::elems($opened)) + ), + nqp::setelems($opened,nqp::add_i($elems,1024)) + ), + nqp::bindpos($opened,$fileno,$!PIO) + ) + } + } + method !forget-about-closing(int $fileno --> Nil) { + $opened-locker.protect: { + nqp::bindpos($opened,$fileno,nqp::null) + } + } + + END { # assuming this is the very last END block to be run my int $i = 2; my int $elems = nqp::elems($opened); nqp::while( @@ -180,19 +200,7 @@ my class IO::Handle { ) ), ); - nqp::if( - nqp::isge_i( - (my int $fileno = nqp::filenofh($!PIO)), - nqp::elems($opened) - ), - $opened-sizer.protect( { - nqp::if( - nqp::isge_i($fileno,(my int $elems = nqp::elems($opened))), - nqp::setelems($opened,nqp::add_i($elems,1024)) - ) - }) - ); - nqp::bindpos($opened,nqp::filenofh($!PIO),$!PIO); + self!remember-to-close; } $!chomp = $chomp; @@ -235,7 +243,8 @@ my class IO::Handle { nqp::stmts( (my int $fileno = nqp::filenofh($!PIO)), nqp::closefh($!PIO), # TODO: catch errors - nqp::bindpos($opened,$fileno,$!PIO := nqp::null) + $!PIO := nqp::null; + self!forget-about-closing($fileno) ) ) } @@ -586,10 +595,10 @@ my class IO::Handle { method lock(IO::Handle:D: Bool:D :$non-blocking = False, Bool:D :$shared = False --> True ) { - nqp::bindpos($opened,nqp::filenofh($!PIO),nqp::null); + self!forget-about-closing(nqp::filenofh($!PIO)); nqp::lockfh($!PIO, 0x10*$non-blocking + $shared); CATCH { default { - nqp::bindpos($opened,nqp::filenofh($!PIO),$!PIO); + self!remember-to-close; fail X::IO::Lock.new: :os-error(.Str), :lock-type( 'non-' x $non-blocking ~ 'blocking, ' ~ ($shared ?? 'shared' !! 'exclusive') ); @@ -597,7 +606,7 @@ my class IO::Handle { } method unlock(IO::Handle:D: --> True) { - nqp::bindpos($opened,nqp::filenofh($!PIO),$!PIO); + self!remember-to-close; nqp::unlockfh($!PIO); } @@ -782,7 +791,8 @@ my class IO::Handle { && nqp::isgt_i((my int $fileno = nqp::filenofh($!PIO)), 2), nqp::stmts( nqp::closefh($!PIO), # don't bother checking for errors - nqp::bindpos($opened,$fileno,$!PIO := nqp::null) + $!PIO := nqp::null; + self!forget-about-closing($fileno) ) ) } From dfbd39b829fb5efc3f43af489513a778779f8d1d Mon Sep 17 00:00:00 2001 From: "Philippe Bruhat (BooK)" Date: Thu, 7 Sep 2017 21:03:40 +0200 Subject: [PATCH 002/692] Fix typo: s/admissable/admissible --- src/Perl6/Metamodel/BOOTSTRAP.nqp | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/Perl6/Metamodel/BOOTSTRAP.nqp b/src/Perl6/Metamodel/BOOTSTRAP.nqp index 917836b69a2..b6e839057ca 100644 --- a/src/Perl6/Metamodel/BOOTSTRAP.nqp +++ b/src/Perl6/Metamodel/BOOTSTRAP.nqp @@ -2234,10 +2234,10 @@ BEGIN { $cur_candidate := nqp::atpos(@candidates, $cur_idx); if nqp::isconcrete($cur_candidate) { - # Check if it's admissable by arity. + # Check if it's admissible by arity. unless $num_args < nqp::atkey($cur_candidate, 'min_arity') || $num_args > nqp::atkey($cur_candidate, 'max_arity') { - # Arity OK; now check if it's admissable by type. + # Arity OK; now check if it's admissible by type. $type_check_count := nqp::atkey($cur_candidate, 'num_types') > $num_args ?? $num_args !! nqp::atkey($cur_candidate, 'num_types'); @@ -2318,7 +2318,7 @@ BEGIN { } unless $type_mismatch || $rwness_mismatch { - # It's an admissable candidate; add to list. + # It's an admissible candidate; add to list. nqp::push(@possibles, $cur_candidate); } } @@ -2619,7 +2619,7 @@ BEGIN { } } - # Check if it's admissable by arity. + # Check if it's admissible by arity. if $num_args < nqp::atkey($cur_candidate, 'min_arity') || $num_args > nqp::atkey($cur_candidate, 'max_arity') { $cur_idx++; @@ -2629,7 +2629,7 @@ BEGIN { # If we got this far, something at least matched on arity. $arity_possible := 1; - # Check if it's admissable by type. + # Check if it's admissible by type. $type_check_count := nqp::atkey($cur_candidate, 'num_types') > $num_args ?? $num_args !! nqp::atkey($cur_candidate, 'num_types'); From 1adacc72cb7b123b716e89f6eb2c9fecc615a756 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Thu, 7 Sep 2017 21:11:58 +0200 Subject: [PATCH 003/692] Streamline exit / END phaser handling - falling off the end of a program / exit now share END phaser handling - the first value given to exit() is what will be returned to the OS - END blocks can also execute exit(), so we could nest - only *one* thread will execute the END phasers on first come/served basis - before, multiple threads could be doing this --- src/core/Exception.pm | 2 +- src/core/Rakudo/Internals.pm | 40 ++++++++++++++++++++++++------------ src/main.nqp | 10 +++------ 3 files changed, 31 insertions(+), 21 deletions(-) diff --git a/src/core/Exception.pm b/src/core/Exception.pm index 4a9d4895992..a2e59a0bedb 100644 --- a/src/core/Exception.pm +++ b/src/core/Exception.pm @@ -388,7 +388,7 @@ do { $err.say("===SORRY!==="); $err.say($e.Str); } - Rakudo::Internals.THE_END(); + nqp::getcurhllsym('&THE_END')(); CONTROL { when CX::Warn { .resume } } } if $! { diff --git a/src/core/Rakudo/Internals.pm b/src/core/Rakudo/Internals.pm index d6911d22f70..01e1c8b63a4 100644 --- a/src/core/Rakudo/Internals.pm +++ b/src/core/Rakudo/Internals.pm @@ -128,12 +128,6 @@ my class Rakudo::Internals { 0; } - method THE_END { - my @END := nqp::p6bindattrinvres(nqp::create(List), List, '$!reified', - nqp::getcurhllsym("@END_PHASERS")); - for @END -> $end { $end() }; - } - method createENV(int $bind) { nqp::stmts( (my $hash := nqp::hash), @@ -1530,17 +1524,37 @@ my class Rakudo::Internals { # expose the number of bits a native int has my constant $?BITS = nqp::isgt_i(nqp::add_i(2147483648, 1), 0) ?? 64 !! 32; +{ # setting up END phaser handling + my int $the-end-is-done; + my $the-end-locker = Lock.new; + # END handling, returns trueish if END handling already done/in progress + nqp::bindcurhllsym('&THE_END', { + unless $the-end-is-done { + $the-end-locker.protect: { + unless $the-end-is-done { + my $comp := nqp::getcomp('perl6'); + my $end := nqp::getcurhllsym('@END_PHASERS'); + while nqp::elems($end) { + my $result := nqp::shift($end)(); + $result.sink if nqp::can($result,'sink'); + CATCH { $comp.handle-exception($_) } + CONTROL { $comp.handle-control($_) } + } + nqp::not_i(($the-end-is-done = 1)); + } + } + } + } ); +} + # we need this to run *after* the mainline of Rakudo::Internals has run Rakudo::Internals.REGISTER-DYNAMIC: '&*EXIT', { PROCESS::<&EXIT> := sub exit($status) { - state $exit; - $exit = $status; + state $exit = $status; # first call to exit sets value - once { - Rakudo::Internals.THE_END(); - nqp::exit(nqp::unbox_i($exit.Int)); - } - $exit; + nqp::getcurhllsym('&THE_END')() + ?? $exit + !! nqp::exit(nqp::unbox_i($exit.Int)) } } diff --git a/src/main.nqp b/src/main.nqp index 069bb09af0f..9244234f1c1 100644 --- a/src/main.nqp +++ b/src/main.nqp @@ -43,12 +43,8 @@ sub MAIN(@ARGS) { # Enter the compiler. $comp.command_line(@ARGS, :encoding('utf8'), :transcode('ascii iso-8859-1')); - # Run any END blocks before exiting. - my @END := nqp::gethllsym('perl6', '@END_PHASERS'); - while +@END { - my $result := (@END.shift)(); - nqp::can($result, 'sink') && $result.sink(); - CATCH { $comp.handle-exception($_); } - CONTROL { $comp.handle-control($_); } + # do all the necessary actions at the end, if any + if nqp::gethllsym('perl6', '&THE_END') -> $THE_END { + $THE_END() } } From 347da8e5b1f1a72fa6ef7d11896e3be1c1027df7 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Thu, 7 Sep 2017 22:44:18 +0200 Subject: [PATCH 004/692] Don't use an END block to close all open files - END blocks can be added/removed at runtime, technically - turn END block into a private method close-all-open-handles - call this private method *after* having run all END blocks --- src/core/IO/Handle.pm | 3 +-- src/core/Rakudo/Internals.pm | 11 +++++++++-- 2 files changed, 10 insertions(+), 4 deletions(-) diff --git a/src/core/IO/Handle.pm b/src/core/IO/Handle.pm index cee1316f06b..cf9d5c591e9 100644 --- a/src/core/IO/Handle.pm +++ b/src/core/IO/Handle.pm @@ -41,8 +41,7 @@ my class IO::Handle { nqp::bindpos($opened,$fileno,nqp::null) } } - - END { # assuming this is the very last END block to be run + method !close-all-open-handles() { my int $i = 2; my int $elems = nqp::elems($opened); nqp::while( diff --git a/src/core/Rakudo/Internals.pm b/src/core/Rakudo/Internals.pm index 01e1c8b63a4..274a6d21dda 100644 --- a/src/core/Rakudo/Internals.pm +++ b/src/core/Rakudo/Internals.pm @@ -1,5 +1,6 @@ my class DateTime { ... } my role IO { ... } +my class IO::Handle { ... } my class IO::Path { ... } my class Rakudo::Metaops { ... } my class X::Cannot::Lazy { ... } @@ -1534,13 +1535,19 @@ my constant $?BITS = nqp::isgt_i(nqp::add_i(2147483648, 1), 0) ?? 64 !! 32; unless $the-end-is-done { my $comp := nqp::getcomp('perl6'); my $end := nqp::getcurhllsym('@END_PHASERS'); - while nqp::elems($end) { + while nqp::elems($end) { # run all END blocks my $result := nqp::shift($end)(); $result.sink if nqp::can($result,'sink'); CATCH { $comp.handle-exception($_) } CONTROL { $comp.handle-control($_) } } - nqp::not_i(($the-end-is-done = 1)); + + # close all open files + IO::Handle.^find_private_method( + 'close-all-open-handles' + )(IO::Handle); + + nqp::not_i(($the-end-is-done = 1)); # we're really done now } } } From e5a600997c30513404775242cf005bf2a26a5177 Mon Sep 17 00:00:00 2001 From: "Will \"Coke\" Coleda" Date: Fri, 8 Sep 2017 08:31:38 -0400 Subject: [PATCH 005/692] Note how to build on windows --- docs/windows.md | 72 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 72 insertions(+) create mode 100644 docs/windows.md diff --git a/docs/windows.md b/docs/windows.md new file mode 100644 index 00000000000..6ffff5f3c6a --- /dev/null +++ b/docs/windows.md @@ -0,0 +1,72 @@ +# Building on windows + +## VM + +Let's assume we're starting out with no hardware: + +Get virtual box for your platform here: + + https://www.virtualbox.org/wiki/Downloads + +Get a windows 10 evaluation copy from here: + + https://developer.microsoft.com/en-us/windows/downloads/virtual-machines + +## Prereqs + +The evaluation copy comes with a copy of Visual Studio. + +### Strawberry Perl + +Install Strawberry Perl from: + + https://strawberryperl.com/ + +### Visual Studio + +Run the VS installer; modify the existing install, and select "Desktop +Development with C++"; This will make the command line tools available +in the "Developer Command Prompt for VS 2017" + +### Git + +Install git from: + + https://git-scm.com/download/win + +## Rakudo + +Clone rakudo; in the VS command prompt: + + C:\Users\user git clone https://github.com/rakudo/rakudo.git + +Configure rakudo: + C:\Users\user cd rakudo + C:\Users\user perl Configure.pl --backends=moar --gen-moar --moar-option="--cc=cl" --moar-option="--ld=link" --moar-option="--make=nmake" + +This will git clone nqp & MoarVM, then build MoarVM, nqp. +To build rakudo itself (and install it into a local ./install directory): + +You might want to "copy config.status config.bat" to save this config, so +you can later run "config" to perform the config step. + +You may wish to use "--gen-moar=master" or "--gen-nqp=master" to get the +latest version of those repositories. + +Build rakudo (for Strawberry/gcc) : + C:\Users\user gmake install + +Build rakudo (for ActiveState/VS) : + C:\Users\user nmake install + +## Test + +Now you can run (using the appropriate make command) the +builtin rakudo tests: + + C:\Users\user nmake test + +Or the spectest suite (note that this will use git to download the +test suite) + + C:\Users\user nmake spectest From fb140b89ac3a5329f2ebc19d5b51cb115c5ee98d Mon Sep 17 00:00:00 2001 From: usev6 Date: Fri, 8 Sep 2017 20:34:36 +0200 Subject: [PATCH 006/692] Make attribute visible for all backends (part of unbusting the jvm build) --- src/core/Kernel.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/Kernel.pm b/src/core/Kernel.pm index 97ce9a7bcb7..f0ef6086bde 100644 --- a/src/core/Kernel.pm +++ b/src/core/Kernel.pm @@ -107,8 +107,8 @@ class Kernel does Systemic { @!signals //= [2, 9] } #?endif -#?if moar has $!signals-setup-lock = Lock.new; +#?if moar has $!signals-setup = False; method signals (Kernel:D:) { unless $!signals-setup { From dd52b07b710f21c9ec814c59f5ec7811c93e1082 Mon Sep 17 00:00:00 2001 From: usev6 Date: Fri, 8 Sep 2017 20:52:35 +0200 Subject: [PATCH 007/692] Use nqp::eqaticim on MoarVM only Fall back to old behaviour (pre 215a5fa731) on other backends. --- src/core/Match.pm | 38 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 38 insertions(+) diff --git a/src/core/Match.pm b/src/core/Match.pm index 19064d943eb..ff6213b1894 100644 --- a/src/core/Match.pm +++ b/src/core/Match.pm @@ -334,6 +334,7 @@ my class Match is Capture is Cool does NQPMatchRole { $match = nqp::eqat($tgt, $topic_str, $pos); } +#?if moar # ignoremark+ignorecase elsif $m && $i { $match = nqp::eqaticim($tgt, $topic_str, $pos); @@ -348,6 +349,43 @@ my class Match is Capture is Cool does NQPMatchRole { elsif $i { $match = nqp::eqatic($tgt, $topic_str, $pos); } +#?endif +#?if !moar + # ignoremark(+ignorecase?) + elsif $m { + my int $k = -1; + + # ignorecase+ignoremark + if $i { + my str $tgt_fc = nqp::fc(nqp::substr($tgt,$pos,$len)); + my str $topic_fc = nqp::fc($topic_str); + Nil while nqp::islt_i(++$k,$len) + && nqp::iseq_i( + nqp::ordbaseat($tgt_fc, nqp::add_i($pos,$k)), + nqp::ordbaseat($topic_fc, $k) + ); + } + + # ignoremark + else { + Nil while nqp::islt_i(++$k, $len) + && nqp::iseq_i( + nqp::ordbaseat($tgt, nqp::add_i($pos,$k)), + nqp::ordbaseat($topic_str, $k) + ); + } + + $match = nqp::iseq_i($k,$len); # match if completed + } + + # ignorecase + else { + $match = nqp::iseq_s( + nqp::fc(nqp::substr($tgt, $pos, $len)), + nqp::fc($topic_str) + ) + } +#?endif if $match && nqp::isgt_i($len,$maxlen) From 591b93eaf8aa9a051a5c8ffd86cfc859942fb63e Mon Sep 17 00:00:00 2001 From: pmurias Date: Fri, 8 Sep 2017 23:09:06 +0200 Subject: [PATCH 008/692] Refactor a regex in a way that avoids a JVM backend bug and is cleaner --- src/Perl6/Grammar.nqp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Perl6/Grammar.nqp b/src/Perl6/Grammar.nqp index ae8e85e798a..f4303361bdf 100644 --- a/src/Perl6/Grammar.nqp +++ b/src/Perl6/Grammar.nqp @@ -253,7 +253,7 @@ role STD { } # core grammar also has a penchant for sending us trailing .ws contents $stopper := $stopper // $goal; - $stopper := $stopper ~~ /(.*.)\s*/; + $stopper := $stopper ~~ /(.*\S)\s*/; $stopper := ~$stopper[0]; self.typed_panic('X::Comp::FailGoal', :$dba, :goal($stopper)); } From dd8d0d89a3f412ef5ad8764c64893f58976891de Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sat, 9 Sep 2017 12:39:10 +0200 Subject: [PATCH 009/692] Make auto-closing files a MoarVM only thing This should help unbusting the JVM, bartolin++ . Can be reverted when someone makes nqp::filenofh give valid values on the JVM. --- src/core/IO/Handle.pm | 16 ++++++++++++++++ src/core/Rakudo/Internals.pm | 4 ++-- 2 files changed, 18 insertions(+), 2 deletions(-) diff --git a/src/core/IO/Handle.pm b/src/core/IO/Handle.pm index cf9d5c591e9..fcefa9a1936 100644 --- a/src/core/IO/Handle.pm +++ b/src/core/IO/Handle.pm @@ -19,6 +19,7 @@ my class IO::Handle { $!encoding = $encoding || 'utf8') } +#?if moar # Make sure we close any open files on exit my $opened := nqp::list; my $opened-locker = Lock.new; @@ -52,6 +53,7 @@ my class IO::Handle { ) ) } +#?endif method open(IO::Handle:D: :$r, :$w, :$x, :$a, :$update, @@ -199,7 +201,9 @@ my class IO::Handle { ) ), ); +#?if moar self!remember-to-close; +#?endif } $!chomp = $chomp; @@ -240,10 +244,14 @@ my class IO::Handle { nqp::if( nqp::defined($!PIO), nqp::stmts( +#?if moar (my int $fileno = nqp::filenofh($!PIO)), +#?endif nqp::closefh($!PIO), # TODO: catch errors $!PIO := nqp::null; +#?if moar self!forget-about-closing($fileno) +#?endif ) ) } @@ -594,10 +602,14 @@ my class IO::Handle { method lock(IO::Handle:D: Bool:D :$non-blocking = False, Bool:D :$shared = False --> True ) { +#?if moar self!forget-about-closing(nqp::filenofh($!PIO)); +#?endif nqp::lockfh($!PIO, 0x10*$non-blocking + $shared); CATCH { default { +#?if moar self!remember-to-close; +#?endif fail X::IO::Lock.new: :os-error(.Str), :lock-type( 'non-' x $non-blocking ~ 'blocking, ' ~ ($shared ?? 'shared' !! 'exclusive') ); @@ -605,7 +617,9 @@ my class IO::Handle { } method unlock(IO::Handle:D: --> True) { +#?if moar self!remember-to-close; +#?endif nqp::unlockfh($!PIO); } @@ -791,7 +805,9 @@ my class IO::Handle { nqp::stmts( nqp::closefh($!PIO), # don't bother checking for errors $!PIO := nqp::null; +#?if moar self!forget-about-closing($fileno) +#?endif ) ) } diff --git a/src/core/Rakudo/Internals.pm b/src/core/Rakudo/Internals.pm index 274a6d21dda..f4cb966009d 100644 --- a/src/core/Rakudo/Internals.pm +++ b/src/core/Rakudo/Internals.pm @@ -1541,12 +1541,12 @@ my constant $?BITS = nqp::isgt_i(nqp::add_i(2147483648, 1), 0) ?? 64 !! 32; CATCH { $comp.handle-exception($_) } CONTROL { $comp.handle-control($_) } } - +#?if moar # close all open files IO::Handle.^find_private_method( 'close-all-open-handles' )(IO::Handle); - +#?endif nqp::not_i(($the-end-is-done = 1)); # we're really done now } } From 16f8419a3e94c1c73908c577bdeb2b89e7a6dd09 Mon Sep 17 00:00:00 2001 From: usev6 Date: Sat, 9 Sep 2017 14:22:01 +0200 Subject: [PATCH 010/692] Avoid trailing semicolon for JVM backend The trailing semicolon in combination with binding nqp::null gave a NullPointerException in infix:<,>. This can be reverted with dd8d0d89a3 when nqp::filenofh give valid values on the JVM. --- src/core/IO/Handle.pm | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/src/core/IO/Handle.pm b/src/core/IO/Handle.pm index fcefa9a1936..d3695b53e5b 100644 --- a/src/core/IO/Handle.pm +++ b/src/core/IO/Handle.pm @@ -244,12 +244,14 @@ my class IO::Handle { nqp::if( nqp::defined($!PIO), nqp::stmts( +#?if !moar + nqp::closefh($!PIO), # TODO: catch errors + $!PIO := nqp::null +#?endif #?if moar (my int $fileno = nqp::filenofh($!PIO)), -#?endif nqp::closefh($!PIO), # TODO: catch errors $!PIO := nqp::null; -#?if moar self!forget-about-closing($fileno) #?endif ) @@ -804,8 +806,11 @@ my class IO::Handle { && nqp::isgt_i((my int $fileno = nqp::filenofh($!PIO)), 2), nqp::stmts( nqp::closefh($!PIO), # don't bother checking for errors - $!PIO := nqp::null; +#?if !moar + $!PIO := nqp::null +#?endif #?if moar + $!PIO := nqp::null; self!forget-about-closing($fileno) #?endif ) From 2762bcc49f2517b9e82e68aafe15ac36950d9221 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sat, 9 Sep 2017 14:30:27 +0200 Subject: [PATCH 011/692] Oops, need parens + comma inside nqp::stmts bartolin++ for spotting --- src/core/IO/Handle.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/IO/Handle.pm b/src/core/IO/Handle.pm index d3695b53e5b..debb60e8351 100644 --- a/src/core/IO/Handle.pm +++ b/src/core/IO/Handle.pm @@ -251,7 +251,7 @@ my class IO::Handle { #?if moar (my int $fileno = nqp::filenofh($!PIO)), nqp::closefh($!PIO), # TODO: catch errors - $!PIO := nqp::null; + ($!PIO := nqp::null), self!forget-about-closing($fileno) #?endif ) @@ -810,7 +810,7 @@ my class IO::Handle { $!PIO := nqp::null #?endif #?if moar - $!PIO := nqp::null; + ($!PIO := nqp::null), self!forget-about-closing($fileno) #?endif ) From 4de858a555fe0f6abfa813f0ff29e32edc159c2f Mon Sep 17 00:00:00 2001 From: Timo Paulssen Date: Sat, 9 Sep 2017 14:57:50 +0200 Subject: [PATCH 012/692] junction optimizer shall ignore proto and only look at candidates --- src/Perl6/Optimizer.nqp | 22 +++++++++++++++++----- 1 file changed, 17 insertions(+), 5 deletions(-) diff --git a/src/Perl6/Optimizer.nqp b/src/Perl6/Optimizer.nqp index 0433601ba02..0800e59e3a7 100644 --- a/src/Perl6/Optimizer.nqp +++ b/src/Perl6/Optimizer.nqp @@ -725,12 +725,24 @@ my class JunctionOptimizer { $found := 1; } if $found == 1 { + my @candidates; + if $obj.is_dispatcher { + my $Routine := $!symbols.find_in_setting("Routine"); + @candidates := nqp::getattr($obj, $Routine, '@!dispatchees'); + } + else { + @candidates := nqp::list($obj); + } my $signature := $!symbols.find_in_setting("Signature"); - my $iter := nqp::iterator(nqp::getattr($obj.signature, $signature, '@!params')); - while $iter { - my $p := nqp::shift($iter); - unless nqp::istype($p.type, $!symbols.Any) { - return 0; + my $canditer := nqp::iterator(@candidates); + while $canditer { + my $cand := nqp::shift($canditer); + my $iter := nqp::iterator(nqp::getattr($cand.signature, $signature, '@!params')); + while $iter { + my $p := nqp::shift($iter); + unless nqp::istype($p.type, $!symbols.Any) { + return 0; + } } } return 1; From 76f1d8970e29b37c165c826d35bc23137e76f0ba Mon Sep 17 00:00:00 2001 From: usev6 Date: Sun, 10 Sep 2017 10:25:43 +0200 Subject: [PATCH 013/692] [jvm] Make libdir known in 'sub hll-config' This lets EvalServer find Perl6::BOOTSTRAP and makes 'make test' work again. (At least after 'make install'.) --- tools/build/Makefile-JVM.in | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/build/Makefile-JVM.in b/tools/build/Makefile-JVM.in index e6248485520..86a0f2781fa 100644 --- a/tools/build/Makefile-JVM.in +++ b/tools/build/Makefile-JVM.in @@ -130,7 +130,7 @@ $(PERL6_C_JAR): src/Perl6/Compiler.nqp $(PERL6_O_JAR) src/Perl6/Compiler.nqp $(PERL6_JAR): src/main.nqp $(RUNTIME_JAR) $(PERL6_G_JAR) $(PERL6_A_JAR) $(PERL6_C_JAR) $(PERL6_P_JAR) $(PERL6_DP_JAR) - $(PERL5) tools/build/gen-version.pl $(PREFIX) > $(J_BUILD_DIR)/main-version.nqp + $(PERL5) tools/build/gen-version.pl $(PREFIX) $(LIBDIR) > $(J_BUILD_DIR)/main-version.nqp $(J_NQP) $(J_GEN_CAT) src/main.nqp $(J_BUILD_DIR)/main-version.nqp > $(J_BUILD_DIR)/main.nqp $(J_NQP) --module-path=blib --target=jar --javaclass=perl6 --output=$(PERL6_JAR) \ $(J_BUILD_DIR)/main.nqp From 9b42484a5d0ca6b5d340620cc5d8dd88e2eb331f Mon Sep 17 00:00:00 2001 From: Samantha McVey Date: Sun, 10 Sep 2017 04:02:18 -0700 Subject: [PATCH 014/692] Bump MoarVM: Unicode Collation Algorithm + other fixes NQP changes: 2017.08-47-g79e6453..2017.08-61-g731fcc381 731fcc381 Bump MoarVM: Unicode Collation Algorithm + other fixes 91d6538e0 Test passing wrongly typed required native named arguments 0e78e6b60 [jvm] When getting a wrong kind of native argument throw an exception instead of trying to coerce 8742805cb Add more index* tests to test empty string paths a6b7c9c51 [js] nqp::can works on stdout 4a78633a7 [js] Fix typo 99d7ae55a [js] Add nqp::const::SIG_* 32625312f [js] Update hack 6bfc31301 Test nqp::codes 8d8bb5d3b [jvm] Implement nqp::codes de18e8897 [jvm] Check that we have at least JVM 1.8 9a9b659f0 [js] Implement nqp::codes 8eac8eb13 [js] Check argument count before doing any unpacking and type checking Moar changes: 2017.08.1-128-gde6dced..2017.08.1-150-g0b81969d 0b81969d Remove unneeded file from UCA implementation 866623d9 Merge Full Unicode Collation Algorithm Implementation 088aa0a0 Fix a leak in CArray repr. 0441e075 Ensure gi->start is set to 0 for flat strings in MVM_string_gi_init 1de91704 MVMROOT remaining pointers to GC objects e86428d4 Don't try duplicate unreachable handlers on inline c78477cd put missing forward declaration of arg_guard_gc_describe in a418dcb8 Only use grapheme iter cached if the Haystack is a strand for index* 13967332 Mark GC blocked when acquiring mutex b2770e27 Use grapheme iterator cached for ignorecase/ignoremark index ops 23d613e3 Fix bug in gi_move_to if not starting at 0 c2fc14dd Optimize MVM_string_gi_move_to d05764fb MVM_IS_32BIT_INT(i) with explicit casts 2b7ecb92 Use existing next-power-of-two function, cygx++ a7debca8 Make size check and bit-twiddling an if/else af649435 Enforce minimum size in on_alloc 4e70bed6 Alloc proc read buffer based on amount last read --- tools/build/NQP_REVISION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/build/NQP_REVISION b/tools/build/NQP_REVISION index 6e51d0cd4a3..6b2a5253889 100644 --- a/tools/build/NQP_REVISION +++ b/tools/build/NQP_REVISION @@ -1 +1 @@ -2017.08-47-g79e6453 +2017.08-61-g731fcc381 \ No newline at end of file From 7da0c2159e6eb311141daa75cfa3b9d9ed852014 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sun, 10 Sep 2017 22:17:19 +0200 Subject: [PATCH 015/692] Don't copy BUILDALLPLAN if the same as BUILDPLAN This should save some memory for every class that inherits from Any, or mixins into a class that don't add any attributes. --- src/Perl6/Metamodel/BUILDPLAN.nqp | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Perl6/Metamodel/BUILDPLAN.nqp b/src/Perl6/Metamodel/BUILDPLAN.nqp index 1187f46ee02..960048e79d4 100644 --- a/src/Perl6/Metamodel/BUILDPLAN.nqp +++ b/src/Perl6/Metamodel/BUILDPLAN.nqp @@ -119,7 +119,9 @@ role Perl6::Metamodel::BUILDPLAN { nqp::push(@all_plan, $_); } } - @!BUILDALLPLAN := @all_plan; + + # if same number of elems, identical, so just keep 1 copy + @!BUILDALLPLAN := +@all_plan == +@plan ?? @plan !! @all_plan; } method BUILDPLAN($obj) { From 0ca5ffa408b60ba67a41b26cd13e609e4d12ead7 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Mon, 11 Sep 2017 09:01:37 +0200 Subject: [PATCH 016/692] Use more idiomatic push rather than @a[+@a] Should be faster as well, although that doesn't matter much at compile time. --- src/Perl6/Metamodel/BUILDPLAN.nqp | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/src/Perl6/Metamodel/BUILDPLAN.nqp b/src/Perl6/Metamodel/BUILDPLAN.nqp index 960048e79d4..840fe4c0be6 100644 --- a/src/Perl6/Metamodel/BUILDPLAN.nqp +++ b/src/Perl6/Metamodel/BUILDPLAN.nqp @@ -34,7 +34,7 @@ role Perl6::Metamodel::BUILDPLAN { if nqp::can($_, 'container_initializer') { my $ci := $_.container_initializer; if nqp::isconcrete($ci) { - @plan[+@plan] := [12, $obj, $_.name, $ci]; + nqp::push(@plan,[12, $obj, $_.name, $ci]); next; } } @@ -47,7 +47,7 @@ role Perl6::Metamodel::BUILDPLAN { my $build := $obj.HOW.find_method($obj, 'BUILD', :no_fallback(1)); if !nqp::isnull($build) && $build { # We'll call the custom one. - @plan[+@plan] := [0, $build]; + nqp::push(@plan,[0, $build]); } else { # No custom BUILD. Rather than having an actual BUILD @@ -59,10 +59,10 @@ role Perl6::Metamodel::BUILDPLAN { my $name := nqp::substr($attr_name, 2); my $typespec := nqp::objprimspec($_.type); if $typespec { - @plan[+@plan] := [nqp::add_i(4, $typespec), - $obj, $name, $attr_name]; + nqp::push(@plan,[nqp::add_i(4, $typespec), + $obj, $name, $attr_name]); } else { - @plan[+@plan] := [1, $obj, $name, $attr_name]; + nqp::push(@plan,[1, $obj, $name, $attr_name]); } } } @@ -71,7 +71,7 @@ role Perl6::Metamodel::BUILDPLAN { # Ensure that any required attributes are set for @attrs { if nqp::can($_, 'required') && $_.required { - @plan[+@plan] := [11, $obj, $_.name, $_.required]; + nqp::push(@plan,[11, $obj, $_.name, $_.required]); nqp::deletekey(%attrs_untouched, $_.name); } } @@ -83,10 +83,10 @@ role Perl6::Metamodel::BUILDPLAN { if !nqp::isnull($default) && $default { my $typespec := nqp::objprimspec($_.type); if $typespec { - @plan[+@plan] := [nqp::add_i(7, $typespec), $obj, $_.name, $default]; + nqp::push(@plan,[nqp::add_i(7, $typespec), $obj, $_.name, $default]); } else { - @plan[+@plan] := [4, $obj, $_.name, $default]; + nqp::push(@plan,[4, $obj, $_.name, $default]); } nqp::deletekey(%attrs_untouched, $_.name); } @@ -95,13 +95,13 @@ role Perl6::Metamodel::BUILDPLAN { # Add vivify instructions. for %attrs_untouched { - @plan[+@plan] := [13, $obj, $_.key]; + nqp::push(@plan,[13, $obj, $_.key]); } # Does it have a TWEAK? my $TWEAK := $obj.HOW.find_method($obj, 'TWEAK', :no_fallback(1)); if !nqp::isnull($TWEAK) && $TWEAK { - @plan[+@plan] := [0, $TWEAK]; + nqp::push(@plan,[0, $TWEAK]); } # Install plan for this class. From edac1d687099794ac163549adff1863839994653 Mon Sep 17 00:00:00 2001 From: Cuong Manh Le Date: Mon, 11 Sep 2017 16:05:02 +0700 Subject: [PATCH 017/692] Supress line number if throw X::Package::Stubbed --- src/core/Exception.pm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/core/Exception.pm b/src/core/Exception.pm index a2e59a0bedb..89bb28f244e 100644 --- a/src/core/Exception.pm +++ b/src/core/Exception.pm @@ -1898,11 +1898,13 @@ my class X::Package::UseLib does X::Comp { } my class X::Package::Stubbed does X::Comp { has @.packages; - # TODO: suppress display of line number method message() { "The following packages were stubbed but not defined:\n " ~ @.packages.join("\n "); } + multi method gist(::?CLASS:D: :$sorry = True, :$expect = True) { + $.message; + } } my class X::Phaser::PrePost is Exception { From 760530a524a525f6a0d4f6ba6e5716b6591211c6 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Mon, 11 Sep 2017 12:06:07 +0200 Subject: [PATCH 018/692] Remove action 13 from BUILDALLPLAN In BUILDALL this is a noop, so don't put it in the BUILDALLPLAN to begin with. And since we now removed that, we don't need to support this in Mu.BUILDALL either. This should have some effect minor effect on memory usage, and maybe some noticeable effect in build times of objects with attributes that don't need initialization. --- src/Perl6/Metamodel/BUILDPLAN.nqp | 12 +++++++++--- src/core/Mu.pm | 18 ++---------------- 2 files changed, 11 insertions(+), 19 deletions(-) diff --git a/src/Perl6/Metamodel/BUILDPLAN.nqp b/src/Perl6/Metamodel/BUILDPLAN.nqp index 840fe4c0be6..c25c0572c0d 100644 --- a/src/Perl6/Metamodel/BUILDPLAN.nqp +++ b/src/Perl6/Metamodel/BUILDPLAN.nqp @@ -112,16 +112,22 @@ role Perl6::Metamodel::BUILDPLAN { my @all_plan; my @mro := self.mro($obj); my $i := +@mro; + my $noops := 0; while $i > 0 { $i := $i - 1; my $class := @mro[$i]; for $class.HOW.BUILDPLAN($class) { - nqp::push(@all_plan, $_); + if $_[0] == 13 { # 13 is a noop in BUILDALLPLAN + $noops := 1; + } + else { + nqp::push(@all_plan, $_); + } } } - # if same number of elems, identical, so just keep 1 copy - @!BUILDALLPLAN := +@all_plan == +@plan ?? @plan !! @all_plan; + # if same number of elems and no noops, identical, so just keep 1 copy + @!BUILDALLPLAN := $noops || +@all_plan != +@plan ?? @all_plan !! @plan; } method BUILDPLAN($obj) { diff --git a/src/core/Mu.pm b/src/core/Mu.pm index 6f53d66de87..93840982c45 100644 --- a/src/core/Mu.pm +++ b/src/core/Mu.pm @@ -278,22 +278,8 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" nqp::atpos($task,2), (nqp::atpos($task,3)()) ), - - nqp::if( - nqp::iseq_i($code,13), # no-op in BUILDALL - nqp::stmts( # 13's flock together - nqp::while( - nqp::islt_i( - ($i = nqp::add_i($i,1)),$count - ) && nqp::iseq_i( - nqp::atpos(nqp::atpos($bp,$i),0),13 - ), - nqp::null - ), - ($i = nqp::sub_i($i,1)) - ), - die("Invalid BUILDALL plan") - ))))))))), + die("Invalid BUILDALL plan") + )))))))), nqp::if( # 0 Custom BUILD call. nqp::istype( From 7f526c1efdc574897c4e3c711dc5ee65d98bf8c1 Mon Sep 17 00:00:00 2001 From: Samantha McVey Date: Tue, 12 Sep 2017 09:03:01 -0700 Subject: [PATCH 019/692] Bump NQP/Moar: Prepend support for casechanges, ignoremark Previously Prepend codepoints in a synthetic grapheme would cause case changes and ignoremark not to function properly. Prepend codepoints are the reverse of normal combining characters, and come before instead of after the base glyph. MoarVM Changes: 2017.08.1-150-g0b81969d..2017.08.1-156-g49b90b99 49b90b99 Fix case change when base cp isn't the first cp in synthetic db3102c4 For degenerate Synth's with Prepend and Extend set base cp to 1st cp f8a639e2 Fix ignoremark with Prepend characters and ordbaseat op d78c3707 ULL is the proper suffix for a 64 bit integer literal 22000677 Nativecall code : fix invalid pointer creation --- tools/build/NQP_REVISION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/build/NQP_REVISION b/tools/build/NQP_REVISION index 6b2a5253889..7f85fe53b3b 100644 --- a/tools/build/NQP_REVISION +++ b/tools/build/NQP_REVISION @@ -1 +1 @@ -2017.08-61-g731fcc381 \ No newline at end of file +2017.08-62-gd35cdbdd3 \ No newline at end of file From 5f335065678021da96fbbf53d5a80a1087970f14 Mon Sep 17 00:00:00 2001 From: Samantha McVey Date: Tue, 12 Sep 2017 09:09:43 -0700 Subject: [PATCH 020/692] .collate/coll/unicmp no longer experimental. $*COLLATION still is The .collate method, coll and unicmp infix functions are no longer experimental. I am still keeping $*COLLATION the dynamic variable which allows you to configure the sort as experimental for now. --- src/core/Collation.pm | 8 ++++++-- src/core/Str.pm | 12 ------------ 2 files changed, 6 insertions(+), 14 deletions(-) diff --git a/src/core/Collation.pm b/src/core/Collation.pm index cc7ed3de4fa..4544b24e521 100644 --- a/src/core/Collation.pm +++ b/src/core/Collation.pm @@ -12,6 +12,10 @@ class Collation { Int :$tertiary = 1, Int :$quaternary = 1) { + nqp::isnull(nqp::getlexcaller('EXPERIMENTAL-COLLATION')) and X::Experimental.new( + feature => 'the $*COLLATION dynamic variable', + use => 'collation' + ).throw; my int $i = 0; $i += 1 if $primary.sign == 1; $i += 2 if $primary.sign == -1; @@ -28,8 +32,8 @@ class Collation { self; } method check ($more, $less) { - # Hopefully the user didn't set it this way, but return the correct - # result just in case + # Hopefully the user didn't set collation-level manually to have a level + # both enabled *and* disabled. But check if this is the case anyway. return 0 if $!collation-level +& all($more,$less); return 1 if $!collation-level +& $more; return -1 if $!collation-level +& $less; diff --git a/src/core/Str.pm b/src/core/Str.pm index 2c9a1d24c09..291587ad964 100644 --- a/src/core/Str.pm +++ b/src/core/Str.pm @@ -2970,10 +2970,6 @@ proto sub infix:(|) is pure { * } proto sub infix:(|) { * } #?if moar multi sub infix:(Str:D \a, Str:D \b --> Order:D) { - nqp::isnull(nqp::getlexcaller('EXPERIMENTAL-COLLATION')) and X::Experimental.new( - feature => "the 'unicmp' operator", - use => "collation" - ).throw; ORDER( nqp::unicmp_s( nqp::unbox_s(a), nqp::unbox_s(b), 85,0,0)) @@ -2982,19 +2978,11 @@ multi sub infix:(Pair:D \a, Pair:D \b) { (a.key unicmp b.key) || (a.value unicmp b.value) } multi sub infix:(Str:D \a, Str:D \b --> Order:D) { - nqp::isnull(nqp::getlexcaller('EXPERIMENTAL-COLLATION')) and X::Experimental.new( - feature => "the 'coll' operator", - use => "collation" - ).throw; ORDER( nqp::unicmp_s( nqp::unbox_s(a), nqp::unbox_s(b), $*COLLATION.collation-level,0,0)) } multi sub infix:(Cool:D \a, Cool:D \b --> Order:D) { - nqp::isnull(nqp::getlexcaller('EXPERIMENTAL-COLLATION')) and X::Experimental.new( - feature => "the 'coll' operator", - use => "collation" - ).throw; ORDER( nqp::unicmp_s( nqp::unbox_s(a.Str), nqp::unbox_s(b.Str), $*COLLATION.collation-level,0,0)) From ec18efa056e80545d0ef81d1223c08e30a879105 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Wed, 13 Sep 2017 00:15:34 +0200 Subject: [PATCH 021/692] Any.collate will also handle List.collate --- src/core/List.pm | 3 --- 1 file changed, 3 deletions(-) diff --git a/src/core/List.pm b/src/core/List.pm index 23694060aae..8bedef1951b 100644 --- a/src/core/List.pm +++ b/src/core/List.pm @@ -1358,9 +1358,6 @@ my class List does Iterable does Positional { # declared in BOOTSTRAP ) ) } - method collate { - self.sort(&[coll]); - } multi method tail(List:D:) is raw { nqp::if( $!todo.DEFINITE, From 3f4a9ffac61ea1fff9c52a4214f31e905b1f7844 Mon Sep 17 00:00:00 2001 From: Samantha McVey Date: Tue, 12 Sep 2017 22:30:14 -0700 Subject: [PATCH 022/692] Don't start Configure.pl without ExtUtils::Command Not all distros include this module, but it is needed to run the Makefile. If a user would try and install Rakudo Star and they don't have the module, this would obscure the missing module and they likely would not know why the Rakudo Star compilation/installation was failing. `use` the module in Configure.pl so the user immediately knows they must install this module if they do not have it. --- Configure.pl | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/Configure.pl b/Configure.pl index 2dbf0065123..c3359d95d1e 100755 --- a/Configure.pl +++ b/Configure.pl @@ -18,8 +18,10 @@ my $uclang = uc $lang; my $win = $^O eq 'MSWin32'; my $slash = $win ? '\\' : '/'; - - +# We don't use ExtUtils::Command in Configure.pl, but it is used in the Makefile +# Try `use`ing it here so users know if they need to install this module +# (not included with *every* Perl installation) +use ExtUtils::Command; MAIN: { if (-r 'config.default') { unshift @ARGV, shellwords(slurp('config.default')); From d2eb74231274b8275d7981e0440224d43ad42da2 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Wed, 13 Sep 2017 12:20:47 +0200 Subject: [PATCH 023/692] Pass :hint-affinity to scheduler in some places These are cases where the input is arriving to be emitted by a Supply, and thus having multiple threads scrambling to handle the input will do more harm than good. Ignored by the current thread pool scheduler, but will be used by the upcoming new one. --- src/core/IO/Notification.pm | 2 +- src/core/IO/Socket/Async.pm | 7 ++++--- src/core/Proc/Async.pm | 2 +- 3 files changed, 6 insertions(+), 5 deletions(-) diff --git a/src/core/IO/Notification.pm b/src/core/IO/Notification.pm index 59d73963577..be9a42805ba 100644 --- a/src/core/IO/Notification.pm +++ b/src/core/IO/Notification.pm @@ -19,7 +19,7 @@ my class IO::Notification { my $is-dir = $path.IO.d; my $s = Supplier.new; nqp::watchfile( - $scheduler.queue, + $scheduler.queue(:hint-affinity), -> \path, \rename, \err { if err { $s.quit(err); diff --git a/src/core/IO/Socket/Async.pm b/src/core/IO/Socket/Async.pm index 9f85cb2ada2..84408b052ac 100644 --- a/src/core/IO/Socket/Async.pm +++ b/src/core/IO/Socket/Async.pm @@ -55,7 +55,8 @@ my class IO::Socket::Async { my $cancellation; Supply.on-demand: -> $supply { - $cancellation := nqp::asyncreadbytes($!VMIO, $scheduler.queue, + $cancellation := nqp::asyncreadbytes($!VMIO, + $scheduler.queue(:hint-affinity), capture($supply), nqp::decont($buf), SocketCancellation); $!close-promise.then({ $supply.done }); }, @@ -119,7 +120,7 @@ my class IO::Socket::Async { my $encoding = Encoding::Registry.find($enc); Supply.on-demand(-> $s { $cancellation := nqp::asynclisten( - $scheduler.queue, + $scheduler.queue(:hint-affinity), -> Mu \socket, Mu \err, Mu \peer-host, Mu \peer-port, Mu \socket-host, Mu \socket-port { if err { $s.quit(err); @@ -189,7 +190,7 @@ my class IO::Socket::Async { my $p = Promise.new; my $encoding = Encoding::Registry.find($enc); nqp::asyncudp( - $scheduler.queue, + $scheduler.queue(:hint-affinity), -> Mu \socket, Mu \err { if err { $p.break(err); diff --git a/src/core/Proc/Async.pm b/src/core/Proc/Async.pm index 578eb250931..9453e21bada 100644 --- a/src/core/Proc/Async.pm +++ b/src/core/Proc/Async.pm @@ -337,7 +337,7 @@ my class Proc::Async { nqp::bindkey($callbacks, 'stdout_fd', $!stdout-fd) if $!stdout-fd.DEFINITE; nqp::bindkey($callbacks, 'stderr_fd', $!stderr-fd) if $!stderr-fd.DEFINITE; - $!process_handle := nqp::spawnprocasync($scheduler.queue, + $!process_handle := nqp::spawnprocasync($scheduler.queue(:hint-affinity), CLONE-LIST-DECONTAINERIZED($!path,@!args), $cwd.Str, CLONE-HASH-DECONTAINERIZED(%ENV), From 80e069a4b4deb271504e052d3d430dd988a55336 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Wed, 13 Sep 2017 13:33:56 +0200 Subject: [PATCH 024/692] BUILDPLAN states 2,3 were not being used - so eradicate them - probably does not have any noticeable performance effects - but it cleans up, and means less codegen to worry about later --- src/Perl6/Metamodel/BUILDPLAN.nqp | 36 ++++--- src/core/Mu.pm | 164 ++++++++++++------------------ 2 files changed, 81 insertions(+), 119 deletions(-) diff --git a/src/Perl6/Metamodel/BUILDPLAN.nqp b/src/Perl6/Metamodel/BUILDPLAN.nqp index c25c0572c0d..1c120d82c71 100644 --- a/src/Perl6/Metamodel/BUILDPLAN.nqp +++ b/src/Perl6/Metamodel/BUILDPLAN.nqp @@ -9,18 +9,16 @@ role Perl6::Metamodel::BUILDPLAN { # nested array is an "op" representing the task to perform: # 0 code = call specified BUILD or TWEAK method # 1 class name attr_name = try to find initialization value - # 2 class name attr_name = try to find initialization value, or set nqp::list() - # 3 class name attr_name = try to find initialization value, or set nqp::hash() - # 4 class attr_name code = call default value closure if needed - # 5 class name attr_name = set a native int attribute - # 6 class name attr_name = set a native num attribute - # 7 class name attr_name = set a native str attribute - # 8 class attr_name code = call default value closure if needed, int attr - # 9 class attr_name code = call default value closure if needed, num attr - # 10 class attr_name code = call default value closure if needed, str attr - # 11 die if a required attribute is not present - # 12 class attr_name code = run attribute container initializer - # 13 class attr_name = touch/vivify attribute if part of mixin + # 2 class attr_name code = call default value closure if needed + # 3 class name attr_name = set a native int attribute + # 4 class name attr_name = set a native num attribute + # 5 class name attr_name = set a native str attribute + # 6 class attr_name code = call default value closure if needed, int attr + # 7 class attr_name code = call default value closure if needed, num attr + # 8 class attr_name code = call default value closure if needed, str attr + # 9 die if a required attribute is not present + # 10 class attr_name code = run attribute container initializer + # 11 class attr_name = touch/vivify attribute if part of mixin method create_BUILDPLAN($obj) { # First, we'll create the build plan for just this class. my @plan; @@ -34,7 +32,7 @@ role Perl6::Metamodel::BUILDPLAN { if nqp::can($_, 'container_initializer') { my $ci := $_.container_initializer; if nqp::isconcrete($ci) { - nqp::push(@plan,[12, $obj, $_.name, $ci]); + nqp::push(@plan,[10, $obj, $_.name, $ci]); next; } } @@ -59,7 +57,7 @@ role Perl6::Metamodel::BUILDPLAN { my $name := nqp::substr($attr_name, 2); my $typespec := nqp::objprimspec($_.type); if $typespec { - nqp::push(@plan,[nqp::add_i(4, $typespec), + nqp::push(@plan,[nqp::add_i(2, $typespec), $obj, $name, $attr_name]); } else { nqp::push(@plan,[1, $obj, $name, $attr_name]); @@ -71,7 +69,7 @@ role Perl6::Metamodel::BUILDPLAN { # Ensure that any required attributes are set for @attrs { if nqp::can($_, 'required') && $_.required { - nqp::push(@plan,[11, $obj, $_.name, $_.required]); + nqp::push(@plan,[9, $obj, $_.name, $_.required]); nqp::deletekey(%attrs_untouched, $_.name); } } @@ -83,10 +81,10 @@ role Perl6::Metamodel::BUILDPLAN { if !nqp::isnull($default) && $default { my $typespec := nqp::objprimspec($_.type); if $typespec { - nqp::push(@plan,[nqp::add_i(7, $typespec), $obj, $_.name, $default]); + nqp::push(@plan,[nqp::add_i(5, $typespec), $obj, $_.name, $default]); } else { - nqp::push(@plan,[4, $obj, $_.name, $default]); + nqp::push(@plan,[2, $obj, $_.name, $default]); } nqp::deletekey(%attrs_untouched, $_.name); } @@ -95,7 +93,7 @@ role Perl6::Metamodel::BUILDPLAN { # Add vivify instructions. for %attrs_untouched { - nqp::push(@plan,[13, $obj, $_.key]); + nqp::push(@plan,[11, $obj, $_.key]); } # Does it have a TWEAK? @@ -117,7 +115,7 @@ role Perl6::Metamodel::BUILDPLAN { $i := $i - 1; my $class := @mro[$i]; for $class.HOW.BUILDPLAN($class) { - if $_[0] == 13 { # 13 is a noop in BUILDALLPLAN + if $_[0] == 11 { # 11 is a noop in BUILDALLPLAN $noops := 1; } else { diff --git a/src/core/Mu.pm b/src/core/Mu.pm index 93840982c45..8f11f726d6b 100644 --- a/src/core/Mu.pm +++ b/src/core/Mu.pm @@ -156,26 +156,16 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" ($code = nqp::atpos(($task := nqp::atpos($bp,$i)),0)), nqp::if( # >0 - nqp::isle_i($code,3), # 1,2,3 + nqp::iseq_i($code,1), # 1 nqp::if( nqp::existskey($init,nqp::atpos($task,2)), (nqp::getattr(self,nqp::atpos($task,1),nqp::atpos($task,3)) = %attrinit.AT-KEY(nqp::atpos($task,2))), - nqp::if( # no initializer found - nqp::iseq_i($code,2), - nqp::bindattr( - self,nqp::atpos($task,1),nqp::atpos($task,3),nqp::list), - nqp::if( - nqp::iseq_i($code,3), - nqp::bindattr( - self,nqp::atpos($task,1),nqp::atpos($task,3),nqp::hash) - ) - ) ), nqp::if( - nqp::iseq_i($code,4), - nqp::unless( # 4 + nqp::iseq_i($code,2), + nqp::unless( # 2 nqp::attrinited(self, nqp::atpos($task,1), nqp::atpos($task,2) @@ -190,24 +180,24 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" ), nqp::if( - nqp::isle_i($code,7), - nqp::if( # 5,6,7 + nqp::isle_i($code,5), + nqp::if( # 3,4,5 nqp::existskey($init,nqp::atpos($task,2)), nqp::if( # can initialize - nqp::iseq_i($code,5), - nqp::bindattr_i(self, # 5 + nqp::iseq_i($code,3), + nqp::bindattr_i(self, # 3 nqp::atpos($task,1), nqp::atpos($task,3), nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,2))) ), nqp::if( - nqp::iseq_i($code,6), # 6 - nqp::bindattr_n(self, + nqp::iseq_i($code,4), + nqp::bindattr_n(self, # 4 nqp::atpos($task,1), nqp::atpos($task,3), nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,2))) ), - nqp::bindattr_s(self, # 7 + nqp::bindattr_s(self, # 5 nqp::atpos($task,1), nqp::atpos($task,3), nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,2))) @@ -217,8 +207,8 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" ), nqp::if( - nqp::iseq_i($code,8), - nqp::if( # 8 + nqp::iseq_i($code,6), + nqp::if( # 6 nqp::iseq_i($int = nqp::getattr_i(self, nqp::atpos($task,1), nqp::atpos($task,2) @@ -231,8 +221,8 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" ), nqp::if( - nqp::iseq_i($code,9), - nqp::if( # 9 + nqp::iseq_i($code,7), + nqp::if( # 7 nqp::iseq_n($num = nqp::getattr_n(self, nqp::atpos($task,1), nqp::atpos($task,2) @@ -245,8 +235,8 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" ), nqp::if( - nqp::iseq_i($code,10), - nqp::if( # 10 + nqp::iseq_i($code,8), + nqp::if( # 8 nqp::isnull_s($str = nqp::getattr_s(self, nqp::atpos($task,1), nqp::atpos($task,2) @@ -259,8 +249,8 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" ), nqp::if( - nqp::iseq_i($code,11), - nqp::unless( # 11 + nqp::iseq_i($code,9), + nqp::unless( # 9 nqp::attrinited(self, nqp::atpos($task,1), nqp::atpos($task,2) @@ -272,8 +262,8 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" ), nqp::if( - nqp::iseq_i($code,12), - nqp::bindattr(self, # 12 + nqp::iseq_i($code,10), + nqp::bindattr(self, # 10 nqp::atpos($task,1), nqp::atpos($task,2), (nqp::atpos($task,3)()) @@ -281,7 +271,7 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" die("Invalid BUILDALL plan") )))))))), - nqp::if( # 0 Custom BUILD call. + nqp::if( # 0 BUILD/TWEAK nqp::istype( ($build := nqp::if( nqp::elems($init), @@ -313,11 +303,11 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" nqp::while( nqp::islt_i($i = nqp::add_i($i,1),$count), - nqp::if( # 0 # Custom BUILD call. + nqp::if( nqp::iseq_i(($code = nqp::atpos( ($task := nqp::atpos($bp,$i)),0 )),0), - nqp::if( + nqp::if( # 0 BUILD/TWEAK nqp::istype( ($build := nqp::if( nqp::elems($init), @@ -329,9 +319,9 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" return $build ), - nqp::if( # 1 + nqp::if( nqp::iseq_i($code,1), - nqp::if( + nqp::if( # 1 nqp::existskey($init,nqp::atpos($task,2)), (nqp::getattr(self,nqp::atpos($task,1),nqp::atpos($task,3)) = nqp::decont( @@ -340,64 +330,38 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" ) ), - nqp::if( # 2 + nqp::if( nqp::iseq_i($code,2), - nqp::if( - nqp::existskey($init,nqp::atpos($task,2)), - (nqp::getattr(self,nqp::atpos($task,1),nqp::atpos($task,3)) - = nqp::decont( - %attrinit.AT-KEY(nqp::p6box_s(nqp::atpos($task,2))) - ) + nqp::unless( # 2 + nqp::attrinited(self, + nqp::atpos($task,1), + nqp::atpos($task,2) ), - nqp::bindattr(self,nqp::atpos($task,1),nqp::atpos($task,3), - nqp::list) + nqp::stmts( + (my \attr := nqp::getattr(self, + nqp::atpos($task,1), + nqp::atpos($task,2) + )), + (attr = nqp::atpos($task,3)(self,attr)) + ) ), - nqp::if( # 3 + nqp::if( nqp::iseq_i($code,3), - nqp::if( + nqp::if( # 3 nqp::existskey($init,nqp::atpos($task,2)), - (nqp::getattr(self,nqp::atpos($task,1),nqp::atpos($task,3)) - = nqp::decont( - %attrinit.AT-KEY(nqp::p6box_s(nqp::atpos($task,2))) - ) - ), - nqp::bindattr(self,nqp::atpos($task,1),nqp::atpos($task,3), - nqp::hash) - ), - - nqp::if( # 4 - nqp::iseq_i($code,4), - nqp::unless( - nqp::attrinited(self, - nqp::atpos($task,1), - nqp::atpos($task,2) - ), - nqp::stmts( - (my \attr := nqp::getattr(self, - nqp::atpos($task,1), - nqp::atpos($task,2) - )), - (attr = nqp::atpos($task,3)(self,attr)) - ) - ), - - nqp::if( # 5 - nqp::iseq_i($code,5), - nqp::if( - nqp::existskey($init,nqp::atpos($task,2)), - nqp::bindattr_i(self, - nqp::atpos($task,1), - nqp::atpos($task,3), - nqp::decont(%attrinit.AT-KEY( - nqp::p6box_s(nqp::atpos($task,2)) + nqp::bindattr_i(self, + nqp::atpos($task,1), + nqp::atpos($task,3), + nqp::decont(%attrinit.AT-KEY( + nqp::p6box_s(nqp::atpos($task,2)) )) ) ), - nqp::if( # 6 - nqp::iseq_i($code,6), - nqp::if( + nqp::if( + nqp::iseq_i($code,4), + nqp::if( # 4 nqp::existskey($init,nqp::atpos($task,2)), nqp::bindattr_n(self, nqp::atpos($task,1), @@ -408,9 +372,9 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" ) ), - nqp::if( # 7 - nqp::iseq_i($code,7), - nqp::if( + nqp::if( + nqp::iseq_i($code,5), + nqp::if( # 5 nqp::existskey($init,nqp::atpos($task,2)), nqp::bindattr_s(self, nqp::atpos($task,1), @@ -421,9 +385,9 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" ) ), - nqp::if( # 8 - nqp::iseq_i($code,8), - nqp::if( + nqp::if( + nqp::iseq_i($code,6), + nqp::if( # 6 nqp::iseq_i($int = nqp::getattr_i(self, nqp::atpos($task,1), nqp::atpos($task,2) @@ -435,9 +399,9 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" ) ), - nqp::if( # 9 - nqp::iseq_i($code,9), - nqp::if( + nqp::if( + nqp::iseq_i($code,7), + nqp::if( # 7 nqp::iseq_n($num = nqp::getattr_n(self, nqp::atpos($task,1), nqp::atpos($task,2) @@ -449,9 +413,9 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" ) ), - nqp::if( # 10 - nqp::iseq_i($code,10), - nqp::if( + nqp::if( + nqp::iseq_i($code,8), + nqp::if( # 8 nqp::isnull_s($str = nqp::getattr_s(self, nqp::atpos($task,1), nqp::atpos($task,2) @@ -463,17 +427,17 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" ) ), - nqp::if( # 13 - nqp::iseq_i($code,13), + nqp::if( + nqp::iseq_i($code,11), # Force vivification, for the sake of meta-object # mix-ins at compile time ending up with correctly # shared containers. - nqp::stmts( + nqp::stmts( # 11 nqp::getattr(self, nqp::atpos($task,1), nqp::atpos($task,2) ), - nqp::while( # 13's flock together + nqp::while( # 11's flock together nqp::islt_i( ($i = nqp::add_i($i,1)), $count @@ -493,7 +457,7 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" ), die("Invalid BUILD_LEAST_DERIVED plan") ) - )))))))))))); + )))))))))); self } From 80b49320cf854ac68a17cdd216575ee26e380325 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Wed, 13 Sep 2017 16:08:58 +0200 Subject: [PATCH 025/692] Initial re-implementation of thread pool scheduler Has separate general and timer queues with separate workers, and also introduces affinity queues, which are intended for cases where events will be fed into a `Supply`, and thus there's no point having lots of threads competing over them only to immediately stumble over each other. The separate timer queue helps with timer events being delayed, for example by a process producing a load of output. The new implementation also adds a supervisor, which is where we will put the smarts on how many threads to have in the pool. For now, it is already smart enough to start a lot less threads than the previous scheduler when they obviously aren't needed, which should help a good bit with memory consumption, as well as to add more when needed to break deadlocks. This area will be further developed in upcoming commits. The default maximum number of threads has been raised to 64, now that the behavior of the scheduler is not to innevitably end up starting the maximum number of threads even when they don't have any work to do. Finally, a new RAKUDO_SCHEDULER_DEBUG environment variable can be set to see how many and what kinds of threads are being started. --- src/core/ThreadPoolScheduler.pm | 394 +++++++++++++++++++++++++------- tools/build/moar_core_sources | 2 +- 2 files changed, 313 insertions(+), 83 deletions(-) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index e1ca4d0ae42..e5ec26c9a14 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -1,10 +1,20 @@ -# The ThreadPoolScheduler is a straightforward scheduler that maintains a -# pool of threads and schedules work items in the order they are added -# using them. - my class ThreadPoolScheduler does Scheduler { - constant THREAD_POOL_PROMPT = Mu.new; + # A concurrent, blocking-on-receive queue. + my class Queue is repr('ConcBlockingQueue') { + method elems() { nqp::elems(self) } + } + + # Scheduler debug, controlled by an environment variable. + my $scheduler-debug = so %*ENV; + sub scheduler-debug($message) { + if $scheduler-debug { + note "[SCHEDULER] $message"; + } + } + # Infrastructure for non-blocking `await` for code running on the + # scheduler. + my constant THREAD_POOL_PROMPT = Mu.new; class ThreadPoolAwaiter does Awaiter { has $!queue; @@ -124,100 +134,330 @@ my class ThreadPoolScheduler does Scheduler { } } - # A concurrent work queue that blocks any worker threads that poll it - # when empty until some work arrives. - my class Queue is repr('ConcBlockingQueue') { } - has $!queue; - - # Semaphore to ensure we don't start more than the maximum number of - # threads allowed. - has $!thread_start_semaphore; + # There are three kinds of worker: + # * General worker threads all pull from the main queue. If they have no + # work, they may steal from timer threads. + # * Timer worker threads are intended to handle time-based events. They + # pull events from the time-sensitive queue, and they will not do any + # work stealing so as to ready and available for timer events. The + # time-sensitive queue will only be returned when a queue is requested + # with the :hint-time-sensitive named argument. Only one timer worker + # will be created on the first request such a queue; the supervisor will + # then monitor the time-sensitive queue length and add more if needed. + # * Affinity worker threads each have their own queue. They are used when + # a queue is requested and :hint-affinity is passed. These are useful + # for things like Proc::Async and IO::Socket::Async, where events will + # be processed using a Supply, which is serial, and so there's no point + # at all in contending over the data. Work will not be stolen from an + # affinity worker thread. + my role Worker { + has $.thread; + has $!scheduler; + + # Completed is the number of tasks completed since the last time the + # supervisor checked in. + has atomicint $.completed; + + # Working is 1 if the worker is currently busy, 0 if not. + has int $.working; + + # Resets the completed to zero. + method take-completed() { + my atomicint $taken; + cas $!completed, -> atomicint $current { $taken = $current; 0 } + $taken + } - # Number of outstanding work items, used for rough management of the - # pool size. - has int $!loads; + method !run-one(\task) { + $!working = 1; + nqp::continuationreset(THREAD_POOL_PROMPT, { + if nqp::istype(task, List) { + my Mu $code := nqp::shift(nqp::getattr(task, List, '$!reified')); + $code(|task); + } + else { + task.(); + } + CONTROL { + default { + my Mu $vm-ex := nqp::getattr(nqp::decont($_), Exception, '$!ex'); + nqp::getcomp('perl6').handle-control($vm-ex); + } + } + CATCH { + default { + $!scheduler.handle_uncaught($_) + } + } + }); + $!working = 0; + $!completed⚛++; + } + } + my class GeneralWorker does Worker { + has Queue $!queue; - # Number of threads started so far. - has int $!threads_started; + submethod BUILD(Queue :$queue!, :$!scheduler!) { + $!queue := $queue; + $!thread = Thread.start(:app_lifetime, { + my $*AWAITER := ThreadPoolAwaiter.new(:$!queue); + loop { + self!run-one(nqp::shift($queue)); + } + }); + } + } + my class TimerWorker does Worker { + has Queue $!queue; - # Lock protecting updates to the above 2 fields. - has $!counts_lock; + submethod BUILD(Queue :$queue!, :$!scheduler!) { + $!queue := $queue; + $!thread = Thread.start(:app_lifetime, { + my $*AWAITER := ThreadPoolAwaiter.new(:$!queue); + loop { + self!run-one(nqp::shift($queue)); + } + }); + } + } + my class AffinityWorker does Worker { + has Queue $.queue; - # If we've got incoming I/O events we need a thread to handle. - has int $!need_io_thread; + submethod BUILD(:$!scheduler!) { + my $queue := $!queue := Queue.CREATE; + $!thread = Thread.start(:app_lifetime, { + my $*AWAITER := ThreadPoolAwaiter.new(:$!queue); + loop { + self!run-one(nqp::shift($queue)); + } + }); + } + } - # Initial and maximum threads. + # Initial and maximum threads allowed. has Int $.initial_threads; has Int $.max_threads; - # Have we started any threads yet? - has int $!started_any; + # All of the worker and queue state below is guarded by this lock. + has Lock $!state-lock .= new; + + # The general queue and timer queue, if created. + has Queue $!general-queue; + has Queue $!timer-queue; + + # The current lists of workers. Immutable lists; new ones are produced + # upon changes. + has List $!general-workers = (); + has List $!timer-workers = (); + has List $!affinity-workers = (); + + # The supervisor thread, if started. + has Thread $!supervisor; + + method !general-queue() { + unless $!general-queue.DEFINITE { + $!state-lock.protect: { + unless $!general-queue.DEFINITE { + # We don't have any workers yet, so start one. + $!general-queue := nqp::create(Queue); + $!general-workers = (GeneralWorker.new( + queue => $!general-queue, + scheduler => self + ),); + scheduler-debug "Created initial general worker thread"; + self!maybe-start-supervisor(); + } + } + } + $!general-queue + } - # Adds a new thread to the pool, respecting the maximum. - method !maybe_new_thread() { - if $!thread_start_semaphore.try_acquire() { - $!started_any = 1; - $!counts_lock.protect: { $!threads_started = $!threads_started + 1 }; - Thread.start(:app_lifetime, { - my $*AWAITER := ThreadPoolAwaiter.new(:$!queue); + method !timer-queue() { + unless $!timer-queue.DEFINITE { + $!state-lock.protect: { + unless $!timer-queue.DEFINITE { + # We don't have any workers yet, so start one. + $!timer-queue := nqp::create(Queue); + $!timer-workers = (TimerWorker.new( + queue => $!timer-queue, + scheduler => self + ),); + scheduler-debug "Created initial timer worker thread"; + self!maybe-start-supervisor(); + } + } + } + $!timer-queue + } + + constant @affinity-add-thresholds = 1, 5, 10, 20, 50, 100; + method !affinity-queue() { + # If there's no affinity workers, start one. + my $cur-affinity-workers := $!affinity-workers; + if $cur-affinity-workers.elems == 0 { + $!state-lock.protect: { + if $!affinity-workers.elems == 0 { + # We don't have any affinity workers yet, so start one + # and return its queue. + $!affinity-workers := (AffinityWorker.new( + scheduler => self + ),); + scheduler-debug "Created initial affinity worker thread"; + self!maybe-start-supervisor(); + return $!affinity-workers[0].queue; + } + } + $cur-affinity-workers := $!affinity-workers; # lost race for first + } + + # Otherwise, see which has the least load (this is inherently racey + # and approximate, but enough to help us avoid a busy worker). If we + # find an empty queue, return it immediately. + my $most-free-worker; + $cur-affinity-workers.map: -> $cand { + if $most-free-worker.DEFINITE { + my $queue = $cand.queue; + return $queue if $queue.elems == 0; + if $cand.elems < $most-free-worker.queue.elems { + $most-free-worker := $cand; + } + } + else { + $most-free-worker := $cand; + } + } + + # Otherwise, check if the queue beats the threshold to add another + # worker thread. + my $chosen-queue = $most-free-worker.queue; + my $queue-elems = $chosen-queue.elems; + my $threshold = @affinity-add-thresholds[ + ($cur-affinity-workers.elems max @affinity-add-thresholds) - 1 + ]; + if $chosen-queue.elems > $threshold { + # Add another one, unless another thread did too. + $!state-lock.protect: { + if $cur-affinity-workers.elems != $!affinity-workers.elems { + return $chosen-queue; + } + my $new-worker = AffinityWorker.new(scheduler => self); + $!affinity-workers = (|$!affinity-workers, $new-worker); + scheduler-debug "Added an affinity worker thread"; + $new-worker.queue + } + } + else { + $chosen-queue + } + } + + # The supervisor sits in a loop, mostly sleeping. Each time it wakes up, + # it takes stock of the current situation and decides whether or not to + # add threads. + method !maybe-start-supervisor() { + unless $!supervisor.DEFINITE { + $!supervisor = Thread.start(:app_lifetime, { + scheduler-debug "Supervisor started"; + sub add-general-worker() { + $!state-lock.protect: { + $!general-workers := (|$!general-workers, GeneralWorker.new( + queue => $!general-queue, + scheduler => self + )); + } + scheduler-debug "Added a general worker thread"; + } + sub add-timer-worker() { + scheduler-debug "Adding a timer worker"; + $!state-lock.protect: { + $!timer-workers := (|$!timer-workers, TimerWorker.new( + queue => $!timer-queue, + scheduler => self + )); + } + scheduler-debug "Added a timer worker thread"; + } loop { - my Mu $task := nqp::shift($!queue); - $!counts_lock.protect: { $!loads = $!loads + 1 }; - nqp::continuationreset(THREAD_POOL_PROMPT, { - if nqp::islist($task) { - my Mu $code := nqp::shift($task); - my \args = nqp::p6bindattrinvres(nqp::create(List), List, '$!reified', $task); - $code(|args); - } - else { - $task(); - } - CONTROL { - default { - my Mu $vm-ex := nqp::getattr(nqp::decont($_), Exception, '$!ex'); - nqp::getcomp('perl6').handle-control($vm-ex); - } - } - CATCH { - default { - self.handle_uncaught($_) - } + sleep 0.005; + if $!general-queue.DEFINITE { + self!tweak-workers: $!general-queue, $!general-workers, + &add-general-worker; + } + CATCH { + default { + scheduler-debug .gist; } - }); - $!counts_lock.protect: { $!loads = $!loads - 1 }; + } } }); } } + method !tweak-workers(\queue, \worker-list, &add-worker) { + # If there's nothing in the queue, nothing could need an extra worker. + return if queue.elems == 0; + + # Go through the worker list. If something is not working, then there + # is at lesat one worker free to process things in the queue, so we + # don't need to add one. + my int $total-completed; + worker-list.map: { + return unless .working; + $total-completed += .take-completed; + } + + # Minimal heuristic: if nothing was completed since the last time, add + # a worker. + # TODO Extra smarts here + if $total-completed == 0 { + add-worker(); + } + } + submethod BUILD( Int :$!initial_threads = 0, - Int :$!max_threads = (%*ENV // 16).Int + Int :$!max_threads = (%*ENV // 64).Int --> Nil ) { die "Initial thread pool threads ($!initial_threads) must be less than or equal to maximum threads ($!max_threads)" if $!initial_threads > $!max_threads; + if $!initial_threads > 0 { + # We've been asked to make some initial threads; we interpret this + # as general workers. + self!general-queue(); # Starts one worker + if $!initial_threads > 1 { + $!general-workers := (|$!general-workers, |( + GeneralWorker.new( + queue => $!general-queue, + scheduler => self + ) xx $!initial_threads - 1 + )); + } + } } - method queue() { - self!initialize unless $!started_any; - self!maybe_new_thread(); - $!need_io_thread = 1; - $!queue + method queue(Bool :$hint-time-sensitive, :$hint-affinity) { + if $hint-affinity { + self!affinity-queue() + } + elsif $hint-time-sensitive { + self!timer-queue() + } + else { + self!general-queue() + } } + my class TimerCancellation is repr('AsyncTask') { } method cue(&code, :$at, :$in, :$every, :$times = 1, :&stop is copy, :&catch ) { - my class TimerCancellation is repr('AsyncTask') { } die "Cannot specify :at and :in at the same time" if $at.defined and $in.defined; die "Cannot specify :every, :times and :stop at the same time" if $every.defined and $times > 1 and &stop; my $delay = $at ?? $at - now !! $in // 0; - self!initialize unless $!started_any; # need repeating if $every { - # generate a stopper if needed if $times > 1 { my $todo = $times; @@ -232,7 +472,7 @@ my class ThreadPoolScheduler does Scheduler { $cancellation //= Cancellation.new(async_handles => [$handle]); } - $handle := nqp::timer($!queue, + $handle := nqp::timer(self!timer-queue(), &catch ?? -> { stop() @@ -247,19 +487,17 @@ my class ThreadPoolScheduler does Scheduler { }, to-millis($delay), to-millis($every), TimerCancellation); - self!maybe_new_thread(); return cancellation() } # no stopper else { - my $handle := nqp::timer($!queue, + my $handle := nqp::timer(self!timer-queue(), &catch ?? -> { code(); CATCH { default { catch($_) } } } !! &code, to-millis($delay), to-millis($every), TimerCancellation); - self!maybe_new_thread(); return Cancellation.new(async_handles => [$handle]); } } @@ -272,9 +510,8 @@ my class ThreadPoolScheduler does Scheduler { my @async_handles; $delay = to-millis($delay) if $delay; @async_handles.push( - nqp::timer($!queue, $todo, $delay, 0, TimerCancellation) + nqp::timer(self!timer-queue(), $todo, $delay, 0, TimerCancellation) ) for 1 .. $times; - self!maybe_new_thread(); return Cancellation.new(:@async_handles); } @@ -283,17 +520,11 @@ my class ThreadPoolScheduler does Scheduler { my &run := &catch ?? -> { code(); CATCH { default { catch($_) } } } !! &code; - self!maybe_new_thread() if $!loads + $!need_io_thread <= $!threads_started; - nqp::push($!queue, &run); + nqp::push(self!general-queue(), &run); return Nil; } } - method loads() { - return 0 unless $!started_any; - $!loads - } - multi to-millis(Int $value) { 1000 * $value } @@ -309,11 +540,10 @@ my class ThreadPoolScheduler does Scheduler { to-millis(+$value) } - method !initialize(--> Nil) { - $!queue := nqp::create(Queue); - $!thread_start_semaphore := Semaphore.new($!max_threads.Int); - $!counts_lock := nqp::create(Lock); - self!maybe_new_thread() for 1..$!initial_threads; + method loads() { + [+] ($!general-queue ?? $!general-queue.elems !! 0), + ($!timer-queue ?? $!timer-queue.elems !! 0), + |($!affinity-workers.map(*.queue.elems)) } } diff --git a/tools/build/moar_core_sources b/tools/build/moar_core_sources index be471a6dac0..863dd5071da 100644 --- a/tools/build/moar_core_sources +++ b/tools/build/moar_core_sources @@ -156,13 +156,13 @@ src/core/Awaitable.pm src/core/Awaiter.pm src/core/Scheduler.pm src/core/Env.pm +src/core/atomicops.pm src/core/ThreadPoolScheduler.pm src/core/CurrentThreadScheduler.pm src/core/Promise.pm src/core/Channel.pm src/core/Supply.pm src/core/asyncops.pm -src/core/atomicops.pm src/core/IO/Socket.pm src/core/IO/Socket/INET.pm src/core/IO/Socket/Async.pm From 76ccfd591db960c6d1a22a496ef928cdd7758403 Mon Sep 17 00:00:00 2001 From: "Salve J. Nilsen" Date: Wed, 13 Sep 2017 16:47:02 +0200 Subject: [PATCH 026/692] Improve generate MAIN usage for rakudobrew When using rakudobrew, the MAIN function's generated usage text contains very long paths on every line. This changes the output to showing the full path on only one line, and then the basename on all subsequent lines. --- src/core/Main.pm | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/core/Main.pm b/src/core/Main.pm index 134c12f8bbe..346691850e3 100644 --- a/src/core/Main.pm +++ b/src/core/Main.pm @@ -92,10 +92,14 @@ my sub MAIN_HELPER($retval = 0) { # Not in PATH $name; } + my sub basename($name) { $*SPEC.splitpath($name)[2] } my $prog-name = %*ENV:exists ?? %*ENV !! $*PROGRAM-NAME; + my $prog-basename = $prog-name eq '-e' + ?? "-e '...'" + !! basename($prog-name); $prog-name = $prog-name eq '-e' ?? "-e '...'" !! strip_path_prefix($prog-name); @@ -154,7 +158,7 @@ my sub MAIN_HELPER($retval = 0) { if $sub.WHY { $docs = '-- ' ~ $sub.WHY.contents } - my $msg = join(' ', $prog-name, @required-named, @optional-named, @positional, $docs // ''); + my $msg = join(' ', $prog-basename, @required-named, @optional-named, @positional, $docs // ''); @help-msgs.push($msg); } @@ -164,7 +168,7 @@ my sub MAIN_HELPER($retval = 0) { @help-msgs.append(@arg-help.map: { ' ' ~ .key ~ ' ' x ($offset - .key.chars) ~ .value }); } - my $usage = "Usage:\n" ~ @help-msgs.map(' ' ~ *).join("\n"); + my $usage = "Usage for {$prog-name}:\n" ~ @help-msgs.map(' ' ~ *).join("\n"); $usage; } From 62fd50933342cee2f514066a0a5798b08cb57be9 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Wed, 13 Sep 2017 16:46:52 +0200 Subject: [PATCH 027/692] Bypass Mu.bless if we can - check if the object's bless method is same as Mu.bless - if so, bypass calling Mu.bless and go for self.BUILDALL directly - makes object creation a bit faster - about 25% for .new on a class with a single attribute and a default value - about 1% slower if you subclass .bless yourself, but that should be rare --- src/core/Mu.pm | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/src/core/Mu.pm b/src/core/Mu.pm index 8f11f726d6b..a35631dcf63 100644 --- a/src/core/Mu.pm +++ b/src/core/Mu.pm @@ -108,8 +108,15 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" } proto method new(|) { * } - multi method new(*%) { - nqp::invokewithcapture(nqp::findmethod(self, 'bless'), nqp::usecapture()) + multi method new(*%attrinit) { + nqp::if( + nqp::eqaddr( + (my $bless := nqp::findmethod(self,'bless')), + nqp::findmethod(Mu,'bless') + ), + nqp::create(self).BUILDALL(%attrinit), + nqp::invokewithcapture($bless,nqp::usecapture) + ) } multi method new($, *@) { X::Constructor::Positional.new(:type( self )).throw(); From 9b527d0f080bf9b2e6ce225ef1b1e60426d75bbe Mon Sep 17 00:00:00 2001 From: Stefan Seifert Date: Wed, 13 Sep 2017 17:42:57 +0200 Subject: [PATCH 028/692] Revert "Improve generate MAIN usage for rakudobrew" This reverts commit 76ccfd591db960c6d1a22a496ef928cdd7758403. The issue only affects rakudobrew users and that's because rakudobrew plays tricks with module installation. The proper fix would be to change rakudobrew so it no longer uses different module installation paths for each rakudo version. --- src/core/Main.pm | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/src/core/Main.pm b/src/core/Main.pm index 346691850e3..134c12f8bbe 100644 --- a/src/core/Main.pm +++ b/src/core/Main.pm @@ -92,14 +92,10 @@ my sub MAIN_HELPER($retval = 0) { # Not in PATH $name; } - my sub basename($name) { $*SPEC.splitpath($name)[2] } my $prog-name = %*ENV:exists ?? %*ENV !! $*PROGRAM-NAME; - my $prog-basename = $prog-name eq '-e' - ?? "-e '...'" - !! basename($prog-name); $prog-name = $prog-name eq '-e' ?? "-e '...'" !! strip_path_prefix($prog-name); @@ -158,7 +154,7 @@ my sub MAIN_HELPER($retval = 0) { if $sub.WHY { $docs = '-- ' ~ $sub.WHY.contents } - my $msg = join(' ', $prog-basename, @required-named, @optional-named, @positional, $docs // ''); + my $msg = join(' ', $prog-name, @required-named, @optional-named, @positional, $docs // ''); @help-msgs.push($msg); } @@ -168,7 +164,7 @@ my sub MAIN_HELPER($retval = 0) { @help-msgs.append(@arg-help.map: { ' ' ~ .key ~ ' ' x ($offset - .key.chars) ~ .value }); } - my $usage = "Usage for {$prog-name}:\n" ~ @help-msgs.map(' ' ~ *).join("\n"); + my $usage = "Usage:\n" ~ @help-msgs.map(' ' ~ *).join("\n"); $usage; } From 2574f8835f7e1342e848c0135fbed6319d55eb0e Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Wed, 13 Sep 2017 18:11:54 +0200 Subject: [PATCH 029/692] Adapt BUILDPLAN further - replace state 0 for calling BUILD/TWEAK by just the Callable - saves one int + one list for each BUILD/TWEAK method in class or derived - adapt Mu.BUILDALL/BUILD_LEAST_DERIVED accordingly - runtime improvements within noise - move up all other states one notch --- src/Perl6/Metamodel/BUILDPLAN.nqp | 50 +++++++------ src/core/Mu.pm | 120 +++++++++++++++--------------- 2 files changed, 84 insertions(+), 86 deletions(-) diff --git a/src/Perl6/Metamodel/BUILDPLAN.nqp b/src/Perl6/Metamodel/BUILDPLAN.nqp index 1c120d82c71..3110441b131 100644 --- a/src/Perl6/Metamodel/BUILDPLAN.nqp +++ b/src/Perl6/Metamodel/BUILDPLAN.nqp @@ -5,20 +5,22 @@ role Perl6::Metamodel::BUILDPLAN { # Creates the plan for building up the object. This works # out what we'll need to do up front, so we can just zip # through the "todo list" each time we need to make an object. - # The plan is an array of arrays. The first element of each - # nested array is an "op" representing the task to perform: - # 0 code = call specified BUILD or TWEAK method - # 1 class name attr_name = try to find initialization value - # 2 class attr_name code = call default value closure if needed - # 3 class name attr_name = set a native int attribute - # 4 class name attr_name = set a native num attribute - # 5 class name attr_name = set a native str attribute - # 6 class attr_name code = call default value closure if needed, int attr - # 7 class attr_name code = call default value closure if needed, num attr - # 8 class attr_name code = call default value closure if needed, str attr - # 9 die if a required attribute is not present - # 10 class attr_name code = run attribute container initializer - # 11 class attr_name = touch/vivify attribute if part of mixin + # The plan is an array of code objects / arrays. If the element + # is a code object, it should be called as a method without any + # further parameters. If it is an array, then the first element + # of each array is an "op" # representing the task to perform: + # code = call as method (for BUILD or TWEAK) + # 0 class name attr_name = try to find initialization value + # 1 class attr_name code = call default value closure if needed + # 2 class name attr_name = set a native int attribute + # 3 class name attr_name = set a native num attribute + # 4 class name attr_name = set a native str attribute + # 5 class attr_name code = call default value closure if needed, int attr + # 6 class attr_name code = call default value closure if needed, num attr + # 7 class attr_name code = call default value closure if needed, str attr + # 8 die if a required attribute is not present + # 9 class attr_name code = run attribute container initializer + # 10 class attr_name = touch/vivify attribute if part of mixin method create_BUILDPLAN($obj) { # First, we'll create the build plan for just this class. my @plan; @@ -32,7 +34,7 @@ role Perl6::Metamodel::BUILDPLAN { if nqp::can($_, 'container_initializer') { my $ci := $_.container_initializer; if nqp::isconcrete($ci) { - nqp::push(@plan,[10, $obj, $_.name, $ci]); + nqp::push(@plan,[9, $obj, $_.name, $ci]); next; } } @@ -45,7 +47,7 @@ role Perl6::Metamodel::BUILDPLAN { my $build := $obj.HOW.find_method($obj, 'BUILD', :no_fallback(1)); if !nqp::isnull($build) && $build { # We'll call the custom one. - nqp::push(@plan,[0, $build]); + nqp::push(@plan,$build); } else { # No custom BUILD. Rather than having an actual BUILD @@ -57,10 +59,10 @@ role Perl6::Metamodel::BUILDPLAN { my $name := nqp::substr($attr_name, 2); my $typespec := nqp::objprimspec($_.type); if $typespec { - nqp::push(@plan,[nqp::add_i(2, $typespec), + nqp::push(@plan,[nqp::add_i(1, $typespec), $obj, $name, $attr_name]); } else { - nqp::push(@plan,[1, $obj, $name, $attr_name]); + nqp::push(@plan,[0, $obj, $name, $attr_name]); } } } @@ -69,7 +71,7 @@ role Perl6::Metamodel::BUILDPLAN { # Ensure that any required attributes are set for @attrs { if nqp::can($_, 'required') && $_.required { - nqp::push(@plan,[9, $obj, $_.name, $_.required]); + nqp::push(@plan,[8, $obj, $_.name, $_.required]); nqp::deletekey(%attrs_untouched, $_.name); } } @@ -81,10 +83,10 @@ role Perl6::Metamodel::BUILDPLAN { if !nqp::isnull($default) && $default { my $typespec := nqp::objprimspec($_.type); if $typespec { - nqp::push(@plan,[nqp::add_i(5, $typespec), $obj, $_.name, $default]); + nqp::push(@plan,[nqp::add_i(4, $typespec), $obj, $_.name, $default]); } else { - nqp::push(@plan,[2, $obj, $_.name, $default]); + nqp::push(@plan,[1, $obj, $_.name, $default]); } nqp::deletekey(%attrs_untouched, $_.name); } @@ -93,13 +95,13 @@ role Perl6::Metamodel::BUILDPLAN { # Add vivify instructions. for %attrs_untouched { - nqp::push(@plan,[11, $obj, $_.key]); + nqp::push(@plan,[10, $obj, $_.key]); } # Does it have a TWEAK? my $TWEAK := $obj.HOW.find_method($obj, 'TWEAK', :no_fallback(1)); if !nqp::isnull($TWEAK) && $TWEAK { - nqp::push(@plan,[0, $TWEAK]); + nqp::push(@plan,$TWEAK); } # Install plan for this class. @@ -115,7 +117,7 @@ role Perl6::Metamodel::BUILDPLAN { $i := $i - 1; my $class := @mro[$i]; for $class.HOW.BUILDPLAN($class) { - if $_[0] == 11 { # 11 is a noop in BUILDALLPLAN + if nqp::islist($_) && $_[0] == 10 { # noop in BUILDALLPLAN $noops := 1; } else { diff --git a/src/core/Mu.pm b/src/core/Mu.pm index a35631dcf63..24296288615 100644 --- a/src/core/Mu.pm +++ b/src/core/Mu.pm @@ -160,19 +160,30 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" nqp::islt_i($i = nqp::add_i($i,1),$count), nqp::if( - ($code = nqp::atpos(($task := nqp::atpos($bp,$i)),0)), + nqp::istype(($task := nqp::atpos($bp,$i)),Callable), + nqp::if( # BUILD/TWEAK + nqp::istype( + ($build := nqp::if( + nqp::elems($init), + $task(self,|%attrinit), + $task(self) + )), + Failure + ), + return $build + ), - nqp::if( # >0 - nqp::iseq_i($code,1), # 1 - nqp::if( + nqp::if( # not just calling + nqp::iseq_i(($code = nqp::atpos($task,0)),0), + nqp::if( # 0 nqp::existskey($init,nqp::atpos($task,2)), (nqp::getattr(self,nqp::atpos($task,1),nqp::atpos($task,3)) = %attrinit.AT-KEY(nqp::atpos($task,2))), ), nqp::if( - nqp::iseq_i($code,2), - nqp::unless( # 2 + nqp::iseq_i($code,1), + nqp::unless( # 1 nqp::attrinited(self, nqp::atpos($task,1), nqp::atpos($task,2) @@ -187,24 +198,24 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" ), nqp::if( - nqp::isle_i($code,5), - nqp::if( # 3,4,5 + nqp::isle_i($code,4), + nqp::if( # 2,3,4 nqp::existskey($init,nqp::atpos($task,2)), nqp::if( # can initialize - nqp::iseq_i($code,3), - nqp::bindattr_i(self, # 3 + nqp::iseq_i($code,2), + nqp::bindattr_i(self, # 2 nqp::atpos($task,1), nqp::atpos($task,3), nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,2))) ), nqp::if( - nqp::iseq_i($code,4), - nqp::bindattr_n(self, # 4 + nqp::iseq_i($code,3), + nqp::bindattr_n(self, # 3 nqp::atpos($task,1), nqp::atpos($task,3), nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,2))) ), - nqp::bindattr_s(self, # 5 + nqp::bindattr_s(self, # 4 nqp::atpos($task,1), nqp::atpos($task,3), nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,2))) @@ -214,8 +225,8 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" ), nqp::if( - nqp::iseq_i($code,6), - nqp::if( # 6 + nqp::iseq_i($code,5), + nqp::if( # 5 nqp::iseq_i($int = nqp::getattr_i(self, nqp::atpos($task,1), nqp::atpos($task,2) @@ -228,8 +239,8 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" ), nqp::if( - nqp::iseq_i($code,7), - nqp::if( # 7 + nqp::iseq_i($code,6), + nqp::if( # 6 nqp::iseq_n($num = nqp::getattr_n(self, nqp::atpos($task,1), nqp::atpos($task,2) @@ -242,8 +253,8 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" ), nqp::if( - nqp::iseq_i($code,8), - nqp::if( # 8 + nqp::iseq_i($code,7), + nqp::if( # 7 nqp::isnull_s($str = nqp::getattr_s(self, nqp::atpos($task,1), nqp::atpos($task,2) @@ -256,8 +267,8 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" ), nqp::if( - nqp::iseq_i($code,9), - nqp::unless( # 9 + nqp::iseq_i($code,8), + nqp::unless( # 8 nqp::attrinited(self, nqp::atpos($task,1), nqp::atpos($task,2) @@ -269,27 +280,14 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" ), nqp::if( - nqp::iseq_i($code,10), - nqp::bindattr(self, # 10 + nqp::iseq_i($code,9), + nqp::bindattr(self, # 9 nqp::atpos($task,1), nqp::atpos($task,2), (nqp::atpos($task,3)()) ), die("Invalid BUILDALL plan") - )))))))), - - nqp::if( # 0 BUILD/TWEAK - nqp::istype( - ($build := nqp::if( - nqp::elems($init), - nqp::atpos($task,1)(self,|%attrinit), - nqp::atpos($task,1)(self) - )), - Failure - ), - return $build - ) - ) + ))))))))), ); self } @@ -311,15 +309,13 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" nqp::islt_i($i = nqp::add_i($i,1),$count), nqp::if( - nqp::iseq_i(($code = nqp::atpos( - ($task := nqp::atpos($bp,$i)),0 - )),0), - nqp::if( # 0 BUILD/TWEAK + nqp::istype(($task := nqp::atpos($bp,$i)),Callable), + nqp::if( # BUILD/TWEAK nqp::istype( ($build := nqp::if( nqp::elems($init), - nqp::atpos($task,1)(self,|%attrinit), - nqp::atpos($task,1)(self) + $task(self,|%attrinit), + $task(self) )), Failure ), @@ -327,8 +323,8 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" ), nqp::if( - nqp::iseq_i($code,1), - nqp::if( # 1 + nqp::iseq_i(($code = nqp::atpos($task,0)),0), + nqp::if( # 0 nqp::existskey($init,nqp::atpos($task,2)), (nqp::getattr(self,nqp::atpos($task,1),nqp::atpos($task,3)) = nqp::decont( @@ -338,8 +334,8 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" ), nqp::if( - nqp::iseq_i($code,2), - nqp::unless( # 2 + nqp::iseq_i($code,1), + nqp::unless( # 1 nqp::attrinited(self, nqp::atpos($task,1), nqp::atpos($task,2) @@ -354,8 +350,8 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" ), nqp::if( - nqp::iseq_i($code,3), - nqp::if( # 3 + nqp::iseq_i($code,2), + nqp::if( # 2 nqp::existskey($init,nqp::atpos($task,2)), nqp::bindattr_i(self, nqp::atpos($task,1), @@ -367,8 +363,8 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" ), nqp::if( - nqp::iseq_i($code,4), - nqp::if( # 4 + nqp::iseq_i($code,3), + nqp::if( # 3 nqp::existskey($init,nqp::atpos($task,2)), nqp::bindattr_n(self, nqp::atpos($task,1), @@ -380,8 +376,8 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" ), nqp::if( - nqp::iseq_i($code,5), - nqp::if( # 5 + nqp::iseq_i($code,4), + nqp::if( # 4 nqp::existskey($init,nqp::atpos($task,2)), nqp::bindattr_s(self, nqp::atpos($task,1), @@ -393,8 +389,8 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" ), nqp::if( - nqp::iseq_i($code,6), - nqp::if( # 6 + nqp::iseq_i($code,5), + nqp::if( # 5 nqp::iseq_i($int = nqp::getattr_i(self, nqp::atpos($task,1), nqp::atpos($task,2) @@ -407,8 +403,8 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" ), nqp::if( - nqp::iseq_i($code,7), - nqp::if( # 7 + nqp::iseq_i($code,6), + nqp::if( # 6 nqp::iseq_n($num = nqp::getattr_n(self, nqp::atpos($task,1), nqp::atpos($task,2) @@ -421,8 +417,8 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" ), nqp::if( - nqp::iseq_i($code,8), - nqp::if( # 8 + nqp::iseq_i($code,7), + nqp::if( # 7 nqp::isnull_s($str = nqp::getattr_s(self, nqp::atpos($task,1), nqp::atpos($task,2) @@ -435,16 +431,16 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" ), nqp::if( - nqp::iseq_i($code,11), + nqp::iseq_i($code,10), # Force vivification, for the sake of meta-object # mix-ins at compile time ending up with correctly # shared containers. - nqp::stmts( # 11 + nqp::stmts( # 10 nqp::getattr(self, nqp::atpos($task,1), nqp::atpos($task,2) ), - nqp::while( # 11's flock together + nqp::while( # 10's flock together nqp::islt_i( ($i = nqp::add_i($i,1)), $count From 9f1d03e72732da1eeb883903b250cce9e91ed52c Mon Sep 17 00:00:00 2001 From: Aleks-Daniel Jakimenko-Aleksejev Date: Wed, 13 Sep 2017 20:56:24 +0300 Subject: [PATCH 030/692] Log some changes Deliberately not logged: 89447213 636a3c12 d0a5cfa8 3518b13b ffd87fe5 3cfc3285 ab69dc3a 29cd9fb5 d8958fc3 b6a60236 43abdb1d 74ca5ce9 9b43c8de f1b08630 e3af6629 3e13825b 1f39d684 067f5407 e717d14d d135728b 90968895 d85569d0 85a97ab3 9a478b1e 75c98704 138b6ce0 72bf0238 c39db878 35916427 d5a5fb7c dfbd39b8 456c4398 e5a60099 fb140b89 dd52b07b 591b93ea 16f8419a 2762bcc4 76f1d897 2c0cd0a3 94fe65db f097e551 --- docs/ChangeLog | 55 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 55 insertions(+) diff --git a/docs/ChangeLog b/docs/ChangeLog index b1040d037db..ac4a434ce2a 100644 --- a/docs/ChangeLog +++ b/docs/ChangeLog @@ -1,3 +1,58 @@ +New in 2017.09: + + Fixes: + + Fixed NativeCall signature check for unsupported native types [4077842c] + + Fixed .made called on a Match on which .make was never called [5db5b1db] + + Fixed newlines after a failed test [b62b40f1] + + Fixed flattening of a typed hash [6cec6b72] + + Fixed iterator on pairs with Mu's [a5014fd0] + + Fixed Supply.batch with non-int elems and elems == 1 [98f9fffe][7d1ece80] + + Improved error message on nameless postfix `.::` [5969f21e] + + Fixed ::("GLOBAL") [1f6a782c] + + Refined merging of one() junctions [79604a88] + + Fixed error message with leaking variable name in FailGoal [ed4f6cc9] + + Implemented missing Instant.Instant [51709e01] + + Fixed thread safety issues with signal introspection [1f411693] + + Fixed thread safety issues in the `signal` sub [13b6a33c] + + Fixed thread safety of "foo{$x}bar" [59454b03] + + Fixed inability of `make`ing type objects [d0d105b8] + + Made Bool.enums consistent with Enumeration.enums [e7a58806] + + Fixed doubled path issue in IO::Notification.watch-path [2362dfd6] + + Disabled interactive REPL for non-TTY input [TODO] see nqp@5bec212 + + Additions: + + Added support for Str operations with Junctions [753c9a5e][7cd153f4] + [95a70ca3][0b19baf0][d2f31bb7][e18291e2][8b5d283c] + + Added support for Unicode 10 [64dd94c2] + + Added Thread.is-initial-thread method [59a2056a] + + Added output buffering for non-TTYs [44680029][4b02b8aa] + + Made temp and let on a Failure throw it [80a3255b] + + Made sure that open files are properly closed on exit [3c9cfdba] + [97853564][347da8e5][dd8d0d89] + + Added experimental Unicode Collation Algorithm [9b42484a] + + Build system: + + Made t/harness* use 6 TEST_JOBS by default [8019c15b] + + Added --ignore-errors option to Configure.pl [0bc1c877][1da075f9] + + Fixed `make test` without `make install` first [fb0b3eb5] + + Efficiency: + + Bump NQP/Moar to get Knuth-Morris-Pratt string search [593fa5f8] + + Made `Any ~ Str` and `Str ~ Any` about 25% faster [815faa35] + + Made index and eqat operations 2x faster [5ebbc5ba] + + Make all(@a), none(@a), one(@a) about 9x faster [51c3d86c] + + Various improvements to BUILDPLAN and BUILDALLPLAN [7da0c215] + [0ca5ffa4][760530a5] + + Internal: + + Simplified setting up auto-threading [8a0f6ac1] + + Streamlined Junction .defined, .Bool, .ACCEPTS [e8137b45] + + Added --no-merge option to t/harness5 to pass through STDERR [4af1d95c] + [84b40cf5] + + Various improvements to INTERPOLATE [215a5fa7][ea57cbec][c6aacafd] + [47439e69][4c25df74][fc632cd8] + + Some minor cleanup on R:I.FirstNThenSinkAll [9dbc3c50] + + Fixed --ll-exception to give full thread backtrace [0877278e] + + Various heap analyzer API changes [bfee5a1e] + + Streamlined exit / END phaser handling [1adacc72] + + Made junction optimizer only look at candidates [4de858a5] + + Assortment of low-level improvements [cbce6721][8a215876][9b42484a] + New in 2017.08: + Security: + Removed '.' and 'blib' from nqp's default module search paths [7e403724] From 532f70927800db362fade4c40b92b4c61c077b5c Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Wed, 13 Sep 2017 21:02:55 +0200 Subject: [PATCH 031/692] Oops, forgot to update the vivify shortcut check --- src/core/Mu.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/Mu.pm b/src/core/Mu.pm index 24296288615..5d8a73326fb 100644 --- a/src/core/Mu.pm +++ b/src/core/Mu.pm @@ -449,7 +449,7 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" ($task := nqp::atpos($bp,$i)), 0 ), - 13 + 10 ), nqp::getattr(self, nqp::atpos($task,1), From b706b843121b2b3548e893479058602250eddfda Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Wed, 13 Sep 2017 21:39:39 +0200 Subject: [PATCH 032/692] Make BUILDALLPLAN and BUILD_LEAST_DERIVED use same internal logic This might have some effect on "but role" code. --- src/core/Mu.pm | 253 ++++++++++++++++++++++++------------------------- 1 file changed, 122 insertions(+), 131 deletions(-) diff --git a/src/core/Mu.pm b/src/core/Mu.pm index 5d8a73326fb..3fff2ac9bd7 100644 --- a/src/core/Mu.pm +++ b/src/core/Mu.pm @@ -148,22 +148,16 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" # would get expensive. my $bp := nqp::findmethod(self.HOW,'BUILDALLPLAN')(self.HOW, self); my int $count = nqp::elems($bp); - my int $i = -1; - my $task; - my $build; - my int $code; - my int $int; - my num $num; - my str $str; + my int $i = -1; nqp::while( nqp::islt_i($i = nqp::add_i($i,1),$count), nqp::if( - nqp::istype(($task := nqp::atpos($bp,$i)),Callable), - nqp::if( # BUILD/TWEAK + nqp::istype((my $task := nqp::atpos($bp,$i)),Callable), + nqp::if( # BUILD/TWEAK nqp::istype( - ($build := nqp::if( + (my $build := nqp::if( nqp::elems($init), $task(self,|%attrinit), $task(self) @@ -173,9 +167,9 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" return $build ), - nqp::if( # not just calling - nqp::iseq_i(($code = nqp::atpos($task,0)),0), - nqp::if( # 0 + nqp::if( # not just calling + nqp::iseq_i((my int $code = nqp::atpos($task,0)),0), + nqp::if( # 0 nqp::existskey($init,nqp::atpos($task,2)), (nqp::getattr(self,nqp::atpos($task,1),nqp::atpos($task,3)) = %attrinit.AT-KEY(nqp::atpos($task,2))), @@ -183,7 +177,7 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" nqp::if( nqp::iseq_i($code,1), - nqp::unless( # 1 + nqp::unless( # 1 nqp::attrinited(self, nqp::atpos($task,1), nqp::atpos($task,2) @@ -199,23 +193,23 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" nqp::if( nqp::isle_i($code,4), - nqp::if( # 2,3,4 + nqp::if( # 2|3|4 nqp::existskey($init,nqp::atpos($task,2)), nqp::if( # can initialize nqp::iseq_i($code,2), - nqp::bindattr_i(self, # 2 + nqp::bindattr_i(self, # 2 nqp::atpos($task,1), nqp::atpos($task,3), nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,2))) ), nqp::if( nqp::iseq_i($code,3), - nqp::bindattr_n(self, # 3 + nqp::bindattr_n(self, # 3 nqp::atpos($task,1), nqp::atpos($task,3), nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,2))) ), - nqp::bindattr_s(self, # 4 + nqp::bindattr_s(self, # 4 nqp::atpos($task,1), nqp::atpos($task,3), nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,2))) @@ -226,8 +220,8 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" nqp::if( nqp::iseq_i($code,5), - nqp::if( # 5 - nqp::iseq_i($int = nqp::getattr_i(self, + nqp::if( # 5 + nqp::iseq_i(my $int = nqp::getattr_i(self, nqp::atpos($task,1), nqp::atpos($task,2) ), 0), @@ -240,8 +234,8 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" nqp::if( nqp::iseq_i($code,6), - nqp::if( # 6 - nqp::iseq_n($num = nqp::getattr_n(self, + nqp::if( # 6 + nqp::iseq_n(my num $num = nqp::getattr_n(self, nqp::atpos($task,1), nqp::atpos($task,2) ), 0e0), @@ -254,8 +248,8 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" nqp::if( nqp::iseq_i($code,7), - nqp::if( # 7 - nqp::isnull_s($str = nqp::getattr_s(self, + nqp::if( # 7 + nqp::isnull_s(my str $str = nqp::getattr_s(self, nqp::atpos($task,1), nqp::atpos($task,2) )), @@ -268,7 +262,7 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" nqp::if( nqp::iseq_i($code,8), - nqp::unless( # 8 + nqp::unless( # 8 nqp::attrinited(self, nqp::atpos($task,1), nqp::atpos($task,2) @@ -281,7 +275,7 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" nqp::if( nqp::iseq_i($code,9), - nqp::bindattr(self, # 9 + nqp::bindattr(self, # 9 nqp::atpos($task,1), nqp::atpos($task,2), (nqp::atpos($task,3)()) @@ -298,21 +292,15 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" my $bp := nqp::findmethod(self.HOW,'BUILDPLAN')(self.HOW,self); my int $count = nqp::elems($bp); my int $i = -1; - my $task; - my $build; - my int $code; - my int $int; - my num $num; - my str $str; nqp::while( nqp::islt_i($i = nqp::add_i($i,1),$count), nqp::if( - nqp::istype(($task := nqp::atpos($bp,$i)),Callable), + nqp::istype((my $task := nqp::atpos($bp,$i)),Callable), nqp::if( # BUILD/TWEAK nqp::istype( - ($build := nqp::if( + (my $build := nqp::if( nqp::elems($init), $task(self,|%attrinit), $task(self) @@ -322,15 +310,12 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" return $build ), - nqp::if( - nqp::iseq_i(($code = nqp::atpos($task,0)),0), + nqp::if( # not just calling + nqp::iseq_i((my int $code = nqp::atpos($task,0)),0), nqp::if( # 0 nqp::existskey($init,nqp::atpos($task,2)), (nqp::getattr(self,nqp::atpos($task,1),nqp::atpos($task,3)) - = nqp::decont( - %attrinit.AT-KEY(nqp::p6box_s(nqp::atpos($task,2))) - ) - ) + = %attrinit.AT-KEY(nqp::atpos($task,2))), ), nqp::if( @@ -350,116 +335,122 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" ), nqp::if( - nqp::iseq_i($code,2), - nqp::if( # 2 + nqp::isle_i($code,4), + nqp::if( # 2|3|4 nqp::existskey($init,nqp::atpos($task,2)), - nqp::bindattr_i(self, - nqp::atpos($task,1), - nqp::atpos($task,3), - nqp::decont(%attrinit.AT-KEY( - nqp::p6box_s(nqp::atpos($task,2)) - )) + nqp::if( # can initialize + nqp::iseq_i($code,2), + nqp::bindattr_i(self, # 2 + nqp::atpos($task,1), + nqp::atpos($task,3), + nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,2))) + ), + nqp::if( + nqp::iseq_i($code,3), + nqp::bindattr_n(self, # 3 + nqp::atpos($task,1), + nqp::atpos($task,3), + nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,2))) + ), + nqp::bindattr_s(self, # 4 + nqp::atpos($task,1), + nqp::atpos($task,3), + nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,2))) + ) + ) + ) + ), + + nqp::if( + nqp::iseq_i($code,5), + nqp::if( # 5 + nqp::iseq_i(my $int = nqp::getattr_i(self, + nqp::atpos($task,1), + nqp::atpos($task,2) + ), 0), + nqp::bindattr_i(self, + nqp::atpos($task,1), + nqp::atpos($task,2), + (nqp::atpos($task,3)(self,$int)) + ) + ), + + nqp::if( + nqp::iseq_i($code,6), + nqp::if( # 6 + nqp::iseq_n(my num $num = nqp::getattr_n(self, + nqp::atpos($task,1), + nqp::atpos($task,2) + ), 0e0), + nqp::bindattr_n(self, + nqp::atpos($task,1), + nqp::atpos($task,2), + (nqp::atpos($task,3)(self,$num)) ) ), nqp::if( - nqp::iseq_i($code,3), - nqp::if( # 3 - nqp::existskey($init,nqp::atpos($task,2)), - nqp::bindattr_n(self, + nqp::iseq_i($code,7), + nqp::if( # 7 + nqp::isnull_s(my str $str = nqp::getattr_s(self, nqp::atpos($task,1), - nqp::atpos($task,3), - nqp::decont(%attrinit.AT-KEY( - nqp::p6box_s(nqp::atpos($task,2)) - )) + nqp::atpos($task,2) + )), + nqp::bindattr_s(self, + nqp::atpos($task,1), + nqp::atpos($task,2), + (nqp::atpos($task,3)(self,$str)) ) ), + nqp::if( + nqp::iseq_i($code,8), + nqp::unless( # 8 + nqp::attrinited(self, + nqp::atpos($task,1), + nqp::atpos($task,2) + ), + X::Attribute::Required.new( + name => nqp::atpos($task,2), + why => nqp::atpos($task,3) + ).throw + ), + nqp::if( - nqp::iseq_i($code,4), - nqp::if( # 4 - nqp::existskey($init,nqp::atpos($task,2)), - nqp::bindattr_s(self, - nqp::atpos($task,1), - nqp::atpos($task,3), - nqp::decont(%attrinit.AT-KEY( - nqp::p6box_s(nqp::atpos($task,2)) - )) - ) + nqp::iseq_i($code,9), + nqp::bindattr(self, # 9 + nqp::atpos($task,1), + nqp::atpos($task,2), + (nqp::atpos($task,3)()) ), nqp::if( - nqp::iseq_i($code,5), - nqp::if( # 5 - nqp::iseq_i($int = nqp::getattr_i(self, + nqp::iseq_i($code,10), + # Force vivification, for the sake of meta-object + # mix-ins at compile time ending up with correctly + # shared containers. + nqp::stmts( # 10 + nqp::getattr(self, nqp::atpos($task,1), nqp::atpos($task,2) - ), 0), - nqp::bindattr_i(self, - nqp::atpos($task,1), - nqp::atpos($task,2), - (nqp::atpos($task,3)(self,$int)) - ) - ), - - nqp::if( - nqp::iseq_i($code,6), - nqp::if( # 6 - nqp::iseq_n($num = nqp::getattr_n(self, + ), + nqp::while( # 10's flock together + nqp::islt_i(($i = nqp::add_i($i,1)),$count) + && nqp::iseq_i( + nqp::atpos( + ($task := nqp::atpos($bp,$i)), + 0 + ),10 + ), + nqp::getattr(self, nqp::atpos($task,1), nqp::atpos($task,2) - ), 0e0), - nqp::bindattr_n(self, - nqp::atpos($task,1), - nqp::atpos($task,2), - (nqp::atpos($task,3)(self,$num)) ) ), - - nqp::if( - nqp::iseq_i($code,7), - nqp::if( # 7 - nqp::isnull_s($str = nqp::getattr_s(self, - nqp::atpos($task,1), - nqp::atpos($task,2) - )), - nqp::bindattr_s(self, - nqp::atpos($task,1), - nqp::atpos($task,2), - (nqp::atpos($task,3)(self,$str)) - ) - ), - - nqp::if( - nqp::iseq_i($code,10), - # Force vivification, for the sake of meta-object - # mix-ins at compile time ending up with correctly - # shared containers. - nqp::stmts( # 10 - nqp::getattr(self, - nqp::atpos($task,1), - nqp::atpos($task,2) - ), - nqp::while( # 10's flock together - nqp::islt_i( - ($i = nqp::add_i($i,1)), - $count - ) && nqp::iseq_i( - nqp::atpos( - ($task := nqp::atpos($bp,$i)), - 0 - ), - 10 - ), - nqp::getattr(self, - nqp::atpos($task,1), - nqp::atpos($task,2) - ) - ), - ($i = nqp::sub_i($i,1)) - ), - die("Invalid BUILD_LEAST_DERIVED plan") - ) + ($i = nqp::sub_i($i,1)) + ), + die("Invalid BUILD_LEAST_DERIVED plan") + ) )))))))))); self } From 963b28d1960b69486fe08dbc26e1483ad2dfcc63 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Wed, 13 Sep 2017 22:04:24 +0200 Subject: [PATCH 033/692] Make BUILDPLAN states order more logical - group all of the init / set default value states together - simplifies build plan creation - should not influence execution speed much - paves way for more optimizations in the future --- src/Perl6/Metamodel/BUILDPLAN.nqp | 48 ++++---- src/core/Mu.pm | 175 +++++++++++++++--------------- 2 files changed, 112 insertions(+), 111 deletions(-) diff --git a/src/Perl6/Metamodel/BUILDPLAN.nqp b/src/Perl6/Metamodel/BUILDPLAN.nqp index 3110441b131..a77bfe16534 100644 --- a/src/Perl6/Metamodel/BUILDPLAN.nqp +++ b/src/Perl6/Metamodel/BUILDPLAN.nqp @@ -10,16 +10,16 @@ role Perl6::Metamodel::BUILDPLAN { # further parameters. If it is an array, then the first element # of each array is an "op" # representing the task to perform: # code = call as method (for BUILD or TWEAK) - # 0 class name attr_name = try to find initialization value - # 1 class attr_name code = call default value closure if needed - # 2 class name attr_name = set a native int attribute - # 3 class name attr_name = set a native num attribute - # 4 class name attr_name = set a native str attribute - # 5 class attr_name code = call default value closure if needed, int attr - # 6 class attr_name code = call default value closure if needed, num attr - # 7 class attr_name code = call default value closure if needed, str attr - # 8 die if a required attribute is not present - # 9 class attr_name code = run attribute container initializer + # 0 class name attr_name = set attribute from init hash + # 1 class name attr_name = set a native int attribute from init hash + # 2 class name attr_name = set a native num attribute from init hash + # 3 class name attr_name = set a native str attribute from init hash + # 4 class attr_name code = call default value closure if needed + # 5 class attr_name code = call default value closure if needed, int attr + # 6 class attr_name code = call default value closure if needed, num attr + # 7 class attr_name code = call default value closure if needed, str attr + # 8 die if a required attribute is not present + # 9 class attr_name code = run attribute container initializer # 10 class attr_name = touch/vivify attribute if part of mixin method create_BUILDPLAN($obj) { # First, we'll create the build plan for just this class. @@ -55,15 +55,12 @@ role Perl6::Metamodel::BUILDPLAN { # need initializing. for @attrs { if $_.has_accessor { - my $attr_name := $_.name; - my $name := nqp::substr($attr_name, 2); - my $typespec := nqp::objprimspec($_.type); - if $typespec { - nqp::push(@plan,[nqp::add_i(1, $typespec), - $obj, $name, $attr_name]); - } else { - nqp::push(@plan,[0, $obj, $name, $attr_name]); - } + nqp::push(@plan,[ + nqp::add_i(0,nqp::objprimspec($_.type)), + $obj, + nqp::substr((my $attr_name := $_.name), 2), + $attr_name + ]); } } } @@ -81,13 +78,12 @@ role Perl6::Metamodel::BUILDPLAN { if nqp::can($_, 'build') { my $default := $_.build; if !nqp::isnull($default) && $default { - my $typespec := nqp::objprimspec($_.type); - if $typespec { - nqp::push(@plan,[nqp::add_i(4, $typespec), $obj, $_.name, $default]); - } - else { - nqp::push(@plan,[1, $obj, $_.name, $default]); - } + nqp::push(@plan,[ + nqp::add_i(4,nqp::objprimspec($_.type)), + $obj, + $_.name, + $default + ]); nqp::deletekey(%attrs_untouched, $_.name); } } diff --git a/src/core/Mu.pm b/src/core/Mu.pm index 3fff2ac9bd7..020bf0e8c85 100644 --- a/src/core/Mu.pm +++ b/src/core/Mu.pm @@ -168,54 +168,49 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" ), nqp::if( # not just calling - nqp::iseq_i((my int $code = nqp::atpos($task,0)),0), - nqp::if( # 0 - nqp::existskey($init,nqp::atpos($task,2)), - (nqp::getattr(self,nqp::atpos($task,1),nqp::atpos($task,3)) - = %attrinit.AT-KEY(nqp::atpos($task,2))), - ), - - nqp::if( - nqp::iseq_i($code,1), - nqp::unless( # 1 - nqp::attrinited(self, - nqp::atpos($task,1), - nqp::atpos($task,2) - ), - nqp::stmts( - (my \attr := nqp::getattr(self, + (my int $code = nqp::atpos($task,0)), + + nqp::if( # >0 + nqp::isle_i($code,3), + nqp::if( # 1|2|3 + nqp::existskey($init,nqp::atpos($task,2)), + nqp::if( # can initialize + nqp::iseq_i($code,1), + nqp::bindattr_i(self, # 1 nqp::atpos($task,1), - nqp::atpos($task,2) - )), - (attr = nqp::atpos($task,3)(self,attr)) - ) - ), - - nqp::if( - nqp::isle_i($code,4), - nqp::if( # 2|3|4 - nqp::existskey($init,nqp::atpos($task,2)), - nqp::if( # can initialize + nqp::atpos($task,3), + nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,2))) + ), + nqp::if( nqp::iseq_i($code,2), - nqp::bindattr_i(self, # 2 + nqp::bindattr_n(self, # 2 nqp::atpos($task,1), nqp::atpos($task,3), nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,2))) ), - nqp::if( - nqp::iseq_i($code,3), - nqp::bindattr_n(self, # 3 - nqp::atpos($task,1), - nqp::atpos($task,3), - nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,2))) - ), - nqp::bindattr_s(self, # 4 - nqp::atpos($task,1), - nqp::atpos($task,3), - nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,2))) - ) + nqp::bindattr_s(self, # 3 + nqp::atpos($task,1), + nqp::atpos($task,3), + nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,2))) ) ) + ) + ), + + nqp::if( + nqp::iseq_i($code,4), + nqp::unless( # 4 + nqp::attrinited(self, + nqp::atpos($task,1), + nqp::atpos($task,2) + ), + nqp::stmts( + (my \attr := nqp::getattr(self, + nqp::atpos($task,1), + nqp::atpos($task,2) + )), + (attr = nqp::atpos($task,3)(self,attr)) + ) ), nqp::if( @@ -280,8 +275,16 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" nqp::atpos($task,2), (nqp::atpos($task,3)()) ), - die("Invalid BUILDALL plan") - ))))))))), + die("Invalid BUILDALL plan"), + ))))))), + + nqp::if( # 0 + nqp::existskey($init,nqp::atpos($task,2)), + (nqp::getattr(self,nqp::atpos($task,1),nqp::atpos($task,3)) + = %attrinit.AT-KEY(nqp::atpos($task,2))), + ) + ) + ) ); self } @@ -311,54 +314,49 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" ), nqp::if( # not just calling - nqp::iseq_i((my int $code = nqp::atpos($task,0)),0), - nqp::if( # 0 - nqp::existskey($init,nqp::atpos($task,2)), - (nqp::getattr(self,nqp::atpos($task,1),nqp::atpos($task,3)) - = %attrinit.AT-KEY(nqp::atpos($task,2))), - ), - - nqp::if( - nqp::iseq_i($code,1), - nqp::unless( # 1 - nqp::attrinited(self, - nqp::atpos($task,1), - nqp::atpos($task,2) - ), - nqp::stmts( - (my \attr := nqp::getattr(self, + (my int $code = nqp::atpos($task,0)), + + nqp::if( # >0 + nqp::isle_i($code,3), + nqp::if( # 1|2|3 + nqp::existskey($init,nqp::atpos($task,2)), + nqp::if( # can initialize + nqp::iseq_i($code,1), + nqp::bindattr_i(self, # 1 nqp::atpos($task,1), - nqp::atpos($task,2) - )), - (attr = nqp::atpos($task,3)(self,attr)) - ) - ), - - nqp::if( - nqp::isle_i($code,4), - nqp::if( # 2|3|4 - nqp::existskey($init,nqp::atpos($task,2)), - nqp::if( # can initialize + nqp::atpos($task,3), + nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,2))) + ), + nqp::if( nqp::iseq_i($code,2), - nqp::bindattr_i(self, # 2 + nqp::bindattr_n(self, # 2 nqp::atpos($task,1), nqp::atpos($task,3), nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,2))) ), - nqp::if( - nqp::iseq_i($code,3), - nqp::bindattr_n(self, # 3 - nqp::atpos($task,1), - nqp::atpos($task,3), - nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,2))) - ), - nqp::bindattr_s(self, # 4 - nqp::atpos($task,1), - nqp::atpos($task,3), - nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,2))) - ) + nqp::bindattr_s(self, # 3 + nqp::atpos($task,1), + nqp::atpos($task,3), + nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,2))) ) ) + ) + ), + + nqp::if( + nqp::iseq_i($code,4), + nqp::unless( # 4 + nqp::attrinited(self, + nqp::atpos($task,1), + nqp::atpos($task,2) + ), + nqp::stmts( + (my \attr := nqp::getattr(self, + nqp::atpos($task,1), + nqp::atpos($task,2) + )), + (attr = nqp::atpos($task,3)(self,attr)) + ) ), nqp::if( @@ -423,7 +421,6 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" nqp::atpos($task,2), (nqp::atpos($task,3)()) ), - nqp::if( nqp::iseq_i($code,10), # Force vivification, for the sake of meta-object @@ -450,8 +447,16 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" ($i = nqp::sub_i($i,1)) ), die("Invalid BUILD_LEAST_DERIVED plan") - ) - )))))))))); + )))))))), + + nqp::if( # 0 + nqp::existskey($init,nqp::atpos($task,2)), + (nqp::getattr(self,nqp::atpos($task,1),nqp::atpos($task,3)) + = %attrinit.AT-KEY(nqp::atpos($task,2))), + ) + ) + ) + ); self } From c4043b068d3f170b601f6eb124db78c9ca699dfa Mon Sep 17 00:00:00 2001 From: Aleks-Daniel Jakimenko-Aleksejev Date: Thu, 14 Sep 2017 01:20:37 +0300 Subject: [PATCH 034/692] Log remaining commits Deliberately not logged: d0d105b8 db68552f c19e810e b62b40f1 76ccfd59 7f0367b7 9b527d0f 9f1d03e7 eb99bbc4 --- docs/ChangeLog | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/docs/ChangeLog b/docs/ChangeLog index ac4a434ce2a..28ae3ce4548 100644 --- a/docs/ChangeLog +++ b/docs/ChangeLog @@ -2,7 +2,6 @@ New in 2017.09: + Fixes: + Fixed NativeCall signature check for unsupported native types [4077842c] + Fixed .made called on a Match on which .make was never called [5db5b1db] - + Fixed newlines after a failed test [b62b40f1] + Fixed flattening of a typed hash [6cec6b72] + Fixed iterator on pairs with Mu's [a5014fd0] + Fixed Supply.batch with non-int elems and elems == 1 [98f9fffe][7d1ece80] @@ -14,10 +13,10 @@ New in 2017.09: + Fixed thread safety issues with signal introspection [1f411693] + Fixed thread safety issues in the `signal` sub [13b6a33c] + Fixed thread safety of "foo{$x}bar" [59454b03] - + Fixed inability of `make`ing type objects [d0d105b8] + Made Bool.enums consistent with Enumeration.enums [e7a58806] + Fixed doubled path issue in IO::Notification.watch-path [2362dfd6] - + Disabled interactive REPL for non-TTY input [TODO] see nqp@5bec212 + + Disabled interactive REPL for non-TTY input [b6a60236] + + Fixed various issues with Unicode Prepend characters [7f526c1e] + Additions: + Added support for Str operations with Junctions [753c9a5e][7cd153f4] [95a70ca3][0b19baf0][d2f31bb7][e18291e2][8b5d283c] @@ -27,18 +26,20 @@ New in 2017.09: + Made temp and let on a Failure throw it [80a3255b] + Made sure that open files are properly closed on exit [3c9cfdba] [97853564][347da8e5][dd8d0d89] - + Added experimental Unicode Collation Algorithm [9b42484a] + + Added Unicode Collation Algorithm [9b42484a][5f335065][ec18efa0] + Build system: + Made t/harness* use 6 TEST_JOBS by default [8019c15b] + Added --ignore-errors option to Configure.pl [0bc1c877][1da075f9] + Fixed `make test` without `make install` first [fb0b3eb5] + + Made Configure.pl refuse to work without ExtUtils::Command [3f4a9ffa] + Efficiency: + Bump NQP/Moar to get Knuth-Morris-Pratt string search [593fa5f8] + Made `Any ~ Str` and `Str ~ Any` about 25% faster [815faa35] + Made index and eqat operations 2x faster [5ebbc5ba] - + Make all(@a), none(@a), one(@a) about 9x faster [51c3d86c] - + Various improvements to BUILDPLAN and BUILDALLPLAN [7da0c215] - [0ca5ffa4][760530a5] + + Made all(@a), none(@a), one(@a) about 9x faster [51c3d86c] + + Various improvements to BUILDPLAN and BUILDALLPLAN [7da0c215][0ca5ffa4] + [760530a5][80e069a4][2574f883][b706b843][963b28d1][532f7092] + + Made object creation 25% faster in some cases [62fd5093] + Internal: + Simplified setting up auto-threading [8a0f6ac1] + Streamlined Junction .defined, .Bool, .ACCEPTS [e8137b45] From 340d8ed3bb4b45af85708771bea396cf862a7330 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Thu, 14 Sep 2017 11:50:43 +0200 Subject: [PATCH 035/692] Respect max_threads To a degree, anyway. We will always start one timer, general, and affinity thread if they're needed even if it takes us over the maximum number of threads. --- src/core/ThreadPoolScheduler.pm | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index e5ec26c9a14..75ef4f4dbfc 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -337,6 +337,10 @@ my class ThreadPoolScheduler does Scheduler { if $chosen-queue.elems > $threshold { # Add another one, unless another thread did too. $!state-lock.protect: { + if self!total-workers() >= $!max_threads { + scheduler-debug "Will not add extra affinity worker; hit $!max_threads thread limit"; + return $chosen-queue; + } if $cur-affinity-workers.elems != $!affinity-workers.elems { return $chosen-queue; } @@ -410,10 +414,19 @@ my class ThreadPoolScheduler does Scheduler { # a worker. # TODO Extra smarts here if $total-completed == 0 { - add-worker(); + if self!total-workers() < $!max_threads { + add-worker(); + } + else { + scheduler-debug "Will not add extra worker; hit $!max_threads thread limit"; + } } } + method !total-workers() { + $!general-workers.elems + $!timer-workers.elems + $!affinity-workers.elems + } + submethod BUILD( Int :$!initial_threads = 0, Int :$!max_threads = (%*ENV // 64).Int From c50d35a90e66346157b31cd92643c2a64e801c24 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Thu, 14 Sep 2017 11:51:41 +0200 Subject: [PATCH 036/692] Add extra timer workers as needed --- src/core/ThreadPoolScheduler.pm | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index 75ef4f4dbfc..85610d2962c 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -372,7 +372,6 @@ my class ThreadPoolScheduler does Scheduler { scheduler-debug "Added a general worker thread"; } sub add-timer-worker() { - scheduler-debug "Adding a timer worker"; $!state-lock.protect: { $!timer-workers := (|$!timer-workers, TimerWorker.new( queue => $!timer-queue, @@ -387,6 +386,10 @@ my class ThreadPoolScheduler does Scheduler { self!tweak-workers: $!general-queue, $!general-workers, &add-general-worker; } + if $!timer-queue.DEFINITE { + self!tweak-workers: $!timer-queue, $!timer-workers, + &add-timer-worker; + } CATCH { default { scheduler-debug .gist; From 683037be698d0bdc21b3c23588085b2d076d7a0a Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Thu, 14 Sep 2017 15:26:40 +0200 Subject: [PATCH 037/692] Start factoring CPU cores and usage into scheduler So that it can pick a better number of threads for the workoad. Now it only boosts threads beyond the number of CPU cores if detects very low resource usage in combination with a queue of work, which is suggestive of a deadlock that may be resolved by an extra thread. --- src/core/ThreadPoolScheduler.pm | 70 ++++++++++++++++++++++++++++----- 1 file changed, 60 insertions(+), 10 deletions(-) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index 85610d2962c..ecac0289cb9 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -358,10 +358,10 @@ my class ThreadPoolScheduler does Scheduler { # The supervisor sits in a loop, mostly sleeping. Each time it wakes up, # it takes stock of the current situation and decides whether or not to # add threads. + my constant SUPERVISION_INTERVAL = 0.005; method !maybe-start-supervisor() { unless $!supervisor.DEFINITE { $!supervisor = Thread.start(:app_lifetime, { - scheduler-debug "Supervisor started"; sub add-general-worker() { $!state-lock.protect: { $!general-workers := (|$!general-workers, GeneralWorker.new( @@ -380,15 +380,47 @@ my class ThreadPoolScheduler does Scheduler { } scheduler-debug "Added a timer worker thread"; } + + scheduler-debug "Supervisor started"; + my num $last-rusage-time = nqp::time_n; + my int $last-usage = self!getrusage-total(); + my num @last-utils; + my int $cpu-cores = nqp::cpucores(); + scheduler-debug "Supervisor thinks there are $cpu-cores CPU cores"; loop { - sleep 0.005; + # Wait until the next time we should check how things + # are. + sleep SUPERVISION_INTERVAL; + + # Work out the delta of CPU usage since last supervison + # and the time period that measurement spans. + my num $now = nqp::time_n; + my num $rusage-period = $now - $last-rusage-time; + $last-rusage-time = $now; + my int $current-usage = self!getrusage-total(); + my int $usage-delta = $current-usage - $last-usage; + $last-usage = $current-usage; + + # Scale this by the time between rusage calls and turn it + # into a per-core utilization percentage. + my num $normalized-delta = $usage-delta / $rusage-period; + my num $per-core = $normalized-delta / $cpu-cores; + my num $per-core-util = 100 * ($per-core / 1000000); + + # Since those values are noisy, average the last 5 to get + # a smoothed value. + @last-utils.shift if @last-utils == 5; + push @last-utils, $per-core-util; + my $smooth-per-core-util = [+](@last-utils) / @last-utils; + scheduler-debug "Per-core utilization (approx): $smooth-per-core-util%"; + if $!general-queue.DEFINITE { self!tweak-workers: $!general-queue, $!general-workers, - &add-general-worker; + &add-general-worker, $cpu-cores, $smooth-per-core-util; } if $!timer-queue.DEFINITE { self!tweak-workers: $!timer-queue, $!timer-workers, - &add-timer-worker; + &add-timer-worker, $cpu-cores, $smooth-per-core-util; } CATCH { default { @@ -400,7 +432,15 @@ my class ThreadPoolScheduler does Scheduler { } } - method !tweak-workers(\queue, \worker-list, &add-worker) { + method !getrusage-total() { + my \rusage = nqp::getrusage(); + nqp::atpos_i(rusage, nqp::const::RUSAGE_UTIME_SEC) * 1000000 + + nqp::atpos_i(rusage, nqp::const::RUSAGE_UTIME_MSEC) + + nqp::atpos_i(rusage, nqp::const::RUSAGE_STIME_SEC) * 1000000 + + nqp::atpos_i(rusage, nqp::const::RUSAGE_STIME_MSEC) + } + + method !tweak-workers(\queue, \worker-list, &add-worker, $cores, $per-core-util) { # If there's nothing in the queue, nothing could need an extra worker. return if queue.elems == 0; @@ -413,12 +453,22 @@ my class ThreadPoolScheduler does Scheduler { $total-completed += .take-completed; } - # Minimal heuristic: if nothing was completed since the last time, add - # a worker. - # TODO Extra smarts here + # If we didn't complete anything, then consider adding more threads. + my int $total-workers = self!total-workers(); if $total-completed == 0 { - if self!total-workers() < $!max_threads { - add-worker(); + if $total-workers < $!max_threads { + # There's something in the queue and we haven't completed it. + # If we are still below the CPU core count, just add a woker. + if $total-workers < $cores { + add-worker(); + } + + # Otherwise, consider utilization. If it's very little then a + # further thread may be needed for deadlock breaking. + elsif $per-core-util < 2 { + scheduler-debug "Heuristic deadlock situation detected"; + add-worker(); + } } else { scheduler-debug "Will not add extra worker; hit $!max_threads thread limit"; From 89b9ac7830bdc195cb303f5241641e0dbe0ebbde Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Thu, 14 Sep 2017 15:31:04 +0200 Subject: [PATCH 038/692] Correct typos; MasterDuke17++ --- src/core/ThreadPoolScheduler.pm | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index ecac0289cb9..a515771a7f3 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -139,11 +139,12 @@ my class ThreadPoolScheduler does Scheduler { # work, they may steal from timer threads. # * Timer worker threads are intended to handle time-based events. They # pull events from the time-sensitive queue, and they will not do any - # work stealing so as to ready and available for timer events. The + # work stealing so as to be ready and available for timer events. The # time-sensitive queue will only be returned when a queue is requested # with the :hint-time-sensitive named argument. Only one timer worker - # will be created on the first request such a queue; the supervisor will - # then monitor the time-sensitive queue length and add more if needed. + # will be created on the first request for such a queue; the supervisor + # will then monitor the time-sensitive queue length and add more if + # needed. # * Affinity worker threads each have their own queue. They are used when # a queue is requested and :hint-affinity is passed. These are useful # for things like Proc::Async and IO::Socket::Async, where events will From 7c18112c59d20413b82356e5c48b38d8a66fc7ea Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Thu, 14 Sep 2017 16:15:27 +0200 Subject: [PATCH 039/692] Never hand back queue in Scalar --- src/core/ThreadPoolScheduler.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index a515771a7f3..98e743afa6e 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -317,7 +317,7 @@ my class ThreadPoolScheduler does Scheduler { my $most-free-worker; $cur-affinity-workers.map: -> $cand { if $most-free-worker.DEFINITE { - my $queue = $cand.queue; + my $queue := $cand.queue; return $queue if $queue.elems == 0; if $cand.elems < $most-free-worker.queue.elems { $most-free-worker := $cand; @@ -330,7 +330,7 @@ my class ThreadPoolScheduler does Scheduler { # Otherwise, check if the queue beats the threshold to add another # worker thread. - my $chosen-queue = $most-free-worker.queue; + my $chosen-queue := $most-free-worker.queue; my $queue-elems = $chosen-queue.elems; my $threshold = @affinity-add-thresholds[ ($cur-affinity-workers.elems max @affinity-add-thresholds) - 1 From c285b489c6629ccdf0c4cb11d2d695b9ef1f890c Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Thu, 14 Sep 2017 16:15:43 +0200 Subject: [PATCH 040/692] Consistently use binding on $!affinity-workers --- src/core/ThreadPoolScheduler.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index 98e743afa6e..c8745a2594a 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -345,8 +345,8 @@ my class ThreadPoolScheduler does Scheduler { if $cur-affinity-workers.elems != $!affinity-workers.elems { return $chosen-queue; } - my $new-worker = AffinityWorker.new(scheduler => self); - $!affinity-workers = (|$!affinity-workers, $new-worker); + my $new-worker := AffinityWorker.new(scheduler => self); + $!affinity-workers := (|$!affinity-workers, $new-worker); scheduler-debug "Added an affinity worker thread"; $new-worker.queue } From 7fcab1067de4757bfdf2fdd1c66893ce4ab06e1b Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Thu, 14 Sep 2017 16:16:04 +0200 Subject: [PATCH 041/692] More typo fixes; MasterDuke17++ --- src/core/ThreadPoolScheduler.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index c8745a2594a..0c2074992d3 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -393,7 +393,7 @@ my class ThreadPoolScheduler does Scheduler { # are. sleep SUPERVISION_INTERVAL; - # Work out the delta of CPU usage since last supervison + # Work out the delta of CPU usage since last supervision # and the time period that measurement spans. my num $now = nqp::time_n; my num $rusage-period = $now - $last-rusage-time; @@ -459,7 +459,7 @@ my class ThreadPoolScheduler does Scheduler { if $total-completed == 0 { if $total-workers < $!max_threads { # There's something in the queue and we haven't completed it. - # If we are still below the CPU core count, just add a woker. + # If we are still below the CPU core count, just add a worker. if $total-workers < $cores { add-worker(); } From b5605c2dd6d361b705a59136c8ad641f245a5da5 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Thu, 14 Sep 2017 16:26:58 +0200 Subject: [PATCH 042/692] Fix affinity worker threshold logic Gets rid of a warning it very rightly produced, which showed up the problem --- src/core/ThreadPoolScheduler.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index 0c2074992d3..7d9a842a685 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -333,7 +333,7 @@ my class ThreadPoolScheduler does Scheduler { my $chosen-queue := $most-free-worker.queue; my $queue-elems = $chosen-queue.elems; my $threshold = @affinity-add-thresholds[ - ($cur-affinity-workers.elems max @affinity-add-thresholds) - 1 + ($cur-affinity-workers.elems min @affinity-add-thresholds) - 1 ]; if $chosen-queue.elems > $threshold { # Add another one, unless another thread did too. From de311f46a98f13a5b0211d2585fbd9b17ce1bf2c Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Thu, 14 Sep 2017 16:54:20 +0200 Subject: [PATCH 043/692] Add RAKUDO_SCHEDULER_DEBUG_STATUS env var Which turns on output of regular status info, at the moment just the calculated per-core utilization. This makes RAKUDO_SCHEDULER_DEBUG just contain information about what kinds of new threads have been created, which got hard to find among all the regular output made with each supervision. --- src/core/ThreadPoolScheduler.pm | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index 7d9a842a685..308d50ea2c7 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -6,11 +6,17 @@ my class ThreadPoolScheduler does Scheduler { # Scheduler debug, controlled by an environment variable. my $scheduler-debug = so %*ENV; + my $scheduler-debug-status = so %*ENV; sub scheduler-debug($message) { if $scheduler-debug { note "[SCHEDULER] $message"; } } + sub scheduler-debug-status($message) { + if $scheduler-debug-status { + note "[SCHEDULER] $message"; + } + } # Infrastructure for non-blocking `await` for code running on the # scheduler. @@ -413,7 +419,7 @@ my class ThreadPoolScheduler does Scheduler { @last-utils.shift if @last-utils == 5; push @last-utils, $per-core-util; my $smooth-per-core-util = [+](@last-utils) / @last-utils; - scheduler-debug "Per-core utilization (approx): $smooth-per-core-util%"; + scheduler-debug-status "Per-core utilization (approx): $smooth-per-core-util%"; if $!general-queue.DEFINITE { self!tweak-workers: $!general-queue, $!general-workers, From 3b98fb9e396d040a8cb2c32d23cee54a5e88f878 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Thu, 14 Sep 2017 17:05:50 +0200 Subject: [PATCH 044/692] Supervising 100 times a second is likely enough --- src/core/ThreadPoolScheduler.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index 308d50ea2c7..386a446ee2f 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -365,7 +365,7 @@ my class ThreadPoolScheduler does Scheduler { # The supervisor sits in a loop, mostly sleeping. Each time it wakes up, # it takes stock of the current situation and decides whether or not to # add threads. - my constant SUPERVISION_INTERVAL = 0.005; + my constant SUPERVISION_INTERVAL = 0.01; method !maybe-start-supervisor() { unless $!supervisor.DEFINITE { $!supervisor = Thread.start(:app_lifetime, { From 596611c8fdc3baf119bc94a8ea30efc0a12cf673 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Thu, 14 Sep 2017 18:12:27 +0200 Subject: [PATCH 045/692] Fix non-MoarVM build with new scheduler Dropping the atomics gives slightly less accurate data, but should not cause any bad behaviors. --- src/core/ThreadPoolScheduler.pm | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index 386a446ee2f..499086f4c6d 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -163,15 +163,26 @@ my class ThreadPoolScheduler does Scheduler { # Completed is the number of tasks completed since the last time the # supervisor checked in. +#?if moar has atomicint $.completed; +#?endif +#?if !moar + has int $.completed; +#?endif # Working is 1 if the worker is currently busy, 0 if not. has int $.working; # Resets the completed to zero. method take-completed() { +#?if moar my atomicint $taken; cas $!completed, -> atomicint $current { $taken = $current; 0 } +#?endif +#?if !moar + my int $taken = $!completed; + $!completed = 0; +#?endif $taken } @@ -198,7 +209,12 @@ my class ThreadPoolScheduler does Scheduler { } }); $!working = 0; +#?if moar $!completed⚛++; +#?endif +#?if !moar + $!completed++; +#?endif } } my class GeneralWorker does Worker { From b7ab48ee1548e55441035ee10e945a7414e300bc Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Thu, 14 Sep 2017 20:24:33 +0200 Subject: [PATCH 046/692] Attribute.required can be anything, not just int --- src/core/Attribute.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/Attribute.pm b/src/core/Attribute.pm index 93a41b07b1a..113b8b3a252 100644 --- a/src/core/Attribute.pm +++ b/src/core/Attribute.pm @@ -12,7 +12,7 @@ my class Attribute { # declared in BOOTSTRAP # has int $!positional_delegate; # has int $!associative_delegate; # has Mu $!why; - # has int $!required; + # has $!required; # has Mu $!container_initializer; method compose(Mu $package, :$compiler_services) { From dea0a08545ab172836f96ba6f5c4129734798a35 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Thu, 14 Sep 2017 20:25:40 +0200 Subject: [PATCH 047/692] Streamline BUILDPLAN a little more - settable attributes with default are now handled in a single task - this saves one list with 3 entries per attribute - also has a small runtime benefit (in the order 2%) - also handles the task *without* default - is required check task now emitted after each settable task without default - because another default could set the attrinited of the attribute - which would cause a false-positive on the is required check This causes one test to fail: test 89 in S02-types/int-uint.t . Same code works ok outside of test-file, so not sure what is going on there. More eyes on this would be appreciated. --- src/Perl6/Metamodel/BUILDPLAN.nqp | 49 ++- src/core/Mu.pm | 564 ++++++++++++++++++------------ 2 files changed, 381 insertions(+), 232 deletions(-) diff --git a/src/Perl6/Metamodel/BUILDPLAN.nqp b/src/Perl6/Metamodel/BUILDPLAN.nqp index a77bfe16534..4107a90fd12 100644 --- a/src/Perl6/Metamodel/BUILDPLAN.nqp +++ b/src/Perl6/Metamodel/BUILDPLAN.nqp @@ -10,10 +10,10 @@ role Perl6::Metamodel::BUILDPLAN { # further parameters. If it is an array, then the first element # of each array is an "op" # representing the task to perform: # code = call as method (for BUILD or TWEAK) - # 0 class name attr_name = set attribute from init hash - # 1 class name attr_name = set a native int attribute from init hash - # 2 class name attr_name = set a native num attribute from init hash - # 3 class name attr_name = set a native str attribute from init hash + # 0 class name attr_name = set attribute from init hash|default + # 1 class name attr_name = set native int attribute from init|default + # 2 class name attr_name = set native num attribute from init|default + # 3 class name attr_name = set native str attribute from init|default # 4 class attr_name code = call default value closure if needed # 5 class attr_name code = call default value closure if needed, int attr # 6 class attr_name code = call default value closure if needed, num attr @@ -30,6 +30,7 @@ role Perl6::Metamodel::BUILDPLAN { # do not touch in any of the BUILDPLAN so we can spit out vivify # ops at the end. my %attrs_untouched; + my %attrs_with_default; for @attrs { if nqp::can($_, 'container_initializer') { my $ci := $_.container_initializer; @@ -48,6 +49,14 @@ role Perl6::Metamodel::BUILDPLAN { if !nqp::isnull($build) && $build { # We'll call the custom one. nqp::push(@plan,$build); + + # Ensure that any required attributes are set + for @attrs { + if nqp::can($_, 'required') && $_.required { + nqp::push(@plan,[8, $obj, $_.name, $_.required]); + nqp::deletekey(%attrs_untouched, $_.name); + } + } } else { # No custom BUILD. Rather than having an actual BUILD @@ -58,24 +67,36 @@ role Perl6::Metamodel::BUILDPLAN { nqp::push(@plan,[ nqp::add_i(0,nqp::objprimspec($_.type)), $obj, - nqp::substr((my $attr_name := $_.name), 2), - $attr_name + $_.name, + nqp::substr($_.name, 2) ]); + + # add default setting logic if available + if nqp::can($_, 'build') { + my $default := $_.build; + if !nqp::isnull($default) && $default { + %attrs_with_default{$_.name} := NQPMu; + @plan[@plan - 1][4] := $default; + } + } } - } - } - # Ensure that any required attributes are set - for @attrs { - if nqp::can($_, 'required') && $_.required { - nqp::push(@plan,[8, $obj, $_.name, $_.required]); - nqp::deletekey(%attrs_untouched, $_.name); + if nqp::can($_, 'required') && $_.required { + unless nqp::existskey(%attrs_with_default,$_.name) { + # check immediately after fetching + nqp::push(@plan,[8, $obj, $_.name, $_.required]); + nqp::deletekey(%attrs_untouched, $_.name); + } + } } } # Check if there's any default values to put in place. for @attrs { - if nqp::can($_, 'build') { + if nqp::existskey(%attrs_with_default,$_.name) { + # already in init logic + } + elsif nqp::can($_, 'build') { my $default := $_.build; if !nqp::isnull($default) && $default { nqp::push(@plan,[ diff --git a/src/core/Mu.pm b/src/core/Mu.pm index 020bf0e8c85..a6df9d45c4d 100644 --- a/src/core/Mu.pm +++ b/src/core/Mu.pm @@ -154,135 +154,199 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" nqp::islt_i($i = nqp::add_i($i,1),$count), nqp::if( - nqp::istype((my $task := nqp::atpos($bp,$i)),Callable), - nqp::if( # BUILD/TWEAK - nqp::istype( - (my $build := nqp::if( - nqp::elems($init), - $task(self,|%attrinit), - $task(self) - )), - Failure - ), - return $build - ), - - nqp::if( # not just calling + nqp::islist(my $task := nqp::atpos($bp,$i)), + nqp::if( # got stuff to do (my int $code = nqp::atpos($task,0)), - nqp::if( # >0 - nqp::isle_i($code,3), - nqp::if( # 1|2|3 - nqp::existskey($init,nqp::atpos($task,2)), - nqp::if( # can initialize - nqp::iseq_i($code,1), - nqp::bindattr_i(self, # 1 - nqp::atpos($task,1), - nqp::atpos($task,3), - nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,2))) - ), - nqp::if( - nqp::iseq_i($code,2), - nqp::bindattr_n(self, # 2 - nqp::atpos($task,1), - nqp::atpos($task,3), - nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,2))) + nqp::if( # >0 + nqp::iseq_i($code,1), + nqp::bindattr_i(self, # 1 + nqp::atpos($task,1), + nqp::atpos($task,2), + nqp::if( + nqp::existskey($init,nqp::atpos($task,3)), + nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,3))), + nqp::if( # no init + nqp::iseq_i(nqp::elems($task),5), + nqp::atpos($task,4)(self, # but a default + nqp::getattr_i(self, + nqp::atpos($task,1), + nqp::atpos($task,2) + ) ), - nqp::bindattr_s(self, # 3 - nqp::atpos($task,1), - nqp::atpos($task,3), - nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,2))) - ) + 0 # no default ) ) ), - nqp::if( - nqp::iseq_i($code,4), - nqp::unless( # 4 - nqp::attrinited(self, - nqp::atpos($task,1), - nqp::atpos($task,2) - ), - nqp::stmts( - (my \attr := nqp::getattr(self, - nqp::atpos($task,1), - nqp::atpos($task,2) - )), - (attr = nqp::atpos($task,3)(self,attr)) + nqp::if( # > 1 + nqp::iseq_i($code,2), + nqp::bindattr_n(self, # 2 + nqp::atpos($task,1), + nqp::atpos($task,2), + nqp::if( + nqp::existskey($init,nqp::atpos($task,3)), + nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,3))), + nqp::if( # no init + nqp::iseq_i(nqp::elems($task),5), + nqp::atpos($task,4)(self, # but a default + nqp::getattr_n(self, + nqp::atpos($task,1), + nqp::atpos($task,2) + ) + ), + 0e0 # no default + ) ) ), - nqp::if( - nqp::iseq_i($code,5), - nqp::if( # 5 - nqp::iseq_i(my $int = nqp::getattr_i(self, - nqp::atpos($task,1), - nqp::atpos($task,2) - ), 0), - nqp::bindattr_i(self, - nqp::atpos($task,1), - nqp::atpos($task,2), - (nqp::atpos($task,3)(self,$int)) + nqp::if( # > 2 + nqp::iseq_i($code,3), + nqp::bindattr_s(self, # 3 + nqp::atpos($task,1), + nqp::atpos($task,2), + nqp::if( + nqp::existskey($init,nqp::atpos($task,3)), + nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,3))), + nqp::if( # no init + nqp::iseq_i(nqp::elems($task),5), + nqp::atpos($task,4)(self, # but a default + nqp::getattr_s(self, + nqp::atpos($task,1), + nqp::atpos($task,2) + ) + ), + "" # no default + ) ) ), - nqp::if( - nqp::iseq_i($code,6), - nqp::if( # 6 - nqp::iseq_n(my num $num = nqp::getattr_n(self, + nqp::if( # > 3 + nqp::iseq_i($code,4), + nqp::unless( # 4 + nqp::attrinited(self, nqp::atpos($task,1), nqp::atpos($task,2) - ), 0e0), - nqp::bindattr_n(self, + ), + nqp::getattr(self, # not initialized yet nqp::atpos($task,1), - nqp::atpos($task,2), - (nqp::atpos($task,3)(self,$num)) + nqp::atpos($task,2) + ) = nqp::atpos($task,3)(self, + nqp::getattr(self, + nqp::atpos($task,1), + nqp::atpos($task,2) + ) ) ), - nqp::if( - nqp::iseq_i($code,7), - nqp::if( # 7 - nqp::isnull_s(my str $str = nqp::getattr_s(self, + nqp::if( # > 4 + nqp::iseq_i($code,5), + nqp::if( # 5 + nqp::iseq_i(my $int = nqp::getattr_i(self, nqp::atpos($task,1), nqp::atpos($task,2) - )), - nqp::bindattr_s(self, + ), 0), + nqp::bindattr_i(self, # not initialized yet nqp::atpos($task,1), nqp::atpos($task,2), - (nqp::atpos($task,3)(self,$str)) + nqp::atpos($task,3)(self,$int) ) ), - nqp::if( - nqp::iseq_i($code,8), - nqp::unless( # 8 - nqp::attrinited(self, - nqp::atpos($task,1), - nqp::atpos($task,2) + nqp::if( # > 5 + nqp::iseq_i($code,6), + nqp::if( # 6 + nqp::iseq_n(my num $num = nqp::getattr_n(self, + nqp::atpos($task,1), + nqp::atpos($task,2) + ), 0e0), + nqp::bindattr_n(self, # not initialized yet + nqp::atpos($task,1), + nqp::atpos($task,2), + nqp::atpos($task,3)(self,$num) + ) ), - X::Attribute::Required.new( - name => nqp::atpos($task,2), - why => nqp::atpos($task,3) - ).throw - ), - nqp::if( - nqp::iseq_i($code,9), - nqp::bindattr(self, # 9 - nqp::atpos($task,1), - nqp::atpos($task,2), - (nqp::atpos($task,3)()) - ), - die("Invalid BUILDALL plan"), - ))))))), + nqp::if( # > 6 + nqp::iseq_i($code,7), + nqp::if( # 7 + nqp::isnull_s(my str $str = nqp::getattr_s(self, + nqp::atpos($task,1), + nqp::atpos($task,2) + )), + nqp::bindattr_s(self, # not initialized yet + nqp::atpos($task,1), + nqp::atpos($task,2), + (nqp::atpos($task,3)(self,$str)) + ) + ), + + nqp::if( # > 7 + nqp::iseq_i($code,8), + nqp::unless( # 8 + nqp::attrinited(self, + nqp::atpos($task,1), + nqp::atpos($task,2) + ), + X::Attribute::Required.new( # missing init + name => nqp::atpos($task,2), + why => nqp::atpos($task,3) + ).throw + ), + + nqp::if( # > 8 + nqp::iseq_i($code,9), + nqp::bindattr(self, # 9 + nqp::atpos($task,1), + nqp::atpos($task,2), + (nqp::atpos($task,3)()) + ), + die("Invalid BUILDALL plan") + ) + ) + ) + ) + ) + ) + ) + ) + ), - nqp::if( # 0 - nqp::existskey($init,nqp::atpos($task,2)), - (nqp::getattr(self,nqp::atpos($task,1),nqp::atpos($task,3)) - = %attrinit.AT-KEY(nqp::atpos($task,2))), + nqp::if( # 0 + nqp::existskey($init,nqp::atpos($task,3)), + (nqp::getattr(self,nqp::atpos($task,1),nqp::atpos($task,2)) + = %attrinit.AT-KEY(nqp::atpos($task,3))), + nqp::if( # no init + nqp::iseq_i(nqp::elems($task),5), + nqp::unless( # but has default + nqp::attrinited(self, + nqp::atpos($task,1), + nqp::atpos($task,2) + ), + nqp::getattr(self, # didn't init yet + nqp::atpos($task,1), + nqp::atpos($task,2) + ) = nqp::atpos($task,4)(self, + nqp::getattr(self, + nqp::atpos($task,1), + nqp::atpos($task,2) + ) + ) + ) + ) ) + ), + + nqp::if( # just call BUILD/TWEAK + nqp::istype( + (my $build := nqp::if( + nqp::elems($init), + $task(self,|%attrinit), + $task(self) + )), + Failure + ), + return $build ) ) ); @@ -300,160 +364,224 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" nqp::islt_i($i = nqp::add_i($i,1),$count), nqp::if( - nqp::istype((my $task := nqp::atpos($bp,$i)),Callable), - nqp::if( # BUILD/TWEAK - nqp::istype( - (my $build := nqp::if( - nqp::elems($init), - $task(self,|%attrinit), - $task(self) - )), - Failure - ), - return $build - ), - - nqp::if( # not just calling + nqp::islist(my $task := nqp::atpos($bp,$i)), + nqp::if( # got stuff to do (my int $code = nqp::atpos($task,0)), - nqp::if( # >0 - nqp::isle_i($code,3), - nqp::if( # 1|2|3 - nqp::existskey($init,nqp::atpos($task,2)), - nqp::if( # can initialize - nqp::iseq_i($code,1), - nqp::bindattr_i(self, # 1 - nqp::atpos($task,1), - nqp::atpos($task,3), - nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,2))) - ), - nqp::if( - nqp::iseq_i($code,2), - nqp::bindattr_n(self, # 2 - nqp::atpos($task,1), - nqp::atpos($task,3), - nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,2))) + nqp::if( # >0 + nqp::iseq_i($code,1), + nqp::bindattr_i(self, # 1 + nqp::atpos($task,1), + nqp::atpos($task,2), + nqp::if( + nqp::existskey($init,nqp::atpos($task,3)), + nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,3))), + nqp::if( # no init + nqp::iseq_i(nqp::elems($task),5), + nqp::atpos($task,4)(self, # but a default + nqp::getattr_i(self, + nqp::atpos($task,1), + nqp::atpos($task,2) + ) ), - nqp::bindattr_s(self, # 3 - nqp::atpos($task,1), - nqp::atpos($task,3), - nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,2))) - ) + 0 # no default ) ) ), - nqp::if( - nqp::iseq_i($code,4), - nqp::unless( # 4 - nqp::attrinited(self, - nqp::atpos($task,1), - nqp::atpos($task,2) - ), - nqp::stmts( - (my \attr := nqp::getattr(self, - nqp::atpos($task,1), - nqp::atpos($task,2) - )), - (attr = nqp::atpos($task,3)(self,attr)) + nqp::if( # > 1 + nqp::iseq_i($code,2), + nqp::bindattr_n(self, # 2 + nqp::atpos($task,1), + nqp::atpos($task,2), + nqp::if( + nqp::existskey($init,nqp::atpos($task,3)), + nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,3))), + nqp::if( # no init + nqp::iseq_i(nqp::elems($task),5), + nqp::atpos($task,4)(self, # but a default + nqp::getattr_n(self, + nqp::atpos($task,1), + nqp::atpos($task,2) + ) + ), + 0e0 # no default + ) ) ), - nqp::if( - nqp::iseq_i($code,5), - nqp::if( # 5 - nqp::iseq_i(my $int = nqp::getattr_i(self, - nqp::atpos($task,1), - nqp::atpos($task,2) - ), 0), - nqp::bindattr_i(self, - nqp::atpos($task,1), - nqp::atpos($task,2), - (nqp::atpos($task,3)(self,$int)) + nqp::if( # > 2 + nqp::iseq_i($code,3), + nqp::bindattr_s(self, # 3 + nqp::atpos($task,1), + nqp::atpos($task,2), + nqp::if( + nqp::existskey($init,nqp::atpos($task,3)), + nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,3))), + nqp::if( # no init + nqp::iseq_i(nqp::elems($task),5), + nqp::atpos($task,4)(self, # but a default + nqp::getattr_s(self, + nqp::atpos($task,1), + nqp::atpos($task,2) + ) + ), + "" # no default + ) ) ), - nqp::if( - nqp::iseq_i($code,6), - nqp::if( # 6 - nqp::iseq_n(my num $num = nqp::getattr_n(self, + nqp::if( # > 3 + nqp::iseq_i($code,4), + nqp::unless( # 4 + nqp::attrinited(self, nqp::atpos($task,1), nqp::atpos($task,2) - ), 0e0), - nqp::bindattr_n(self, + ), + nqp::getattr(self, # not initialized yet nqp::atpos($task,1), - nqp::atpos($task,2), - (nqp::atpos($task,3)(self,$num)) + nqp::atpos($task,2) + ) = nqp::atpos($task,3)(self, + nqp::getattr(self, + nqp::atpos($task,1), + nqp::atpos($task,2) + ) ) ), - nqp::if( - nqp::iseq_i($code,7), - nqp::if( # 7 - nqp::isnull_s(my str $str = nqp::getattr_s(self, + nqp::if( # > 4 + nqp::iseq_i($code,5), + nqp::if( # 5 + nqp::iseq_i(my $int = nqp::getattr_i(self, nqp::atpos($task,1), nqp::atpos($task,2) - )), - nqp::bindattr_s(self, + ), 0), + nqp::bindattr_i(self, # not initialized yet nqp::atpos($task,1), nqp::atpos($task,2), - (nqp::atpos($task,3)(self,$str)) + nqp::atpos($task,3)(self,$int) ) ), - nqp::if( - nqp::iseq_i($code,8), - nqp::unless( # 8 - nqp::attrinited(self, - nqp::atpos($task,1), - nqp::atpos($task,2) + nqp::if( # > 5 + nqp::iseq_i($code,6), + nqp::if( # 6 + nqp::iseq_n(my num $num = nqp::getattr_n(self, + nqp::atpos($task,1), + nqp::atpos($task,2) + ), 0e0), + nqp::bindattr_n(self, # not initialized yet + nqp::atpos($task,1), + nqp::atpos($task,2), + nqp::atpos($task,3)(self,$num) + ) ), - X::Attribute::Required.new( - name => nqp::atpos($task,2), - why => nqp::atpos($task,3) - ).throw - ), - nqp::if( - nqp::iseq_i($code,9), - nqp::bindattr(self, # 9 - nqp::atpos($task,1), - nqp::atpos($task,2), - (nqp::atpos($task,3)()) - ), - nqp::if( - nqp::iseq_i($code,10), - # Force vivification, for the sake of meta-object - # mix-ins at compile time ending up with correctly - # shared containers. - nqp::stmts( # 10 - nqp::getattr(self, + nqp::if( # > 6 + nqp::iseq_i($code,7), + nqp::if( # 7 + nqp::isnull_s(my str $str = nqp::getattr_s(self, nqp::atpos($task,1), nqp::atpos($task,2) - ), - nqp::while( # 10's flock together - nqp::islt_i(($i = nqp::add_i($i,1)),$count) - && nqp::iseq_i( - nqp::atpos( - ($task := nqp::atpos($bp,$i)), - 0 - ),10 - ), - nqp::getattr(self, + )), + nqp::bindattr_s(self, # not initialized yet + nqp::atpos($task,1), + nqp::atpos($task,2), + (nqp::atpos($task,3)(self,$str)) + ) + ), + + nqp::if( # > 7 + nqp::iseq_i($code,8), + nqp::unless( # 8 + nqp::attrinited(self, nqp::atpos($task,1), nqp::atpos($task,2) - ) + ), + X::Attribute::Required.new( # missing init + name => nqp::atpos($task,2), + why => nqp::atpos($task,3) + ).throw ), - ($i = nqp::sub_i($i,1)) - ), - die("Invalid BUILD_LEAST_DERIVED plan") - )))))))), - nqp::if( # 0 - nqp::existskey($init,nqp::atpos($task,2)), - (nqp::getattr(self,nqp::atpos($task,1),nqp::atpos($task,3)) - = %attrinit.AT-KEY(nqp::atpos($task,2))), + nqp::if( # > 8 + nqp::iseq_i($code,9), + nqp::bindattr(self, # 9 + nqp::atpos($task,1), + nqp::atpos($task,2), + (nqp::atpos($task,3)()) + ), + + nqp::if( # > 9 + nqp::iseq_i($code,10), +# Force vivification, for the sake of meta-object mix-ins at compile time +# ending up with correctly shared containers. + nqp::stmts( # 10 + nqp::getattr(self, + nqp::atpos($task,1), + nqp::atpos($task,2) + ), + nqp::while( # 10's flock together + nqp::islt_i( + ($i = nqp::add_i($i,1)), + $count + ) && nqp::islist( + ($task := nqp::atpos($bp,$i)) + ) && nqp::iseq_i(nqp::atpos($task,0),10), + nqp::getattr(self, + nqp::atpos($task,1), + nqp::atpos($task,2) + ) + ), + ($i = nqp::sub_i($i,1)) + ), + die("Invalid BUILD_LEAST_DERIVED plan") + ) + ) + ) + ) + ) + ) + ) + ) + ) + ), + + nqp::if( # 0 + nqp::existskey($init,nqp::atpos($task,3)), + (nqp::getattr(self,nqp::atpos($task,1),nqp::atpos($task,2)) + = %attrinit.AT-KEY(nqp::atpos($task,3))), + nqp::if( # no init + nqp::iseq_i(nqp::elems($task),5), + nqp::unless( # but has default + nqp::attrinited(self, + nqp::atpos($task,1), + nqp::atpos($task,2) + ), + nqp::getattr(self, # didn't init yet + nqp::atpos($task,1), + nqp::atpos($task,2) + ) = nqp::atpos($task,4)(self, + nqp::getattr(self, + nqp::atpos($task,1), + nqp::atpos($task,2) + ) + ) + ) + ) ) + ), + + nqp::if( # just call BUILD/TWEAK + nqp::istype( + (my $build := nqp::if( + nqp::elems($init), + $task(self,|%attrinit), + $task(self) + )), + Failure + ), + return $build ) ) ); From 7ba9b7cd6f65032564b369131872f8e796f1fbd3 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Thu, 14 Sep 2017 18:52:24 +0000 Subject: [PATCH 048/692] Shorten signature of a method The actual params aren't used and aren't needed, but we still need a bit of params to make the method more specific than the one from the role. See also: https://github.com/rakudo/rakudo/pull/1154 https://irclog.perlgeek.de/perl6-dev/2017-09-14#i_15164490 --- src/core/Exception.pm | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/core/Exception.pm b/src/core/Exception.pm index 89bb28f244e..599f2d10867 100644 --- a/src/core/Exception.pm +++ b/src/core/Exception.pm @@ -1902,7 +1902,11 @@ my class X::Package::Stubbed does X::Comp { "The following packages were stubbed but not defined:\n " ~ @.packages.join("\n "); } - multi method gist(::?CLASS:D: :$sorry = True, :$expect = True) { + + # The unnamed named param is here so this candidate, rather than + # the one from X::Comp is used. (is it a bug that this is needed? + # No idea: https://irclog.perlgeek.de/perl6-dev/2017-09-14#i_15164569 ) + multi method gist(::?CLASS:D: :$) { $.message; } } From 06e20f80c9d3ddb8a4facdbc3fb4268171516b56 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Thu, 14 Sep 2017 18:55:21 +0000 Subject: [PATCH 049/692] Bump NQP --- tools/build/NQP_REVISION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/build/NQP_REVISION b/tools/build/NQP_REVISION index 7f85fe53b3b..435b0579974 100644 --- a/tools/build/NQP_REVISION +++ b/tools/build/NQP_REVISION @@ -1 +1 @@ -2017.08-62-gd35cdbdd3 \ No newline at end of file +2017.08-67-g9a2ba37 From a8e0352b0358ad3ca99335d91e06b7e6a3fdbbfa Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Thu, 14 Sep 2017 21:22:43 +0200 Subject: [PATCH 050/692] Reorganize BUILDPLAN handling of native inits - move the check out of the parameter to bindattr_x - this causes one Scalar allocation less for each initialization --- src/core/Mu.pm | 150 +++++++++++++++++++++++++++---------------------- 1 file changed, 84 insertions(+), 66 deletions(-) diff --git a/src/core/Mu.pm b/src/core/Mu.pm index a6df9d45c4d..c78a7d62e00 100644 --- a/src/core/Mu.pm +++ b/src/core/Mu.pm @@ -160,63 +160,72 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" nqp::if( # >0 nqp::iseq_i($code,1), - nqp::bindattr_i(self, # 1 - nqp::atpos($task,1), - nqp::atpos($task,2), - nqp::if( - nqp::existskey($init,nqp::atpos($task,3)), - nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,3))), - nqp::if( # no init - nqp::iseq_i(nqp::elems($task),5), - nqp::atpos($task,4)(self, # but a default + nqp::if( # 1 + nqp::existskey($init,nqp::atpos($task,3)), + nqp::bindattr_i(self, # init value + nqp::atpos($task,1), + nqp::atpos($task,2), + nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,3))) + ), + nqp::if( # no init + nqp::iseq_i(nqp::elems($task),5), + nqp::bindattr_i(self, # but a default + nqp::atpos($task,1), + nqp::atpos($task,2), + nqp::atpos($task,4)(self, nqp::getattr_i(self, nqp::atpos($task,1), nqp::atpos($task,2) ) - ), - 0 # no default + ) ) ) ), nqp::if( # > 1 nqp::iseq_i($code,2), - nqp::bindattr_n(self, # 2 - nqp::atpos($task,1), - nqp::atpos($task,2), - nqp::if( - nqp::existskey($init,nqp::atpos($task,3)), - nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,3))), - nqp::if( # no init - nqp::iseq_i(nqp::elems($task),5), - nqp::atpos($task,4)(self, # but a default + nqp::if( # 2 + nqp::existskey($init,nqp::atpos($task,3)), + nqp::bindattr_n(self, # init value + nqp::atpos($task,1), + nqp::atpos($task,2), + nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,3))) + ), + nqp::if( # no init + nqp::iseq_i(nqp::elems($task),5), + nqp::bindattr_n(self, # but a default + nqp::atpos($task,1), + nqp::atpos($task,2), + nqp::atpos($task,4)(self, nqp::getattr_n(self, nqp::atpos($task,1), nqp::atpos($task,2) ) - ), - 0e0 # no default + ) ) ) ), nqp::if( # > 2 nqp::iseq_i($code,3), - nqp::bindattr_s(self, # 3 - nqp::atpos($task,1), - nqp::atpos($task,2), - nqp::if( - nqp::existskey($init,nqp::atpos($task,3)), - nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,3))), - nqp::if( # no init - nqp::iseq_i(nqp::elems($task),5), - nqp::atpos($task,4)(self, # but a default + nqp::if( # 3 + nqp::existskey($init,nqp::atpos($task,3)), + nqp::bindattr_s(self, # init value + nqp::atpos($task,1), + nqp::atpos($task,2), + nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,3))) + ), + nqp::if( # no init + nqp::iseq_i(nqp::elems($task),5), + nqp::bindattr_s(self, # but a default + nqp::atpos($task,1), + nqp::atpos($task,2), + nqp::atpos($task,4)(self, nqp::getattr_s(self, nqp::atpos($task,1), nqp::atpos($task,2) ) - ), - "" # no default + ) ) ) ), @@ -370,63 +379,72 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" nqp::if( # >0 nqp::iseq_i($code,1), - nqp::bindattr_i(self, # 1 - nqp::atpos($task,1), - nqp::atpos($task,2), - nqp::if( - nqp::existskey($init,nqp::atpos($task,3)), - nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,3))), - nqp::if( # no init - nqp::iseq_i(nqp::elems($task),5), - nqp::atpos($task,4)(self, # but a default + nqp::if( # 1 + nqp::existskey($init,nqp::atpos($task,3)), + nqp::bindattr_i(self, # init value + nqp::atpos($task,1), + nqp::atpos($task,2), + nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,3))) + ), + nqp::if( # no init + nqp::iseq_i(nqp::elems($task),5), + nqp::bindattr_i(self, # but a default + nqp::atpos($task,1), + nqp::atpos($task,2), + nqp::atpos($task,4)(self, nqp::getattr_i(self, nqp::atpos($task,1), nqp::atpos($task,2) ) - ), - 0 # no default + ) ) ) ), nqp::if( # > 1 nqp::iseq_i($code,2), - nqp::bindattr_n(self, # 2 - nqp::atpos($task,1), - nqp::atpos($task,2), - nqp::if( - nqp::existskey($init,nqp::atpos($task,3)), - nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,3))), - nqp::if( # no init - nqp::iseq_i(nqp::elems($task),5), - nqp::atpos($task,4)(self, # but a default + nqp::if( # 2 + nqp::existskey($init,nqp::atpos($task,3)), + nqp::bindattr_n(self, # init value + nqp::atpos($task,1), + nqp::atpos($task,2), + nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,3))) + ), + nqp::if( # no init + nqp::iseq_i(nqp::elems($task),5), + nqp::bindattr_n(self, # but a default + nqp::atpos($task,1), + nqp::atpos($task,2), + nqp::atpos($task,4)(self, nqp::getattr_n(self, nqp::atpos($task,1), nqp::atpos($task,2) ) - ), - 0e0 # no default + ) ) ) ), nqp::if( # > 2 nqp::iseq_i($code,3), - nqp::bindattr_s(self, # 3 - nqp::atpos($task,1), - nqp::atpos($task,2), - nqp::if( - nqp::existskey($init,nqp::atpos($task,3)), - nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,3))), - nqp::if( # no init - nqp::iseq_i(nqp::elems($task),5), - nqp::atpos($task,4)(self, # but a default + nqp::if( # 3 + nqp::existskey($init,nqp::atpos($task,3)), + nqp::bindattr_s(self, # init value + nqp::atpos($task,1), + nqp::atpos($task,2), + nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,3))) + ), + nqp::if( # no init + nqp::iseq_i(nqp::elems($task),5), + nqp::bindattr_s(self, # but a default + nqp::atpos($task,1), + nqp::atpos($task,2), + nqp::atpos($task,4)(self, nqp::getattr_s(self, nqp::atpos($task,1), nqp::atpos($task,2) ) - ), - "" # no default + ) ) ) ), From 2645a1e97cfa313de1943eacbfffa70c1e46e49d Mon Sep 17 00:00:00 2001 From: "Philippe Bruhat (BooK)" Date: Fri, 15 Sep 2017 00:48:35 +0200 Subject: [PATCH 051/692] Implement pred() and succ() for the Enumeration role These method will walk the enumeration in the declaration order. Using Order as an example: - Order::Same.succ is Order::More, - Order::Same.pred is Order::Less. Calling pred or succ on the boundaries will fail with X::OutOfBound. Using the same example, Order::Less.pred fails with this X::OutOfRange: "Decrement out of range. Is: Less, should be in Order::Less^..Order::More". --- src/core/Enumeration.pm | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/src/core/Enumeration.pm b/src/core/Enumeration.pm index 88884b03154..0dbd65167ad 100644 --- a/src/core/Enumeration.pm +++ b/src/core/Enumeration.pm @@ -32,6 +32,21 @@ my role Enumeration { ?? $x !! self.^enum_from_value($x) } + + method pred() { + my @values := self.^enum_value_list; + my $index = @values.first( self, :k ); + return $index <= 0 + ?? Failure.new( X::OutOfRange.new( what => "Decrement", got => self, range => @values[0] ^.. @values[*-1] ) ) + !! @values[ $index - 1 ]; + } + method succ() { + my @values := self.^enum_value_list; + my $index = @values.first( self, :k ); + return $index >= @values.end + ?? Failure.new( X::OutOfRange.new( what => "Increment", got => self, range => @values[0] ..^ @values[*-1] ) ) + !! @values[ $index + 1 ]; + } } # Methods that we also have if the base type of an enumeration is From 8df53f34ddee3bf6091a566ba5583f37b2502c9b Mon Sep 17 00:00:00 2001 From: "Philippe Bruhat (BooK)" Date: Fri, 15 Sep 2017 01:28:04 +0200 Subject: [PATCH 052/692] Remove Failure from Enumeration's pred and succ Following this comment from Zoffix on #perl6: If we make .pred go to previous element (and just return the first element if it's already at the first element) and .succ go to next element (and just return the first element if it's already at the last element). We make Enumeration <-> Bool consistent AND keep the behaviour of Order and Bool semantically the same (More.succ currently returns 2, which is still more) https://irclog.perlgeek.de/perl6/2017-09-14#i_15165758 --- src/core/Enumeration.pm | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/src/core/Enumeration.pm b/src/core/Enumeration.pm index 0dbd65167ad..c350e469e48 100644 --- a/src/core/Enumeration.pm +++ b/src/core/Enumeration.pm @@ -36,16 +36,12 @@ my role Enumeration { method pred() { my @values := self.^enum_value_list; my $index = @values.first( self, :k ); - return $index <= 0 - ?? Failure.new( X::OutOfRange.new( what => "Decrement", got => self, range => @values[0] ^.. @values[*-1] ) ) - !! @values[ $index - 1 ]; + return $index <= 0 ?? self !! @values[ $index - 1 ]; } method succ() { my @values := self.^enum_value_list; my $index = @values.first( self, :k ); - return $index >= @values.end - ?? Failure.new( X::OutOfRange.new( what => "Increment", got => self, range => @values[0] ..^ @values[*-1] ) ) - !! @values[ $index + 1 ]; + return $index >= @values.end ?? self !! @values[ $index + 1 ]; } } From 4e3f0fcad7105c250167f6be9443c7afb55bb3c9 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Fri, 15 Sep 2017 11:45:10 +0200 Subject: [PATCH 053/692] Fix non-installed gdb/valgrind runners The paths were in the wrong order, meaning a ./perl6-gdb-m or ./perl6-valgrind-m before `make install` would not work --- tools/build/Makefile-Moar.in | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/tools/build/Makefile-Moar.in b/tools/build/Makefile-Moar.in index f20705b2533..42400b9af4e 100644 --- a/tools/build/Makefile-Moar.in +++ b/tools/build/Makefile-Moar.in @@ -195,21 +195,21 @@ $(PERL6_DEBUG_MOAR): src/perl6-debug.nqp $(PERL6_MOAR) --vmlibs=$(M_PERL6_OPS_DLL)=Rakudo_ops_init $(M_BUILD_DIR)/perl6-debug.nqp $(M_DEBUG_RUNNER): tools/build/create-moar-runner.pl $(PERL6_DEBUG_MOAR) $(SETTING_MOAR) - $(M_RUN_PERL6) tools/build/create-moar-runner.pl "$(MOAR)" perl6-debug.moarvm perl6-debug-m . "" --nqp-lib=blib "$(M_LIBPATH)" "$(NQP_LIBPATH)" . blib + $(M_RUN_PERL6) tools/build/create-moar-runner.pl "$(MOAR)" perl6-debug.moarvm perl6-debug-m . "" --nqp-lib=blib . blib "$(M_LIBPATH)" "$(NQP_LIBPATH)" $(M_GDB_RUNNER): tools/build/create-moar-runner.pl $(PERL6_MOAR) $(SETTING_MOAR) $(RM_F) $(M_GDB_RUNNER) - $(M_RUN_PERL6) tools/build/create-moar-runner.pl "$(MOAR)" perl6.moarvm perl6-gdb-m . "gdb" --nqp-lib=blib "$(M_LIBDEFPATH)" "$(M_LIBPATH)" "$(NQP_LIBPATH)" . blib + $(M_RUN_PERL6) tools/build/create-moar-runner.pl "$(MOAR)" perl6.moarvm perl6-gdb-m . "gdb" --nqp-lib=blib . blib "$(M_LIBDEFPATH)" "$(M_LIBPATH)" "$(NQP_LIBPATH)" -$(CHMOD) 755 $(M_GDB_RUNNER) $(M_LLDB_RUNNER): tools/build/create-moar-runner.pl $(PERL6_MOAR) $(SETTING_MOAR) $(RM_F) $(M_LLDB_RUNNER) - $(M_RUN_PERL6) tools/build/create-moar-runner.pl "$(MOAR)" perl6.moarvm perl6-lldb-m . "lldb" --nqp-lib=blib "$(M_LIBPATH)" "$(NQP_LIBPATH)" . + $(M_RUN_PERL6) tools/build/create-moar-runner.pl "$(MOAR)" perl6.moarvm perl6-lldb-m . "lldb" --nqp-lib=blib . blib "$(M_LIBPATH)" "$(NQP_LIBPATH)" -$(CHMOD) 755 $(M_LLDB_RUNNER) $(M_VALGRIND_RUNNER): tools/build/create-moar-runner.pl $(PERL6_MOAR) $(SETTING_MOAR) $(RM_F) $(M_VALGRIND_RUNNER) - $(M_RUN_PERL6) tools/build/create-moar-runner.pl "$(MOAR)" perl6.moarvm perl6-valgrind-m . "valgrind" --nqp-lib=blib "$(M_LIBPATH)" "$(NQP_LIBPATH)" . blib + $(M_RUN_PERL6) tools/build/create-moar-runner.pl "$(MOAR)" perl6.moarvm perl6-valgrind-m . "valgrind" --nqp-lib=blib . blib "$(M_LIBPATH)" "$(NQP_LIBPATH)" -$(CHMOD) 755 $(M_VALGRIND_RUNNER) ## testing targets From b30ac08a133f41caae2e3e613cef43a58a76bd13 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Fri, 15 Sep 2017 11:48:36 +0200 Subject: [PATCH 054/692] Fix race in Channel awaiter Fixes an occasional crash with "cannot call close on a null object" in S17-promise/nonblocking-await.t --- src/core/Channel.pm | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/src/core/Channel.pm b/src/core/Channel.pm index 032d6ff4eaf..461d322278b 100644 --- a/src/core/Channel.pm +++ b/src/core/Channel.pm @@ -176,11 +176,16 @@ my class Channel does Awaitable { # Need some care here to avoid a race. We must tap the notification # supply first, and then do an immediate poll after it, just to be # sure we won't miss notifications between the two. Also, we need - # to take some care that we never call subscriber twice; a lock is - # a tad heavy-weight for it, in the future we can just CAS an int. + # to take some care that we never call subscriber twice. my $notified := False; my $l := Lock.new; - my $t := $!async-notify.unsanitized-supply.tap: &poll-now; + my $t; + $l.protect: { + # Lock ensures $t will be assigned before we run the logic + # inside of poll-now, which relies on being able to do + # $t.close. + $t := $!async-notify.unsanitized-supply.tap: &poll-now; + } poll-now(); sub poll-now($discard?) { From 1818de980fe39a37b405c0353d088932bd4d034a Mon Sep 17 00:00:00 2001 From: Timo Paulssen Date: Fri, 15 Sep 2017 13:50:03 +0200 Subject: [PATCH 055/692] nativecall: don't try to compile sigs with optional parameters it's currently NYI, and default values would just be ignored. --- lib/NativeCall.pm6 | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) diff --git a/lib/NativeCall.pm6 b/lib/NativeCall.pm6 index 34f82d03027..2eece730b0d 100644 --- a/lib/NativeCall.pm6 +++ b/lib/NativeCall.pm6 @@ -298,7 +298,8 @@ my role Native[Routine $r, $libname where Str|Callable|List|IO::Path|Distributio has $!cpp-name-mangler; has Pointer $!entry-point; has int $!arity; - has $!is-clone; + has int8 $!is-clone; + has int8 $!any-optionals; method !setup() { $setup-lock.protect: { @@ -325,7 +326,16 @@ my role Native[Routine $r, $libname where Str|Callable|List|IO::Path|Distributio $!rettype := nqp::decont(map_return_type($r.returns)); $!arity = $r.signature.arity; $!setup = 1; + + $!any-optionals = self!any-optionals; + } + } + + method !any-optionals() { + for $r.signature.params -> $p { + return True if $p.optional } + return False } my $perl6comp := nqp::getcomp("perl6"); @@ -406,7 +416,7 @@ my role Native[Routine $r, $libname where Str|Callable|List|IO::Path|Distributio method clone() { my $clone := callsame; - nqp::bindattr($clone, $?CLASS, '$!is-clone', 1); + nqp::bindattr_i($clone, $?CLASS, '$!is-clone', 1); $clone } @@ -414,6 +424,7 @@ my role Native[Routine $r, $libname where Str|Callable|List|IO::Path|Distributio self!setup(); self!create-optimized-call() unless $!is-clone # Clones and original would share the invokespec but not the $!do attribute + or $!any-optionals # the compiled code doesn't support optional parameters yet or $*W; # Avoid issues with compiling specialized version during BEGIN time my Mu $args := nqp::getattr(nqp::decont(args), Capture, '@!list'); From 69dae1f3be3827a73ef601b8e2cb2ab3223e2f62 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Fri, 15 Sep 2017 14:28:57 +0200 Subject: [PATCH 056/692] Give Enumeration its own .WHICH So that we can distinguish between enums that happen to have the same value. --- src/core/Enumeration.pm | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/src/core/Enumeration.pm b/src/core/Enumeration.pm index c350e469e48..e47f8e79f9c 100644 --- a/src/core/Enumeration.pm +++ b/src/core/Enumeration.pm @@ -22,6 +22,13 @@ my role Enumeration { multi method Int(::?CLASS:D:) { $!value.Int } multi method Real(::?CLASS:D:) { $!value.Real } + multi method WHICH(::?CLASS:D:) { + nqp::box_s( + nqp::join("|",nqp::list(self.^name,$!key,$!value.WHICH)), + ObjAt + ) + } + # Make sure we always accept any element of the enumeration multi method ACCEPTS(::?CLASS:D: ::?CLASS:U $ --> True) { } multi method ACCEPTS(::?CLASS:D: ::?CLASS:D \v) { self === v } From cc64a75842236de43b7874578b289f6fcd292c97 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Fri, 15 Sep 2017 14:42:18 +0200 Subject: [PATCH 057/692] Give enums an iterator - e.g. "for Order" will show Less/Same/More - e.g. "for Less" will still just show Less --- src/core/Enumeration.pm | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/core/Enumeration.pm b/src/core/Enumeration.pm index e47f8e79f9c..28227965f62 100644 --- a/src/core/Enumeration.pm +++ b/src/core/Enumeration.pm @@ -29,6 +29,10 @@ my role Enumeration { ) } + multi method iterator(::?CLASS:U:) { + Rakudo::Iterator.ReifiedList(self.^enum_value_list) + } + # Make sure we always accept any element of the enumeration multi method ACCEPTS(::?CLASS:D: ::?CLASS:U $ --> True) { } multi method ACCEPTS(::?CLASS:D: ::?CLASS:D \v) { self === v } From 2ad51a0f5bc1df064353042cb5e1f09bff99eb88 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Fri, 15 Sep 2017 12:58:06 +0000 Subject: [PATCH 058/692] Constrain Enumeration.succ/.pred to instances pre- https://github.com/rakudo/rakudo/pull/1156 type objects would just die with X::Parameter::InvalidConcreteness but now they return weird results. Constrain to instances, to restore the ::InvalidConcreteness throwage we had before. --- src/core/Enumeration.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/Enumeration.pm b/src/core/Enumeration.pm index 28227965f62..732fb02bcb0 100644 --- a/src/core/Enumeration.pm +++ b/src/core/Enumeration.pm @@ -44,12 +44,12 @@ my role Enumeration { !! self.^enum_from_value($x) } - method pred() { + method pred(::?CLASS:D:) { my @values := self.^enum_value_list; my $index = @values.first( self, :k ); return $index <= 0 ?? self !! @values[ $index - 1 ]; } - method succ() { + method succ(::?CLASS:D:) { my @values := self.^enum_value_list; my $index = @values.first( self, :k ); return $index >= @values.end ?? self !! @values[ $index + 1 ]; From 8d442a52324d81be344376f91db137d56e5b95b8 Mon Sep 17 00:00:00 2001 From: "Philippe Bruhat (BooK)" Date: Fri, 15 Sep 2017 15:30:39 +0200 Subject: [PATCH 059/692] Avoid mistaking two enumeration elements with the same value MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This is a fix for this issue: enum Animal (Cat => 0, Dog => 0, Human => 42); say Dog.succ; # OUTPUT: «Dog␤» With this change, the behaviour becomes: say Dog.succ; # OUTPUT: «Human␤» --- src/core/Enumeration.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/Enumeration.pm b/src/core/Enumeration.pm index 732fb02bcb0..b52d46cf960 100644 --- a/src/core/Enumeration.pm +++ b/src/core/Enumeration.pm @@ -46,12 +46,12 @@ my role Enumeration { method pred(::?CLASS:D:) { my @values := self.^enum_value_list; - my $index = @values.first( self, :k ); + my $index = @values.first: { nqp::eqaddr( self, $_ ) }, :k; return $index <= 0 ?? self !! @values[ $index - 1 ]; } method succ(::?CLASS:D:) { my @values := self.^enum_value_list; - my $index = @values.first( self, :k ); + my $index = @values.first: { nqp::eqaddr( self, $_ ) }, :k; return $index >= @values.end ?? self !! @values[ $index + 1 ]; } } From 8d938461a9fbd9f5328e7f5c0e41386ce4f96ecb Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Fri, 15 Sep 2017 13:43:53 +0000 Subject: [PATCH 060/692] Fix Enumeration:D === Enumeration:D An earlier fix[^1] to .WHICH fixed the method, but the issue with the operator remained, because there exists an Int:D === Int:D candidate that simply unboxes the Ints. Fix by adding Enumeration:D === Enumeration:D candidate for infix:<===> [1] https://github.com/rakudo/rakudo/commit/69dae1f3be3827a73ef601b8e2cb2ab3223e2f62 --- src/core/Enumeration.pm | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/src/core/Enumeration.pm b/src/core/Enumeration.pm index b52d46cf960..cd4f0154bdc 100644 --- a/src/core/Enumeration.pm +++ b/src/core/Enumeration.pm @@ -100,4 +100,15 @@ Metamodel::EnumHOW.set_composalizer(-> $type, $name, %enum_values { $r }); +# We use this one because, for example, Int:D === Int:D, has an optimization +# that simply unboxes the values. That's no good for us, since two different +# Enumertaion:Ds could have the same Int:D value. +multi infix:<===> (Enumeration:D \a, Enumeration:D \b) { + nqp::p6bool( + nqp::eqaddr(a,b) + || (nqp::eqaddr(a.WHAT,b.WHAT) + && nqp::iseq_s(nqp::unbox_s(a.WHICH), nqp::unbox_s(b.WHICH))) + ) +} + # vim: ft=perl6 expandtab sw=4 From f26d1e24f92715e9adb6935b65bb51f233d29262 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Fri, 15 Sep 2017 16:09:17 +0200 Subject: [PATCH 061/692] Don't attempt non-blocking await if holding locks Locks are tied to a particular OS thread. Non-blocking await may move code between OS threads. Therefore, if a lock is being held, then we fall back on a real blocking await, so things work. At present, various bits of the Supply internals rely on locks; this thus fixes a lot of things that are broken, but also means that we can't yet get all the benefit we'd like from non-blocking await. Upcoming changes to various affected aspects of supplies will fix this issue. --- src/core/ThreadPoolScheduler.pm | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index e1ca4d0ae42..b6e8b3d7e66 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -12,7 +12,17 @@ my class ThreadPoolScheduler does Scheduler { $!queue := nqp::decont($queue); } + sub holding-locks() { + nqp::p6bool(nqp::threadlockcount(nqp::currentthread())) + } + method await(Awaitable:D $a) { + holding-locks() + ?? Awaiter::Blocking.await($a) + !! self!do-await($a) + } + + method !do-await(Awaitable:D $a) { my $handle := $a.get-await-handle; if $handle.already { $handle.success @@ -37,6 +47,12 @@ my class ThreadPoolScheduler does Scheduler { } method await-all(Iterable:D \i) { + holding-locks() + ?? Awaiter::Blocking.await-all(i) + !! self!do-await-all(i) + } + + method !do-await-all(Iterable:D \i) { # Collect results that are already available, and handles where the # results are not yet available together with the matching insertion # indices. From a4ce97cacbb9a30feb4ff14b42f4196aaeb55c31 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Fri, 15 Sep 2017 16:28:29 +0200 Subject: [PATCH 062/692] Bump NQP_REVISION for threadlockcount op --- tools/build/NQP_REVISION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/build/NQP_REVISION b/tools/build/NQP_REVISION index 435b0579974..3ef99757c08 100644 --- a/tools/build/NQP_REVISION +++ b/tools/build/NQP_REVISION @@ -1 +1 @@ -2017.08-67-g9a2ba37 +2017.08-71-gf3b0f0c From a137c0de12193393873c73a62cf347a2e1eb1fc4 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Fri, 15 Sep 2017 16:46:33 +0200 Subject: [PATCH 063/692] Fix non-blocking await-all to respect Slip --- src/core/Awaiter.pm | 16 ++++++++++++---- src/core/ThreadPoolScheduler.pm | 16 ++++++++++++---- 2 files changed, 24 insertions(+), 8 deletions(-) diff --git a/src/core/Awaiter.pm b/src/core/Awaiter.pm index 12b8ad07661..73355ce0272 100644 --- a/src/core/Awaiter.pm +++ b/src/core/Awaiter.pm @@ -35,6 +35,7 @@ my class Awaiter::Blocking does Awaiter { my \handles = nqp::list(); my \indices = nqp::list_i(); my int $insert = 0; + my $saw-slip = False; for i -> $awaitable { unless nqp::istype($awaitable, Awaitable) { die "Can only specify Awaitable objects to await (got a $awaitable.^name())"; @@ -45,9 +46,14 @@ my class Awaiter::Blocking does Awaiter { my $handle := $awaitable.get-await-handle; if $handle.already { - $handle.success - ?? nqp::bindpos(results, $insert, $handle.result) - !! $handle.cause.rethrow + if $handle.success { + my \result = $handle.result; + nqp::bindpos(results, $insert, result); + $saw-slip = True if nqp::istype(result, Slip); + } + else { + $handle.cause.rethrow + } } else { nqp::push(handles, $handle); @@ -73,6 +79,7 @@ my class Awaiter::Blocking does Awaiter { $l.protect: { if success && $remaining { nqp::bindpos(results, $insert, result); + $saw-slip = True if nqp::istype(result, Slip); --$remaining; $ready.signal unless $remaining; } @@ -98,7 +105,8 @@ my class Awaiter::Blocking does Awaiter { $exception.rethrow if nqp::isconcrete($exception); } - nqp::p6bindattrinvres(nqp::create(List), List, '$!reified', results); + my \result-list = nqp::p6bindattrinvres(nqp::create(List), List, '$!reified', results); + $saw-slip ?? result-list.map(-> \val { val }).List !! result-list } } diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index b6e8b3d7e66..f4bd1e37d83 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -60,6 +60,7 @@ my class ThreadPoolScheduler does Scheduler { my \handles = nqp::list(); my \indices = nqp::list_i(); my int $insert = 0; + my $saw-slip = False; for i -> $awaitable { unless nqp::istype($awaitable, Awaitable) { die "Can only specify Awaitable objects to await (got a $awaitable.^name())"; @@ -70,9 +71,14 @@ my class ThreadPoolScheduler does Scheduler { my $handle := $awaitable.get-await-handle; if $handle.already { - $handle.success - ?? nqp::bindpos(results, $insert, $handle.result) - !! $handle.cause.rethrow + if $handle.success { + my \result = $handle.result; + nqp::bindpos(results, $insert, result); + $saw-slip = True if nqp::istype(result, Slip); + } + else { + $handle.cause.rethrow + } } else { nqp::push(handles, $handle); @@ -105,6 +111,7 @@ my class ThreadPoolScheduler does Scheduler { $l.protect: { if success && $remaining { nqp::bindpos(results, $insert, result); + $saw-slip = True if nqp::istype(result, Slip); --$remaining; $resume = 1 unless $remaining; } @@ -136,7 +143,8 @@ my class ThreadPoolScheduler does Scheduler { $exception.rethrow if nqp::isconcrete($exception); } - nqp::p6bindattrinvres(nqp::create(List), List, '$!reified', results); + my \result-list = nqp::p6bindattrinvres(nqp::create(List), List, '$!reified', results); + $saw-slip ?? result-list.map(-> \val { val }).List !! result-list } } From 55aa7f28d33623562073a1d3bbdd70ed680bb5a8 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Fri, 15 Sep 2017 15:03:25 +0000 Subject: [PATCH 064/692] Make Enumeration.pred 8.4x faster / .succ 6x faster Closes RT#132093: https://rt.perl.org/Ticket/Display.html?id=132093 --- src/core/Enumeration.pm | 35 +++++++++++++++++++++++++++++------ 1 file changed, 29 insertions(+), 6 deletions(-) diff --git a/src/core/Enumeration.pm b/src/core/Enumeration.pm index cd4f0154bdc..8a68882dd78 100644 --- a/src/core/Enumeration.pm +++ b/src/core/Enumeration.pm @@ -45,14 +45,37 @@ my role Enumeration { } method pred(::?CLASS:D:) { - my @values := self.^enum_value_list; - my $index = @values.first: { nqp::eqaddr( self, $_ ) }, :k; - return $index <= 0 ?? self !! @values[ $index - 1 ]; + nqp::stmts( + (my $values := self.^enum_value_list), + # We find ourselves in $values and give previous value, or self if we are the first one + nqp::if( + nqp::isle_i((my int $els = $values.elems), 1), + self, # short-curcuit; there's only us in the list; avoids --$i'ing past end later + nqp::stmts( + ($values := nqp::getattr($values, List, '$!reified')), + (my int $i = $els), + nqp::while( + nqp::isgt_i(($i = nqp::sub_i($i, 1)), 1) # >1 because we subtract one after the loop + && nqp::isfalse(self === nqp::atpos($values, $i)), + nqp::null), + nqp::atpos($values, nqp::sub_i($i,1))))) } method succ(::?CLASS:D:) { - my @values := self.^enum_value_list; - my $index = @values.first: { nqp::eqaddr( self, $_ ) }, :k; - return $index >= @values.end ?? self !! @values[ $index + 1 ]; + nqp::stmts( + (my $values := self.^enum_value_list), + # We find ourselves in $values and give next value, or self if we are the last one + nqp::if( + nqp::isle_i((my int $els = nqp::sub_i($values.elems, 2)), -1), + # $els - 2 because we add 1 after the loop + self, # short-curcuit; there's only us in the list; avoids ++$i'ing past end later + nqp::stmts( + ($values := nqp::getattr($values, List, '$!reified')), + (my int $i = -1), + nqp::while( + nqp::islt_i(($i = nqp::add_i($i, 1)), $els) + && nqp::isfalse(self === nqp::atpos($values, $i)), + nqp::null), + nqp::atpos($values, nqp::add_i($i,1))))) } } From 43e41ec6833d1e36df8cd598c1380a5e4c28b37d Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Fri, 15 Sep 2017 17:39:02 +0000 Subject: [PATCH 065/692] Apply lizmat++'s improvements From https://irclog.perlgeek.de/perl6-dev/2017-09-15#i_15169665 Makes .pred 2.8x faster still and .succ 80% faster --- src/core/Enumeration.pm | 22 ++++++++-------------- 1 file changed, 8 insertions(+), 14 deletions(-) diff --git a/src/core/Enumeration.pm b/src/core/Enumeration.pm index 8a68882dd78..21a3a86e436 100644 --- a/src/core/Enumeration.pm +++ b/src/core/Enumeration.pm @@ -46,34 +46,32 @@ my role Enumeration { method pred(::?CLASS:D:) { nqp::stmts( - (my $values := self.^enum_value_list), + (my $values := nqp::getattr(self.^enum_value_list, List, '$!reified')), # We find ourselves in $values and give previous value, or self if we are the first one nqp::if( - nqp::isle_i((my int $els = $values.elems), 1), + nqp::isle_i((my int $els = nqp::elems($values)), 1), self, # short-curcuit; there's only us in the list; avoids --$i'ing past end later nqp::stmts( - ($values := nqp::getattr($values, List, '$!reified')), (my int $i = $els), nqp::while( nqp::isgt_i(($i = nqp::sub_i($i, 1)), 1) # >1 because we subtract one after the loop - && nqp::isfalse(self === nqp::atpos($values, $i)), + && nqp::isfalse(nqp::eqaddr(self, nqp::atpos($values, $i))), nqp::null), nqp::atpos($values, nqp::sub_i($i,1))))) } method succ(::?CLASS:D:) { nqp::stmts( - (my $values := self.^enum_value_list), + (my $values := nqp::getattr(self.^enum_value_list, List, '$!reified')), # We find ourselves in $values and give next value, or self if we are the last one nqp::if( - nqp::isle_i((my int $els = nqp::sub_i($values.elems, 2)), -1), + nqp::isle_i((my int $els = nqp::sub_i(nqp::elems($values), 2)), -1), # $els - 2 because we add 1 after the loop self, # short-curcuit; there's only us in the list; avoids ++$i'ing past end later nqp::stmts( - ($values := nqp::getattr($values, List, '$!reified')), - (my int $i = -1), + (my int $i = -1), nqp::while( nqp::islt_i(($i = nqp::add_i($i, 1)), $els) - && nqp::isfalse(self === nqp::atpos($values, $i)), + && nqp::isfalse(nqp::eqaddr(self, nqp::atpos($values, $i))), nqp::null), nqp::atpos($values, nqp::add_i($i,1))))) } @@ -127,11 +125,7 @@ Metamodel::EnumHOW.set_composalizer(-> $type, $name, %enum_values { # that simply unboxes the values. That's no good for us, since two different # Enumertaion:Ds could have the same Int:D value. multi infix:<===> (Enumeration:D \a, Enumeration:D \b) { - nqp::p6bool( - nqp::eqaddr(a,b) - || (nqp::eqaddr(a.WHAT,b.WHAT) - && nqp::iseq_s(nqp::unbox_s(a.WHICH), nqp::unbox_s(b.WHICH))) - ) + nqp::p6bool(nqp::eqaddr(nqp::decont(a), nqp::decont(b))) } # vim: ft=perl6 expandtab sw=4 From 880b33e2e68d17f59a3ee62bd5d4abfd0663d59d Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Fri, 15 Sep 2017 17:40:15 +0000 Subject: [PATCH 066/692] Add deconts to nqp::eqaddr() tests There are more places where this is needed. Will try to remember to fix up those later, unless someone beats me. Per: https://irclog.perlgeek.de/perl6-dev/2017-09-15#i_15169706 --- src/core/Any.pm | 2 +- src/core/Str.pm | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/Any.pm b/src/core/Any.pm index 3770cc28d59..a71ca8ec585 100644 --- a/src/core/Any.pm +++ b/src/core/Any.pm @@ -484,7 +484,7 @@ proto sub infix:<===>(Mu $?, Mu $?) is pure { * } multi sub infix:<===>($?) { Bool::True } multi sub infix:<===>(\a, \b) { nqp::p6bool( - nqp::eqaddr(a,b) + nqp::eqaddr(nqp::decont(a),nqp::decont(b)) || (nqp::eqaddr(a.WHAT,b.WHAT) && nqp::iseq_s(nqp::unbox_s(a.WHICH), nqp::unbox_s(b.WHICH))) ) diff --git a/src/core/Str.pm b/src/core/Str.pm index 291587ad964..b4a84056f58 100644 --- a/src/core/Str.pm +++ b/src/core/Str.pm @@ -3102,7 +3102,7 @@ sub substr-rw(\what, \start, $want?) is rw { multi sub infix:(Str:D \a, Str:D \b) { nqp::p6bool( nqp::unless( - nqp::eqaddr(a,b), + nqp::eqaddr(nqp::decont(a),nqp::decont(b)), nqp::eqaddr(a.WHAT,b.WHAT) && nqp::iseq_s(a,b) ) ) From f925c64826f78803969bb43398877309f6b4a1ac Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Fri, 15 Sep 2017 20:20:05 +0200 Subject: [PATCH 067/692] Streamline Enum.succ|pred|WHICH - facilitated by an Enum knowing its index in the ^enum_value_list - make Enum.succ|pred about 7x faster, and O(1) (testing with Order) - use index to make Enum.WHICH completely agnostic about its contents --- src/Perl6/Actions.nqp | 3 ++- src/Perl6/World.nqp | 3 ++- src/core/Enumeration.pm | 48 +++++++++++++++++++---------------------- 3 files changed, 26 insertions(+), 28 deletions(-) diff --git a/src/Perl6/Actions.nqp b/src/Perl6/Actions.nqp index bdcc7b45fd2..d9751638bb5 100644 --- a/src/Perl6/Actions.nqp +++ b/src/Perl6/Actions.nqp @@ -4609,6 +4609,7 @@ class Perl6::Actions is HLL::Actions does STDActions { my $cur_value := nqp::box_i(-1, $*W.find_symbol(['Int'])); my @redecl; my $block := $*W.cur_lexpad(); + my $index := -1; for @values { # If it's a pair, take that as the value; also find # key. @@ -4658,7 +4659,7 @@ class Perl6::Actions is HLL::Actions does STDActions { } # Create and install value. - my $val_obj := $*W.create_enum_value($type_obj, $cur_key, $cur_value); + my $val_obj := $*W.create_enum_value($type_obj, $cur_key, $cur_value, $index := $index + 1); $cur_key := nqp::unbox_s($cur_key); $*W.install_package_symbol_unchecked($type_obj, $cur_key, $val_obj); if $block.symbol($cur_key) { diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index d82992adfd1..5e56702bf53 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -3082,11 +3082,12 @@ class Perl6::World is HLL::World { } # Adds a value to an enumeration. - method create_enum_value($enum_type_obj, $key, $value) { + method create_enum_value($enum_type_obj, $key, $value, $index) { # Create directly. my $val := nqp::rebless(nqp::clone($value), $enum_type_obj); nqp::bindattr($val, $enum_type_obj, '$!key', $key); nqp::bindattr($val, $enum_type_obj, '$!value', $value); + nqp::bindattr_i($val, $enum_type_obj, '$!index', $index); self.add_object($val); # Add to meta-object. diff --git a/src/core/Enumeration.pm b/src/core/Enumeration.pm index 21a3a86e436..b1388c15108 100644 --- a/src/core/Enumeration.pm +++ b/src/core/Enumeration.pm @@ -2,6 +2,7 @@ my role Enumeration { has $.key; has $.value; + has int $!index; method enums() { self.^enum_values.Map } @@ -24,7 +25,7 @@ my role Enumeration { multi method WHICH(::?CLASS:D:) { nqp::box_s( - nqp::join("|",nqp::list(self.^name,$!key,$!value.WHICH)), + nqp::concat(self.^name,nqp::concat("|",$!index)), ObjAt ) } @@ -45,35 +46,30 @@ my role Enumeration { } method pred(::?CLASS:D:) { - nqp::stmts( - (my $values := nqp::getattr(self.^enum_value_list, List, '$!reified')), - # We find ourselves in $values and give previous value, or self if we are the first one - nqp::if( - nqp::isle_i((my int $els = nqp::elems($values)), 1), - self, # short-curcuit; there's only us in the list; avoids --$i'ing past end later - nqp::stmts( - (my int $i = $els), - nqp::while( - nqp::isgt_i(($i = nqp::sub_i($i, 1)), 1) # >1 because we subtract one after the loop - && nqp::isfalse(nqp::eqaddr(self, nqp::atpos($values, $i))), - nqp::null), - nqp::atpos($values, nqp::sub_i($i,1))))) + nqp::if( + nqp::getattr_i(self,::?CLASS,'$!index'), + nqp::atpos( + nqp::getattr(self.^enum_value_list,List,'$!reified'), + nqp::sub_i(nqp::getattr_i(self,::?CLASS,'$!index'),1) + ), + self + ) } method succ(::?CLASS:D:) { nqp::stmts( - (my $values := nqp::getattr(self.^enum_value_list, List, '$!reified')), - # We find ourselves in $values and give next value, or self if we are the last one + (my $values := nqp::getattr(self.^enum_value_list,List,'$!reified')), nqp::if( - nqp::isle_i((my int $els = nqp::sub_i(nqp::elems($values), 2)), -1), - # $els - 2 because we add 1 after the loop - self, # short-curcuit; there's only us in the list; avoids ++$i'ing past end later - nqp::stmts( - (my int $i = -1), - nqp::while( - nqp::islt_i(($i = nqp::add_i($i, 1)), $els) - && nqp::isfalse(nqp::eqaddr(self, nqp::atpos($values, $i))), - nqp::null), - nqp::atpos($values, nqp::add_i($i,1))))) + nqp::islt_i( + nqp::getattr_i(self,::?CLASS,'$!index'), + nqp::sub_i(nqp::elems($values),1), + ), + nqp::atpos( + $values, + nqp::add_i(nqp::getattr_i(self,::?CLASS,'$!index'),1) + ), + self + ) + ) } } From 0704cd97226e63001943426666c88cef1c5fe711 Mon Sep 17 00:00:00 2001 From: David Warring Date: Sat, 16 Sep 2017 07:18:17 +1200 Subject: [PATCH 068/692] add isa method to SubsetHOW Fixes RT#132073 the following was erroring, but now returns True: subset S of Int; say S.isa(Int); --- src/Perl6/Metamodel/SubsetHOW.nqp | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/Perl6/Metamodel/SubsetHOW.nqp b/src/Perl6/Metamodel/SubsetHOW.nqp index 516d443ba1f..dc50e80dd59 100644 --- a/src/Perl6/Metamodel/SubsetHOW.nqp +++ b/src/Perl6/Metamodel/SubsetHOW.nqp @@ -56,6 +56,10 @@ class Perl6::Metamodel::SubsetHOW method refinement($obj) { $!refinement } + + method isa($obj, $type) { + $!refinee.isa($type); + } method nominalize($obj) { $!refinee.HOW.archetypes.nominal ?? From 3de6f33887688be0a39ba41a225b45489bf0cf4b Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Fri, 15 Sep 2017 23:54:32 +0200 Subject: [PATCH 069/692] Revert streamlining of BUILDPLAN - this reverts a8e0352b0358ad3ca99335d dea0a08545ab172836f9 - defaults can refer to something being initialized later - so merging the actions into a single action does not cut it :-( --- src/Perl6/Metamodel/BUILDPLAN.nqp | 49 +-- src/core/Mu.pm | 562 +++++++++++------------------- 2 files changed, 222 insertions(+), 389 deletions(-) diff --git a/src/Perl6/Metamodel/BUILDPLAN.nqp b/src/Perl6/Metamodel/BUILDPLAN.nqp index 4107a90fd12..a77bfe16534 100644 --- a/src/Perl6/Metamodel/BUILDPLAN.nqp +++ b/src/Perl6/Metamodel/BUILDPLAN.nqp @@ -10,10 +10,10 @@ role Perl6::Metamodel::BUILDPLAN { # further parameters. If it is an array, then the first element # of each array is an "op" # representing the task to perform: # code = call as method (for BUILD or TWEAK) - # 0 class name attr_name = set attribute from init hash|default - # 1 class name attr_name = set native int attribute from init|default - # 2 class name attr_name = set native num attribute from init|default - # 3 class name attr_name = set native str attribute from init|default + # 0 class name attr_name = set attribute from init hash + # 1 class name attr_name = set a native int attribute from init hash + # 2 class name attr_name = set a native num attribute from init hash + # 3 class name attr_name = set a native str attribute from init hash # 4 class attr_name code = call default value closure if needed # 5 class attr_name code = call default value closure if needed, int attr # 6 class attr_name code = call default value closure if needed, num attr @@ -30,7 +30,6 @@ role Perl6::Metamodel::BUILDPLAN { # do not touch in any of the BUILDPLAN so we can spit out vivify # ops at the end. my %attrs_untouched; - my %attrs_with_default; for @attrs { if nqp::can($_, 'container_initializer') { my $ci := $_.container_initializer; @@ -49,14 +48,6 @@ role Perl6::Metamodel::BUILDPLAN { if !nqp::isnull($build) && $build { # We'll call the custom one. nqp::push(@plan,$build); - - # Ensure that any required attributes are set - for @attrs { - if nqp::can($_, 'required') && $_.required { - nqp::push(@plan,[8, $obj, $_.name, $_.required]); - nqp::deletekey(%attrs_untouched, $_.name); - } - } } else { # No custom BUILD. Rather than having an actual BUILD @@ -67,36 +58,24 @@ role Perl6::Metamodel::BUILDPLAN { nqp::push(@plan,[ nqp::add_i(0,nqp::objprimspec($_.type)), $obj, - $_.name, - nqp::substr($_.name, 2) + nqp::substr((my $attr_name := $_.name), 2), + $attr_name ]); - - # add default setting logic if available - if nqp::can($_, 'build') { - my $default := $_.build; - if !nqp::isnull($default) && $default { - %attrs_with_default{$_.name} := NQPMu; - @plan[@plan - 1][4] := $default; - } - } } + } + } - if nqp::can($_, 'required') && $_.required { - unless nqp::existskey(%attrs_with_default,$_.name) { - # check immediately after fetching - nqp::push(@plan,[8, $obj, $_.name, $_.required]); - nqp::deletekey(%attrs_untouched, $_.name); - } - } + # Ensure that any required attributes are set + for @attrs { + if nqp::can($_, 'required') && $_.required { + nqp::push(@plan,[8, $obj, $_.name, $_.required]); + nqp::deletekey(%attrs_untouched, $_.name); } } # Check if there's any default values to put in place. for @attrs { - if nqp::existskey(%attrs_with_default,$_.name) { - # already in init logic - } - elsif nqp::can($_, 'build') { + if nqp::can($_, 'build') { my $default := $_.build; if !nqp::isnull($default) && $default { nqp::push(@plan,[ diff --git a/src/core/Mu.pm b/src/core/Mu.pm index c78a7d62e00..020bf0e8c85 100644 --- a/src/core/Mu.pm +++ b/src/core/Mu.pm @@ -154,208 +154,135 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" nqp::islt_i($i = nqp::add_i($i,1),$count), nqp::if( - nqp::islist(my $task := nqp::atpos($bp,$i)), - nqp::if( # got stuff to do + nqp::istype((my $task := nqp::atpos($bp,$i)),Callable), + nqp::if( # BUILD/TWEAK + nqp::istype( + (my $build := nqp::if( + nqp::elems($init), + $task(self,|%attrinit), + $task(self) + )), + Failure + ), + return $build + ), + + nqp::if( # not just calling (my int $code = nqp::atpos($task,0)), - nqp::if( # >0 - nqp::iseq_i($code,1), - nqp::if( # 1 - nqp::existskey($init,nqp::atpos($task,3)), - nqp::bindattr_i(self, # init value - nqp::atpos($task,1), - nqp::atpos($task,2), - nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,3))) - ), - nqp::if( # no init - nqp::iseq_i(nqp::elems($task),5), - nqp::bindattr_i(self, # but a default + nqp::if( # >0 + nqp::isle_i($code,3), + nqp::if( # 1|2|3 + nqp::existskey($init,nqp::atpos($task,2)), + nqp::if( # can initialize + nqp::iseq_i($code,1), + nqp::bindattr_i(self, # 1 nqp::atpos($task,1), - nqp::atpos($task,2), - nqp::atpos($task,4)(self, - nqp::getattr_i(self, - nqp::atpos($task,1), - nqp::atpos($task,2) - ) - ) + nqp::atpos($task,3), + nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,2))) + ), + nqp::if( + nqp::iseq_i($code,2), + nqp::bindattr_n(self, # 2 + nqp::atpos($task,1), + nqp::atpos($task,3), + nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,2))) + ), + nqp::bindattr_s(self, # 3 + nqp::atpos($task,1), + nqp::atpos($task,3), + nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,2))) + ) ) ) ), - nqp::if( # > 1 - nqp::iseq_i($code,2), - nqp::if( # 2 - nqp::existskey($init,nqp::atpos($task,3)), - nqp::bindattr_n(self, # init value + nqp::if( + nqp::iseq_i($code,4), + nqp::unless( # 4 + nqp::attrinited(self, nqp::atpos($task,1), - nqp::atpos($task,2), - nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,3))) + nqp::atpos($task,2) ), - nqp::if( # no init - nqp::iseq_i(nqp::elems($task),5), - nqp::bindattr_n(self, # but a default + nqp::stmts( + (my \attr := nqp::getattr(self, nqp::atpos($task,1), - nqp::atpos($task,2), - nqp::atpos($task,4)(self, - nqp::getattr_n(self, - nqp::atpos($task,1), - nqp::atpos($task,2) - ) - ) - ) + nqp::atpos($task,2) + )), + (attr = nqp::atpos($task,3)(self,attr)) ) ), - nqp::if( # > 2 - nqp::iseq_i($code,3), - nqp::if( # 3 - nqp::existskey($init,nqp::atpos($task,3)), - nqp::bindattr_s(self, # init value + nqp::if( + nqp::iseq_i($code,5), + nqp::if( # 5 + nqp::iseq_i(my $int = nqp::getattr_i(self, + nqp::atpos($task,1), + nqp::atpos($task,2) + ), 0), + nqp::bindattr_i(self, nqp::atpos($task,1), nqp::atpos($task,2), - nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,3))) - ), - nqp::if( # no init - nqp::iseq_i(nqp::elems($task),5), - nqp::bindattr_s(self, # but a default - nqp::atpos($task,1), - nqp::atpos($task,2), - nqp::atpos($task,4)(self, - nqp::getattr_s(self, - nqp::atpos($task,1), - nqp::atpos($task,2) - ) - ) - ) + (nqp::atpos($task,3)(self,$int)) ) ), - nqp::if( # > 3 - nqp::iseq_i($code,4), - nqp::unless( # 4 - nqp::attrinited(self, + nqp::if( + nqp::iseq_i($code,6), + nqp::if( # 6 + nqp::iseq_n(my num $num = nqp::getattr_n(self, nqp::atpos($task,1), nqp::atpos($task,2) - ), - nqp::getattr(self, # not initialized yet + ), 0e0), + nqp::bindattr_n(self, nqp::atpos($task,1), - nqp::atpos($task,2) - ) = nqp::atpos($task,3)(self, - nqp::getattr(self, - nqp::atpos($task,1), - nqp::atpos($task,2) - ) + nqp::atpos($task,2), + (nqp::atpos($task,3)(self,$num)) ) ), - nqp::if( # > 4 - nqp::iseq_i($code,5), - nqp::if( # 5 - nqp::iseq_i(my $int = nqp::getattr_i(self, + nqp::if( + nqp::iseq_i($code,7), + nqp::if( # 7 + nqp::isnull_s(my str $str = nqp::getattr_s(self, nqp::atpos($task,1), nqp::atpos($task,2) - ), 0), - nqp::bindattr_i(self, # not initialized yet + )), + nqp::bindattr_s(self, nqp::atpos($task,1), nqp::atpos($task,2), - nqp::atpos($task,3)(self,$int) + (nqp::atpos($task,3)(self,$str)) ) ), - nqp::if( # > 5 - nqp::iseq_i($code,6), - nqp::if( # 6 - nqp::iseq_n(my num $num = nqp::getattr_n(self, - nqp::atpos($task,1), - nqp::atpos($task,2) - ), 0e0), - nqp::bindattr_n(self, # not initialized yet - nqp::atpos($task,1), - nqp::atpos($task,2), - nqp::atpos($task,3)(self,$num) - ) + nqp::if( + nqp::iseq_i($code,8), + nqp::unless( # 8 + nqp::attrinited(self, + nqp::atpos($task,1), + nqp::atpos($task,2) ), + X::Attribute::Required.new( + name => nqp::atpos($task,2), + why => nqp::atpos($task,3) + ).throw + ), - nqp::if( # > 6 - nqp::iseq_i($code,7), - nqp::if( # 7 - nqp::isnull_s(my str $str = nqp::getattr_s(self, - nqp::atpos($task,1), - nqp::atpos($task,2) - )), - nqp::bindattr_s(self, # not initialized yet - nqp::atpos($task,1), - nqp::atpos($task,2), - (nqp::atpos($task,3)(self,$str)) - ) - ), - - nqp::if( # > 7 - nqp::iseq_i($code,8), - nqp::unless( # 8 - nqp::attrinited(self, - nqp::atpos($task,1), - nqp::atpos($task,2) - ), - X::Attribute::Required.new( # missing init - name => nqp::atpos($task,2), - why => nqp::atpos($task,3) - ).throw - ), - - nqp::if( # > 8 - nqp::iseq_i($code,9), - nqp::bindattr(self, # 9 - nqp::atpos($task,1), - nqp::atpos($task,2), - (nqp::atpos($task,3)()) - ), - die("Invalid BUILDALL plan") - ) - ) - ) - ) - ) - ) - ) - ) - ), + nqp::if( + nqp::iseq_i($code,9), + nqp::bindattr(self, # 9 + nqp::atpos($task,1), + nqp::atpos($task,2), + (nqp::atpos($task,3)()) + ), + die("Invalid BUILDALL plan"), + ))))))), - nqp::if( # 0 - nqp::existskey($init,nqp::atpos($task,3)), - (nqp::getattr(self,nqp::atpos($task,1),nqp::atpos($task,2)) - = %attrinit.AT-KEY(nqp::atpos($task,3))), - nqp::if( # no init - nqp::iseq_i(nqp::elems($task),5), - nqp::unless( # but has default - nqp::attrinited(self, - nqp::atpos($task,1), - nqp::atpos($task,2) - ), - nqp::getattr(self, # didn't init yet - nqp::atpos($task,1), - nqp::atpos($task,2) - ) = nqp::atpos($task,4)(self, - nqp::getattr(self, - nqp::atpos($task,1), - nqp::atpos($task,2) - ) - ) - ) - ) + nqp::if( # 0 + nqp::existskey($init,nqp::atpos($task,2)), + (nqp::getattr(self,nqp::atpos($task,1),nqp::atpos($task,3)) + = %attrinit.AT-KEY(nqp::atpos($task,2))), ) - ), - - nqp::if( # just call BUILD/TWEAK - nqp::istype( - (my $build := nqp::if( - nqp::elems($init), - $task(self,|%attrinit), - $task(self) - )), - Failure - ), - return $build ) ) ); @@ -373,233 +300,160 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" nqp::islt_i($i = nqp::add_i($i,1),$count), nqp::if( - nqp::islist(my $task := nqp::atpos($bp,$i)), - nqp::if( # got stuff to do + nqp::istype((my $task := nqp::atpos($bp,$i)),Callable), + nqp::if( # BUILD/TWEAK + nqp::istype( + (my $build := nqp::if( + nqp::elems($init), + $task(self,|%attrinit), + $task(self) + )), + Failure + ), + return $build + ), + + nqp::if( # not just calling (my int $code = nqp::atpos($task,0)), - nqp::if( # >0 - nqp::iseq_i($code,1), - nqp::if( # 1 - nqp::existskey($init,nqp::atpos($task,3)), - nqp::bindattr_i(self, # init value - nqp::atpos($task,1), - nqp::atpos($task,2), - nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,3))) - ), - nqp::if( # no init - nqp::iseq_i(nqp::elems($task),5), - nqp::bindattr_i(self, # but a default + nqp::if( # >0 + nqp::isle_i($code,3), + nqp::if( # 1|2|3 + nqp::existskey($init,nqp::atpos($task,2)), + nqp::if( # can initialize + nqp::iseq_i($code,1), + nqp::bindattr_i(self, # 1 nqp::atpos($task,1), - nqp::atpos($task,2), - nqp::atpos($task,4)(self, - nqp::getattr_i(self, - nqp::atpos($task,1), - nqp::atpos($task,2) - ) - ) + nqp::atpos($task,3), + nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,2))) + ), + nqp::if( + nqp::iseq_i($code,2), + nqp::bindattr_n(self, # 2 + nqp::atpos($task,1), + nqp::atpos($task,3), + nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,2))) + ), + nqp::bindattr_s(self, # 3 + nqp::atpos($task,1), + nqp::atpos($task,3), + nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,2))) + ) ) ) ), - nqp::if( # > 1 - nqp::iseq_i($code,2), - nqp::if( # 2 - nqp::existskey($init,nqp::atpos($task,3)), - nqp::bindattr_n(self, # init value + nqp::if( + nqp::iseq_i($code,4), + nqp::unless( # 4 + nqp::attrinited(self, nqp::atpos($task,1), - nqp::atpos($task,2), - nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,3))) + nqp::atpos($task,2) ), - nqp::if( # no init - nqp::iseq_i(nqp::elems($task),5), - nqp::bindattr_n(self, # but a default + nqp::stmts( + (my \attr := nqp::getattr(self, nqp::atpos($task,1), - nqp::atpos($task,2), - nqp::atpos($task,4)(self, - nqp::getattr_n(self, - nqp::atpos($task,1), - nqp::atpos($task,2) - ) - ) - ) + nqp::atpos($task,2) + )), + (attr = nqp::atpos($task,3)(self,attr)) ) ), - nqp::if( # > 2 - nqp::iseq_i($code,3), - nqp::if( # 3 - nqp::existskey($init,nqp::atpos($task,3)), - nqp::bindattr_s(self, # init value + nqp::if( + nqp::iseq_i($code,5), + nqp::if( # 5 + nqp::iseq_i(my $int = nqp::getattr_i(self, + nqp::atpos($task,1), + nqp::atpos($task,2) + ), 0), + nqp::bindattr_i(self, nqp::atpos($task,1), nqp::atpos($task,2), - nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,3))) - ), - nqp::if( # no init - nqp::iseq_i(nqp::elems($task),5), - nqp::bindattr_s(self, # but a default - nqp::atpos($task,1), - nqp::atpos($task,2), - nqp::atpos($task,4)(self, - nqp::getattr_s(self, - nqp::atpos($task,1), - nqp::atpos($task,2) - ) - ) - ) + (nqp::atpos($task,3)(self,$int)) ) ), - nqp::if( # > 3 - nqp::iseq_i($code,4), - nqp::unless( # 4 - nqp::attrinited(self, + nqp::if( + nqp::iseq_i($code,6), + nqp::if( # 6 + nqp::iseq_n(my num $num = nqp::getattr_n(self, nqp::atpos($task,1), nqp::atpos($task,2) - ), - nqp::getattr(self, # not initialized yet + ), 0e0), + nqp::bindattr_n(self, nqp::atpos($task,1), - nqp::atpos($task,2) - ) = nqp::atpos($task,3)(self, - nqp::getattr(self, - nqp::atpos($task,1), - nqp::atpos($task,2) - ) + nqp::atpos($task,2), + (nqp::atpos($task,3)(self,$num)) ) ), - nqp::if( # > 4 - nqp::iseq_i($code,5), - nqp::if( # 5 - nqp::iseq_i(my $int = nqp::getattr_i(self, + nqp::if( + nqp::iseq_i($code,7), + nqp::if( # 7 + nqp::isnull_s(my str $str = nqp::getattr_s(self, nqp::atpos($task,1), nqp::atpos($task,2) - ), 0), - nqp::bindattr_i(self, # not initialized yet + )), + nqp::bindattr_s(self, nqp::atpos($task,1), nqp::atpos($task,2), - nqp::atpos($task,3)(self,$int) + (nqp::atpos($task,3)(self,$str)) ) ), - nqp::if( # > 5 - nqp::iseq_i($code,6), - nqp::if( # 6 - nqp::iseq_n(my num $num = nqp::getattr_n(self, - nqp::atpos($task,1), - nqp::atpos($task,2) - ), 0e0), - nqp::bindattr_n(self, # not initialized yet - nqp::atpos($task,1), - nqp::atpos($task,2), - nqp::atpos($task,3)(self,$num) - ) + nqp::if( + nqp::iseq_i($code,8), + nqp::unless( # 8 + nqp::attrinited(self, + nqp::atpos($task,1), + nqp::atpos($task,2) ), + X::Attribute::Required.new( + name => nqp::atpos($task,2), + why => nqp::atpos($task,3) + ).throw + ), - nqp::if( # > 6 - nqp::iseq_i($code,7), - nqp::if( # 7 - nqp::isnull_s(my str $str = nqp::getattr_s(self, + nqp::if( + nqp::iseq_i($code,9), + nqp::bindattr(self, # 9 + nqp::atpos($task,1), + nqp::atpos($task,2), + (nqp::atpos($task,3)()) + ), + nqp::if( + nqp::iseq_i($code,10), + # Force vivification, for the sake of meta-object + # mix-ins at compile time ending up with correctly + # shared containers. + nqp::stmts( # 10 + nqp::getattr(self, nqp::atpos($task,1), nqp::atpos($task,2) - )), - nqp::bindattr_s(self, # not initialized yet - nqp::atpos($task,1), - nqp::atpos($task,2), - (nqp::atpos($task,3)(self,$str)) - ) - ), - - nqp::if( # > 7 - nqp::iseq_i($code,8), - nqp::unless( # 8 - nqp::attrinited(self, - nqp::atpos($task,1), - nqp::atpos($task,2) - ), - X::Attribute::Required.new( # missing init - name => nqp::atpos($task,2), - why => nqp::atpos($task,3) - ).throw ), - - nqp::if( # > 8 - nqp::iseq_i($code,9), - nqp::bindattr(self, # 9 + nqp::while( # 10's flock together + nqp::islt_i(($i = nqp::add_i($i,1)),$count) + && nqp::iseq_i( + nqp::atpos( + ($task := nqp::atpos($bp,$i)), + 0 + ),10 + ), + nqp::getattr(self, nqp::atpos($task,1), - nqp::atpos($task,2), - (nqp::atpos($task,3)()) - ), - - nqp::if( # > 9 - nqp::iseq_i($code,10), -# Force vivification, for the sake of meta-object mix-ins at compile time -# ending up with correctly shared containers. - nqp::stmts( # 10 - nqp::getattr(self, - nqp::atpos($task,1), - nqp::atpos($task,2) - ), - nqp::while( # 10's flock together - nqp::islt_i( - ($i = nqp::add_i($i,1)), - $count - ) && nqp::islist( - ($task := nqp::atpos($bp,$i)) - ) && nqp::iseq_i(nqp::atpos($task,0),10), - nqp::getattr(self, - nqp::atpos($task,1), - nqp::atpos($task,2) - ) - ), - ($i = nqp::sub_i($i,1)) - ), - die("Invalid BUILD_LEAST_DERIVED plan") + nqp::atpos($task,2) ) - ) - ) - ) - ) - ) - ) - ) - ) - ), + ), + ($i = nqp::sub_i($i,1)) + ), + die("Invalid BUILD_LEAST_DERIVED plan") + )))))))), - nqp::if( # 0 - nqp::existskey($init,nqp::atpos($task,3)), - (nqp::getattr(self,nqp::atpos($task,1),nqp::atpos($task,2)) - = %attrinit.AT-KEY(nqp::atpos($task,3))), - nqp::if( # no init - nqp::iseq_i(nqp::elems($task),5), - nqp::unless( # but has default - nqp::attrinited(self, - nqp::atpos($task,1), - nqp::atpos($task,2) - ), - nqp::getattr(self, # didn't init yet - nqp::atpos($task,1), - nqp::atpos($task,2) - ) = nqp::atpos($task,4)(self, - nqp::getattr(self, - nqp::atpos($task,1), - nqp::atpos($task,2) - ) - ) - ) - ) + nqp::if( # 0 + nqp::existskey($init,nqp::atpos($task,2)), + (nqp::getattr(self,nqp::atpos($task,1),nqp::atpos($task,3)) + = %attrinit.AT-KEY(nqp::atpos($task,2))), ) - ), - - nqp::if( # just call BUILD/TWEAK - nqp::istype( - (my $build := nqp::if( - nqp::elems($init), - $task(self,|%attrinit), - $task(self) - )), - Failure - ), - return $build ) ) ); From ce95e1628c4ad62471b038a50877aac2c3789066 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sat, 16 Sep 2017 00:22:59 +0200 Subject: [PATCH 070/692] Revert "Give enums an iterator" This reverts commit cc64a75842236de43b7874578b289f6fcd292c97. This appears to at least be given more thought. So at least reverting before the release. --- src/core/Enumeration.pm | 4 ---- 1 file changed, 4 deletions(-) diff --git a/src/core/Enumeration.pm b/src/core/Enumeration.pm index b1388c15108..0b3d8f4c25e 100644 --- a/src/core/Enumeration.pm +++ b/src/core/Enumeration.pm @@ -30,10 +30,6 @@ my role Enumeration { ) } - multi method iterator(::?CLASS:U:) { - Rakudo::Iterator.ReifiedList(self.^enum_value_list) - } - # Make sure we always accept any element of the enumeration multi method ACCEPTS(::?CLASS:D: ::?CLASS:U $ --> True) { } multi method ACCEPTS(::?CLASS:D: ::?CLASS:D \v) { self === v } From c3a71acb33c4f2d3b380cde17b26156b6e068f23 Mon Sep 17 00:00:00 2001 From: Samantha McVey Date: Sat, 16 Sep 2017 01:16:03 -0700 Subject: [PATCH 071/692] Add collation tests to spectest.data --- t/spectest.data | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/t/spectest.data b/t/spectest.data index 800edcd4eb6..b1f68b1ec98 100644 --- a/t/spectest.data +++ b/t/spectest.data @@ -1154,6 +1154,10 @@ S32-str/uc.t S32-str/unpack.t S32-str/utf8-c8.t # moar S32-str/words.t +S32-str/S32-str/CollationTest_NON_IGNORABLE-0.t # moar +S32-str/S32-str/CollationTest_NON_IGNORABLE-1.t # moar +S32-str/S32-str/CollationTest_NON_IGNORABLE-2.t # moar +S32-str/S32-str/CollationTest_NON_IGNORABLE-3.t # moar S32-temporal/calendar.t S32-temporal/Date.t S32-temporal/DateTime-Instant-Duration.t From e6a695b272ac2eeb3ebc0c38c18f52e3e73535bf Mon Sep 17 00:00:00 2001 From: Samantha McVey Date: Sat, 16 Sep 2017 07:42:40 -0700 Subject: [PATCH 072/692] Fix spectest.data path for Collation tests --- t/spectest.data | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/t/spectest.data b/t/spectest.data index b1f68b1ec98..c51314765db 100644 --- a/t/spectest.data +++ b/t/spectest.data @@ -1154,10 +1154,10 @@ S32-str/uc.t S32-str/unpack.t S32-str/utf8-c8.t # moar S32-str/words.t -S32-str/S32-str/CollationTest_NON_IGNORABLE-0.t # moar -S32-str/S32-str/CollationTest_NON_IGNORABLE-1.t # moar -S32-str/S32-str/CollationTest_NON_IGNORABLE-2.t # moar -S32-str/S32-str/CollationTest_NON_IGNORABLE-3.t # moar +S32-str/CollationTest_NON_IGNORABLE-0.t # moar +S32-str/CollationTest_NON_IGNORABLE-1.t # moar +S32-str/CollationTest_NON_IGNORABLE-2.t # moar +S32-str/CollationTest_NON_IGNORABLE-3.t # moar S32-temporal/calendar.t S32-temporal/Date.t S32-temporal/DateTime-Instant-Duration.t From bdbb7e4aca2a5f4adda657007bc211a97c8a9ca6 Mon Sep 17 00:00:00 2001 From: Aleks-Daniel Jakimenko-Aleksejev Date: Sat, 16 Sep 2017 18:32:43 +0300 Subject: [PATCH 073/692] Log remaining changes Deliberately not logged: 29691b2f c4043b06 b7ab48ee fe719405 06e20f80 cc64a758 ce95e162 dea0a085 a8e0352b 3de6f338 ac8e099b c3a71acb 66015614 --- docs/ChangeLog | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/docs/ChangeLog b/docs/ChangeLog index 28ae3ce4548..2c9ca3ceb32 100644 --- a/docs/ChangeLog +++ b/docs/ChangeLog @@ -17,6 +17,13 @@ New in 2017.09: + Fixed doubled path issue in IO::Notification.watch-path [2362dfd6] + Disabled interactive REPL for non-TTY input [b6a60236] + Fixed various issues with Unicode Prepend characters [7f526c1e] + + Suppress line number in X::Package::Stubbed [edac1d68][7ba9b7cd] + + Fixed race condition in Channel awaiter [b30ac08a] + + Fixed NYI compilation of NativeCall sigs with optional params [1818de98] + + Fixed missing deconts in nqp::eqaddr() tests [880b33e2] + + Fixed Enumeration:D === Enumeration:D [8d938461] + + Fixed non-blocking await when holding locks [f26d1e24] + + Fixed non-blocking await-all to respect Slip [a137c0de] + Additions: + Added support for Str operations with Junctions [753c9a5e][7cd153f4] [95a70ca3][0b19baf0][d2f31bb7][e18291e2][8b5d283c] @@ -27,11 +34,15 @@ New in 2017.09: + Made sure that open files are properly closed on exit [3c9cfdba] [97853564][347da8e5][dd8d0d89] + Added Unicode Collation Algorithm [9b42484a][5f335065][ec18efa0] + + Implement pred() and succ() for the Enumeration role [2645a1e9] + [8d442a52][8df53f34][43e41ec6][55aa7f28][f925c648][69dae1f3][2ad51a0f] + + Added isa method to SubsetHOW [0704cd97] + Build system: + Made t/harness* use 6 TEST_JOBS by default [8019c15b] + Added --ignore-errors option to Configure.pl [0bc1c877][1da075f9] + Fixed `make test` without `make install` first [fb0b3eb5] + Made Configure.pl refuse to work without ExtUtils::Command [3f4a9ffa] + + Fixed non-installed gdb/valgrind runners [4e3f0fca] + Efficiency: + Bump NQP/Moar to get Knuth-Morris-Pratt string search [593fa5f8] + Made `Any ~ Str` and `Str ~ Any` about 25% faster [815faa35] @@ -52,7 +63,8 @@ New in 2017.09: + Various heap analyzer API changes [bfee5a1e] + Streamlined exit / END phaser handling [1adacc72] + Made junction optimizer only look at candidates [4de858a5] - + Assortment of low-level improvements [cbce6721][8a215876][9b42484a] + + Assortment of low-level improvements [cbce6721][8a215876] + [9b42484a][a4ce97ca] New in 2017.08: + Security: From 24d6c66f30e1f5d4e1434f5eb602c16d283c28f0 Mon Sep 17 00:00:00 2001 From: Samantha McVey Date: Sat, 16 Sep 2017 13:45:47 -0700 Subject: [PATCH 074/692] Update ChangeLog with more Unicode/string related MoarVM changes --- docs/ChangeLog | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/docs/ChangeLog b/docs/ChangeLog index 2c9ca3ceb32..fdecffd9be1 100644 --- a/docs/ChangeLog +++ b/docs/ChangeLog @@ -16,7 +16,8 @@ New in 2017.09: + Made Bool.enums consistent with Enumeration.enums [e7a58806] + Fixed doubled path issue in IO::Notification.watch-path [2362dfd6] + Disabled interactive REPL for non-TTY input [b6a60236] - + Fixed various issues with Unicode Prepend characters [7f526c1e] + + Fix ignoremark and casechange operations of graphemes which begin with + Unicode Prepend characters [7f526c1e] + Suppress line number in X::Package::Stubbed [edac1d68][7ba9b7cd] + Fixed race condition in Channel awaiter [b30ac08a] + Fixed NYI compilation of NativeCall sigs with optional params [1818de98] @@ -28,12 +29,14 @@ New in 2017.09: + Added support for Str operations with Junctions [753c9a5e][7cd153f4] [95a70ca3][0b19baf0][d2f31bb7][e18291e2][8b5d283c] + Added support for Unicode 10 [64dd94c2] + + Added complete Unicode Collation Algorithm implementation [9b42484a][5f335065][ec18efa0] + + .collate/coll/unicmp operators are no longer experimental + (Note: $*COLLATION dynamic variable is still experimental) [5f3350656] + Added Thread.is-initial-thread method [59a2056a] + Added output buffering for non-TTYs [44680029][4b02b8aa] + Made temp and let on a Failure throw it [80a3255b] + Made sure that open files are properly closed on exit [3c9cfdba] [97853564][347da8e5][dd8d0d89] - + Added Unicode Collation Algorithm [9b42484a][5f335065][ec18efa0] + Implement pred() and succ() for the Enumeration role [2645a1e9] [8d442a52][8df53f34][43e41ec6][55aa7f28][f925c648][69dae1f3][2ad51a0f] + Added isa method to SubsetHOW [0704cd97] @@ -44,7 +47,12 @@ New in 2017.09: + Made Configure.pl refuse to work without ExtUtils::Command [3f4a9ffa] + Fixed non-installed gdb/valgrind runners [4e3f0fca] + Efficiency: - + Bump NQP/Moar to get Knuth-Morris-Pratt string search [593fa5f8] + + MoarVM: + + Knuth-Morris-Pratt string search has been implemented for string + indexing operations (needles between 2 and 8192 in length) [593fa5f8] + + 1.5-2x speedup of most string operations involving strands [5ebbc5baf] + + 2.5x speedup for eq() for comparing two flat strings (between 1.7-2x speedup for others) + + 9x speedup when indexing with a needle one grapheme in length [8a215876c] + Made `Any ~ Str` and `Str ~ Any` about 25% faster [815faa35] + Made index and eqat operations 2x faster [5ebbc5ba] + Made all(@a), none(@a), one(@a) about 9x faster [51c3d86c] From 1ca81432af51b842ca0f0c86b8b602ae358d8985 Mon Sep 17 00:00:00 2001 From: Timo Paulssen Date: Sun, 17 Sep 2017 01:11:47 +0200 Subject: [PATCH 075/692] refer to "want list?" var in permutations iterator properly since classes aren't closures, you could get the wrong type from interleaved pull-one calls on iterators with $!b set to different values. --- src/core/Rakudo/Iterator.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/Rakudo/Iterator.pm b/src/core/Rakudo/Iterator.pm index e9b75a1173d..c001b328173 100644 --- a/src/core/Rakudo/Iterator.pm +++ b/src/core/Rakudo/Iterator.pm @@ -2379,7 +2379,7 @@ class Rakudo::Iterator { ) ), nqp::if( - $b, + $!b, $permuted, nqp::p6bindattrinvres( nqp::create(List),List,'$!reified',$permuted) From 488ca6f067aeaadd4f2b6e4effa20aff36d1ca15 Mon Sep 17 00:00:00 2001 From: Timo Paulssen Date: Sun, 17 Sep 2017 01:13:33 +0200 Subject: [PATCH 076/692] same fix for Combinations as Permutations so we'll always get the correct type that was set on object creation time, not whatever was last passed to the Combinations method. --- src/core/Rakudo/Iterator.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/Rakudo/Iterator.pm b/src/core/Rakudo/Iterator.pm index c001b328173..09b298f1848 100644 --- a/src/core/Rakudo/Iterator.pm +++ b/src/core/Rakudo/Iterator.pm @@ -751,7 +751,7 @@ class Rakudo::Iterator { nqp::if( nqp::iseq_i($index,$k), nqp::if( - $b, + $!b, nqp::clone($!combination), nqp::p6bindattrinvres( nqp::create(List),List,'$!reified', From b76f7ccbfee4c18447bf25adbb0076c44d01295f Mon Sep 17 00:00:00 2001 From: Aleks-Daniel Jakimenko-Aleksejev Date: Sun, 17 Sep 2017 06:52:21 +0300 Subject: [PATCH 077/692] Resolve Releasable warnings Nothing wrong with longer shas, but it's 8 for consistency. --- docs/ChangeLog | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/docs/ChangeLog b/docs/ChangeLog index fdecffd9be1..349f7ed6642 100644 --- a/docs/ChangeLog +++ b/docs/ChangeLog @@ -31,7 +31,7 @@ New in 2017.09: + Added support for Unicode 10 [64dd94c2] + Added complete Unicode Collation Algorithm implementation [9b42484a][5f335065][ec18efa0] + .collate/coll/unicmp operators are no longer experimental - (Note: $*COLLATION dynamic variable is still experimental) [5f3350656] + (Note: $*COLLATION dynamic variable is still experimental) [5f335065] + Added Thread.is-initial-thread method [59a2056a] + Added output buffering for non-TTYs [44680029][4b02b8aa] + Made temp and let on a Failure throw it [80a3255b] @@ -50,9 +50,9 @@ New in 2017.09: + MoarVM: + Knuth-Morris-Pratt string search has been implemented for string indexing operations (needles between 2 and 8192 in length) [593fa5f8] - + 1.5-2x speedup of most string operations involving strands [5ebbc5baf] + + 1.5-2x speedup of most string operations involving strands [5ebbc5ba] + 2.5x speedup for eq() for comparing two flat strings (between 1.7-2x speedup for others) - + 9x speedup when indexing with a needle one grapheme in length [8a215876c] + + 9x speedup when indexing with a needle one grapheme in length [8a215876] + Made `Any ~ Str` and `Str ~ Any` about 25% faster [815faa35] + Made index and eqat operations 2x faster [5ebbc5ba] + Made all(@a), none(@a), one(@a) about 9x faster [51c3d86c] From d3f542d65bb588a52b7e57bf2fb28d2fa33fefff Mon Sep 17 00:00:00 2001 From: Aleks-Daniel Jakimenko-Aleksejev Date: Sun, 17 Sep 2017 06:55:03 +0300 Subject: [PATCH 078/692] Fix needless buffering when running prove with -j See RT #132108 --- lib/Test.pm6 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lib/Test.pm6 b/lib/Test.pm6 index ea4176a40d8..8ef52b9d036 100644 --- a/lib/Test.pm6 +++ b/lib/Test.pm6 @@ -39,6 +39,8 @@ my int $done_testing_has_been_run = 0; _init_vars(); sub _init_io { + nqp::setbuffersizefh(nqp::getstdin(), 0); + nqp::setbuffersizefh(nqp::getstdout(), 0); $output = $PROCESS::OUT; $failure_output = $PROCESS::ERR; $todo_output = $PROCESS::OUT; From aca6f9bfa879950729088cc628852d7931462c53 Mon Sep 17 00:00:00 2001 From: Aleks-Daniel Jakimenko-Aleksejev Date: Sun, 17 Sep 2017 17:21:56 +0300 Subject: [PATCH 079/692] Oops. Un-buffer stderr, not stdin --- lib/Test.pm6 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/Test.pm6 b/lib/Test.pm6 index 8ef52b9d036..6ba89e9f131 100644 --- a/lib/Test.pm6 +++ b/lib/Test.pm6 @@ -39,8 +39,8 @@ my int $done_testing_has_been_run = 0; _init_vars(); sub _init_io { - nqp::setbuffersizefh(nqp::getstdin(), 0); nqp::setbuffersizefh(nqp::getstdout(), 0); + nqp::setbuffersizefh(nqp::getstderr(), 0); $output = $PROCESS::OUT; $failure_output = $PROCESS::ERR; $todo_output = $PROCESS::OUT; From 85514723da3c79db5d0cd0474b7d46c0a24c0de9 Mon Sep 17 00:00:00 2001 From: Aleks-Daniel Jakimenko-Aleksejev Date: Sun, 17 Sep 2017 18:09:09 +0300 Subject: [PATCH 080/692] Frequent bumps are good before the release --- docs/release_guide.pod | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/docs/release_guide.pod b/docs/release_guide.pod index 3eb23d8a7bf..e954c79e700 100644 --- a/docs/release_guide.pod +++ b/docs/release_guide.pod @@ -74,6 +74,11 @@ the release announcement). =item * +B, especially the day before the release. Otherwise issues +with MoarVM/NQP might go unnoticed for too long. + +=item * + Create a draft release announcement in docs/announce/YYYY.MM.md in markdown format. You can often use the previous release’s file as a starting point, updating the release number, version information, name, From 9eeb357111f2b3383d0db457a15b58f9ea93d688 Mon Sep 17 00:00:00 2001 From: Cuong Manh Le Date: Sun, 17 Sep 2017 23:59:55 +0700 Subject: [PATCH 081/692] remove bad comment of srand --- src/core/Num.pm | 1 - 1 file changed, 1 deletion(-) diff --git a/src/core/Num.pm b/src/core/Num.pm index 0794e93247b..a992d08f125 100644 --- a/src/core/Num.pm +++ b/src/core/Num.pm @@ -491,7 +491,6 @@ sub rand(--> Num:D) { nqp::p6box_n(nqp::rand_n(1e0)); } -# TODO: default seed of 'time' sub srand(Int $seed --> Int:D) { nqp::p6box_i(nqp::srand($seed)) } From 3f47eba3734c023f3cfdfad1e6f9f317cea3ccdf Mon Sep 17 00:00:00 2001 From: Aleks-Daniel Jakimenko-Aleksejev Date: Sun, 17 Sep 2017 20:56:23 +0300 Subject: [PATCH 082/692] Pre-release NQP_REVISION bump --- tools/build/NQP_REVISION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/build/NQP_REVISION b/tools/build/NQP_REVISION index 3ef99757c08..71c0772c366 100644 --- a/tools/build/NQP_REVISION +++ b/tools/build/NQP_REVISION @@ -1 +1 @@ -2017.08-71-gf3b0f0c +2017.08-75-g71c775fee From 68e54f98f0e3364daa5f6aaf444c6916a2b92232 Mon Sep 17 00:00:00 2001 From: Aleks-Daniel Jakimenko-Aleksejev Date: Sun, 17 Sep 2017 23:49:08 +0300 Subject: [PATCH 083/692] Pre-release NQP_REVISION bump --- tools/build/NQP_REVISION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/build/NQP_REVISION b/tools/build/NQP_REVISION index 71c0772c366..d26707ce773 100644 --- a/tools/build/NQP_REVISION +++ b/tools/build/NQP_REVISION @@ -1 +1 @@ -2017.08-75-g71c775fee +2017.08-76-g1fd30a896 From 1c985681c096c2195e327f96bb5939685576b13b Mon Sep 17 00:00:00 2001 From: Aleks-Daniel Jakimenko-Aleksejev Date: Mon, 18 Sep 2017 00:30:52 +0300 Subject: [PATCH 084/692] Final tweaks for the ChangeLog Enforcing short line length to be more email-friendly. Novel MoarVM subsubsection is interesting, but if we do it we should be doing it consistently, therefore I will leave out it for now. One change is without a sha reference but that's OK. Deliberately not logged: 627de783 e6a695b2 bdbb7e4a 24d6c66f b76f7ccb d3f542d6 aca6f9bf 85514723 3f47eba3 68e54f98 9eeb3571 7b9e1037 9073a4dc 1ca81432 488ca6f0 --- docs/ChangeLog | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/docs/ChangeLog b/docs/ChangeLog index 349f7ed6642..97e94b67305 100644 --- a/docs/ChangeLog +++ b/docs/ChangeLog @@ -29,7 +29,8 @@ New in 2017.09: + Added support for Str operations with Junctions [753c9a5e][7cd153f4] [95a70ca3][0b19baf0][d2f31bb7][e18291e2][8b5d283c] + Added support for Unicode 10 [64dd94c2] - + Added complete Unicode Collation Algorithm implementation [9b42484a][5f335065][ec18efa0] + + Added complete Unicode Collation Algorithm implementation [9b42484a] + [5f335065][ec18efa0] + .collate/coll/unicmp operators are no longer experimental (Note: $*COLLATION dynamic variable is still experimental) [5f335065] + Added Thread.is-initial-thread method [59a2056a] @@ -47,12 +48,11 @@ New in 2017.09: + Made Configure.pl refuse to work without ExtUtils::Command [3f4a9ffa] + Fixed non-installed gdb/valgrind runners [4e3f0fca] + Efficiency: - + MoarVM: - + Knuth-Morris-Pratt string search has been implemented for string - indexing operations (needles between 2 and 8192 in length) [593fa5f8] - + 1.5-2x speedup of most string operations involving strands [5ebbc5ba] - + 2.5x speedup for eq() for comparing two flat strings (between 1.7-2x speedup for others) - + 9x speedup when indexing with a needle one grapheme in length [8a215876] + + Knuth-Morris-Pratt string search has been implemented for string + indexing operations (needles between 2 and 8192 in length) [593fa5f8] + + 1.5-2x speedup of most string operations involving strands [5ebbc5ba] + + 2.5x speedup for eq() for comparing two flat strings (1.7-2x for others) + + 9x speedup when indexing with a needle one grapheme in length [8a215876] + Made `Any ~ Str` and `Str ~ Any` about 25% faster [815faa35] + Made index and eqat operations 2x faster [5ebbc5ba] + Made all(@a), none(@a), one(@a) about 9x faster [51c3d86c] From 9d2dabf5d247fb16c1afcf2b443b48e63b26db61 Mon Sep 17 00:00:00 2001 From: Aleks-Daniel Jakimenko-Aleksejev Date: Mon, 18 Sep 2017 00:55:26 +0300 Subject: [PATCH 085/692] =?UTF-8?q?Make=20it=20clear=20that=20this=20is=20?= =?UTF-8?q?a=20Perl=C2=A06=20script?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Also add a shebang. “pl6” because other files in that folder use “pl6”. --- docs/release_guide.pod | 4 ++-- ...elease-announcement.pl => create-release-announcement.pl6} | 1 + 2 files changed, 3 insertions(+), 2 deletions(-) rename tools/{create-release-announcement.pl => create-release-announcement.pl6} (99%) diff --git a/docs/release_guide.pod b/docs/release_guide.pod index e954c79e700..6a647a3b88d 100644 --- a/docs/release_guide.pod +++ b/docs/release_guide.pod @@ -87,13 +87,13 @@ etc. as appropriate. git add docs/announce/YYYY.MM.md git commit docs -There is a helper script C that +There is a helper script C that will create a basic release announcement for you based on the state of the repository and the current date. Feel free to use it to save yourself some time, but please look over its output if you decide to use it: - ./perl6 tools/create-release-announcement.pl > docs/announce/YYYY.MM.md + ./perl6 tools/create-release-announcement.pl6 > docs/announce/YYYY.MM.md =item * diff --git a/tools/create-release-announcement.pl b/tools/create-release-announcement.pl6 similarity index 99% rename from tools/create-release-announcement.pl rename to tools/create-release-announcement.pl6 index 87445b91695..dab91f9119b 100755 --- a/tools/create-release-announcement.pl +++ b/tools/create-release-announcement.pl6 @@ -1,3 +1,4 @@ +#!/usr/bin/env perl6 use v6; my $template = q:to/END_TEMPLATE/; From 213c3e3e6fc701aa22bed722b121f1819961808a Mon Sep 17 00:00:00 2001 From: Aleks-Daniel Jakimenko-Aleksejev Date: Mon, 18 Sep 2017 01:06:41 +0300 Subject: [PATCH 086/692] Generate release announcement for 2017.09 --- docs/announce/2017.09.md | 148 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 148 insertions(+) create mode 100644 docs/announce/2017.09.md diff --git a/docs/announce/2017.09.md b/docs/announce/2017.09.md new file mode 100644 index 00000000000..d821aea927a --- /dev/null +++ b/docs/announce/2017.09.md @@ -0,0 +1,148 @@ +# Announce: Rakudo Perl 6 compiler, Release #115 (2017.09) + +On behalf of the Rakudo development team, I’m very happy to announce the +September 2017 release of Rakudo Perl 6 #115. Rakudo is an implementation of +Perl 6 on the Moar Virtual Machine[^1]. + +This release implements the 6.c version of the Perl 6 specifications. +It includes bugfixes and optimizations on top of +the 2015.12 release of Rakudo. + +Upcoming releases in 2017 will include new functionality that is not +part of the 6.c specification, available with a lexically scoped +pragma. Our goal is to ensure that anything that is tested as part of the +6.c specification will continue to work unchanged. There may be incremental +spec releases this year as well. + +The tarball for this release is available from . + +Please note: This announcement is not for the Rakudo Star +distribution[^2] — it’s announcing a new release of the compiler +only. For the latest Rakudo Star release, see +. + +The changes in this release are outlined below: + +New in 2017.09: + + Fixes: + + Fixed NativeCall signature check for unsupported native types [4077842c] + + Fixed .made called on a Match on which .make was never called [5db5b1db] + + Fixed flattening of a typed hash [6cec6b72] + + Fixed iterator on pairs with Mu's [a5014fd0] + + Fixed Supply.batch with non-int elems and elems == 1 [98f9fffe][7d1ece80] + + Improved error message on nameless postfix `.::` [5969f21e] + + Fixed ::("GLOBAL") [1f6a782c] + + Refined merging of one() junctions [79604a88] + + Fixed error message with leaking variable name in FailGoal [ed4f6cc9] + + Implemented missing Instant.Instant [51709e01] + + Fixed thread safety issues with signal introspection [1f411693] + + Fixed thread safety issues in the `signal` sub [13b6a33c] + + Fixed thread safety of "foo{$x}bar" [59454b03] + + Made Bool.enums consistent with Enumeration.enums [e7a58806] + + Fixed doubled path issue in IO::Notification.watch-path [2362dfd6] + + Disabled interactive REPL for non-TTY input [b6a60236] + + Fix ignoremark and casechange operations of graphemes which begin with + Unicode Prepend characters [7f526c1e] + + Suppress line number in X::Package::Stubbed [edac1d68][7ba9b7cd] + + Fixed race condition in Channel awaiter [b30ac08a] + + Fixed NYI compilation of NativeCall sigs with optional params [1818de98] + + Fixed missing deconts in nqp::eqaddr() tests [880b33e2] + + Fixed Enumeration:D === Enumeration:D [8d938461] + + Fixed non-blocking await when holding locks [f26d1e24] + + Fixed non-blocking await-all to respect Slip [a137c0de] + + Additions: + + Added support for Str operations with Junctions [753c9a5e][7cd153f4] + [95a70ca3][0b19baf0][d2f31bb7][e18291e2][8b5d283c] + + Added support for Unicode 10 [64dd94c2] + + Added complete Unicode Collation Algorithm implementation [9b42484a] + [5f335065][ec18efa0] + + .collate/coll/unicmp operators are no longer experimental + (Note: $*COLLATION dynamic variable is still experimental) [5f335065] + + Added Thread.is-initial-thread method [59a2056a] + + Added output buffering for non-TTYs [44680029][4b02b8aa] + + Made temp and let on a Failure throw it [80a3255b] + + Made sure that open files are properly closed on exit [3c9cfdba] + [97853564][347da8e5][dd8d0d89] + + Implement pred() and succ() for the Enumeration role [2645a1e9] + [8d442a52][8df53f34][43e41ec6][55aa7f28][f925c648][69dae1f3][2ad51a0f] + + Added isa method to SubsetHOW [0704cd97] + + Build system: + + Made t/harness* use 6 TEST_JOBS by default [8019c15b] + + Added --ignore-errors option to Configure.pl [0bc1c877][1da075f9] + + Fixed `make test` without `make install` first [fb0b3eb5] + + Made Configure.pl refuse to work without ExtUtils::Command [3f4a9ffa] + + Fixed non-installed gdb/valgrind runners [4e3f0fca] + + Efficiency: + + Knuth-Morris-Pratt string search has been implemented for string + indexing operations (needles between 2 and 8192 in length) [593fa5f8] + + 1.5-2x speedup of most string operations involving strands [5ebbc5ba] + + 2.5x speedup for eq() for comparing two flat strings (1.7-2x for others) + + 9x speedup when indexing with a needle one grapheme in length [8a215876] + + Made `Any ~ Str` and `Str ~ Any` about 25% faster [815faa35] + + Made index and eqat operations 2x faster [5ebbc5ba] + + Made all(@a), none(@a), one(@a) about 9x faster [51c3d86c] + + Various improvements to BUILDPLAN and BUILDALLPLAN [7da0c215][0ca5ffa4] + [760530a5][80e069a4][2574f883][b706b843][963b28d1][532f7092] + + Made object creation 25% faster in some cases [62fd5093] + + Internal: + + Simplified setting up auto-threading [8a0f6ac1] + + Streamlined Junction .defined, .Bool, .ACCEPTS [e8137b45] + + Added --no-merge option to t/harness5 to pass through STDERR [4af1d95c] + [84b40cf5] + + Various improvements to INTERPOLATE [215a5fa7][ea57cbec][c6aacafd] + [47439e69][4c25df74][fc632cd8] + + Some minor cleanup on R:I.FirstNThenSinkAll [9dbc3c50] + + Fixed --ll-exception to give full thread backtrace [0877278e] + + Various heap analyzer API changes [bfee5a1e] + + Streamlined exit / END phaser handling [1adacc72] + + Made junction optimizer only look at candidates [4de858a5] + + Assortment of low-level improvements [cbce6721][8a215876] + [9b42484a][a4ce97ca] + + +The following people contributed to this release: + +Elizabeth Mattijsen, Aleks-Daniel Jakimenko-Aleksejev, Pawel Murias, +Will "Coke" Coleda, Samantha McVey, Jonathan Worthington, Moritz Lenz, +Steve Mynott, Wenzel P. P. Peppmeyer, Nick Logan, Daniel Green, Zak B. Elep, +Stefan Seifert, Philippe Bruhat (BooK), Timo Paulssen, Altai-man, +Christian Bartolomäus, Cuong Manh Le, Brian S. Julin, Claudio Ramirez, +Juan Julián Merelo Guervós, Christopher Bottoms, rafaelschipiura, +Lance Wicks, Jeremy Studer, Adrian White, David Warring, Leon Timmermans, +andreoss, Andrew Ruder, Douglas L. Schrag, Peter Stuifzand, John Harrison, +Salve J. Nilsen, Zoffix Znet + +If you would like to contribute or find out more information, visit +, , ask on the + mailing list, or ask on IRC #perl6 on freenode. + +Additionally, we invite you to make a donation to The Perl Foundation +to sponsor Perl 6 development: +(put “Perl 6 Core Development Fund” in the ‘Purpose’ text field) + +The next release of Rakudo (#116), is tentatively scheduled for 2017-10-21. + +A list of the other planned release dates is available in the +“docs/release_guide.pod” file. + +The development team appreciates feedback! If you’re using Rakudo, do +get back to us. Questions, comments, suggestions for improvements, cool +discoveries, incredible hacks, or any other feedback – get in touch with +us through (the above-mentioned) mailing list or IRC channel. Enjoy! + +Please note that recent releases have known issues running on the JVM. +We are working to get the JVM backend working again but do not yet have +an estimated delivery date. + +[^1]: See + +[^2]: What’s the difference between the Rakudo compiler and the Rakudo +Star distribution? + +The Rakudo compiler is a compiler for the Perl 6 language. +Not much more. + +The Rakudo Star distribution is the Rakudo compiler plus a selection +of useful Perl 6 modules, a module installer, Perl 6 introductory +documentation, and other software that can be used with the Rakudo +compiler to enhance its utility. From 8b05c34ac7dd7b14a08e1eccdd944620399e46fc Mon Sep 17 00:00:00 2001 From: Aleks-Daniel Jakimenko-Aleksejev Date: Mon, 18 Sep 2017 02:14:04 +0300 Subject: [PATCH 087/692] Reflect actual date, claim next release --- docs/release_guide.pod | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/docs/release_guide.pod b/docs/release_guide.pod index 6a647a3b88d..f0fe868df83 100644 --- a/docs/release_guide.pod +++ b/docs/release_guide.pod @@ -22,8 +22,7 @@ Note that we are trying very hard to ensure there are no backward compatibility issues post Christmas. As such, we may end up delaying some releases to ensure any compatibility issues are resolved. - 2017-09-16 Rakudo #115 (AlexDaniel) - 2017-10-21 Rakudo #116 + 2017-10-21 Rakudo #116 (AlexDaniel + Releasable) 2017-11-18 Rakudo #117 2017-12-16 Rakudo #118 2018-01-20 Rakudo #119 @@ -451,6 +450,7 @@ Previous releases were bundled as part of monthly Parrot releases. 2017-06-17 Rakudo #112 "2017.06" (Zoffix + NeuralAnomaly) 2017-07-15 Rakudo #113 "2017.07" (Zoffix + NeuralAnomaly) 2017-08-21 Rakudo #114 "2017.08" (AlexDaniel + Releasable) + 2017-09-18 Rakudo #115 "2017.09" (AlexDaniel + Releasable) =head1 COPYRIGHT From b4ba33af43f6faca869554fa6e00324e2cec7719 Mon Sep 17 00:00:00 2001 From: Aleks-Daniel Jakimenko-Aleksejev Date: Mon, 18 Sep 2017 02:29:04 +0300 Subject: [PATCH 088/692] [release] Bump NQP revision to 2017.09 --- tools/build/NQP_REVISION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/build/NQP_REVISION b/tools/build/NQP_REVISION index d26707ce773..eae7db5dd46 100644 --- a/tools/build/NQP_REVISION +++ b/tools/build/NQP_REVISION @@ -1 +1 @@ -2017.08-76-g1fd30a896 +2017.09 From ce12e480316e042db3f7b70bd8aefa13544425e9 Mon Sep 17 00:00:00 2001 From: Aleks-Daniel Jakimenko-Aleksejev Date: Mon, 18 Sep 2017 02:29:04 +0300 Subject: [PATCH 089/692] [release] Bump VERSION to 2017.09 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index e4e3626979e..eae7db5dd46 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -2017.08 +2017.09 From 5a19dffa075ec8cc66adc4a43966c3d4b897ae90 Mon Sep 17 00:00:00 2001 From: Cuong Manh Le Date: Mon, 18 Sep 2017 13:22:22 +0700 Subject: [PATCH 090/692] Add trim* subroutines for Cool instance --- src/core/Str.pm | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/src/core/Str.pm b/src/core/Str.pm index b4a84056f58..d4c943cadab 100644 --- a/src/core/Str.pm +++ b/src/core/Str.pm @@ -2918,10 +2918,12 @@ multi sub ords(Str $s) { $s.ords } -# TODO: Cool variants -sub trim (Str:D $s --> Str:D) { $s.trim } -sub trim-leading (Str:D $s --> Str:D) { $s.trim-leading } -sub trim-trailing(Str:D $s --> Str:D) { $s.trim-trailing } +multi sub trim (Str:D $s --> Str:D) { $s.trim } +multi sub trim (Cool:D $c --> Str:D) { $c.Stringy.trim } +multi sub trim-leading (Str:D $s --> Str:D) { $s.trim-leading } +multi sub trim-leading (Cool:D $c --> Str:D) { $c.Stringy.trim-leading } +multi sub trim-trailing(Str:D $s --> Str:D) { $s.trim-trailing } +multi sub trim-trailing(Cool:D $c --> Str:D) { $c.Stringy.trim-trailing } # the opposite of Real.base, used for :16($hex_str) proto sub UNBASE (|) { * } From 691f8b7b18b01fd8966742fad12a753d6e714bf2 Mon Sep 17 00:00:00 2001 From: Cuong Manh Le Date: Mon, 18 Sep 2017 13:46:23 +0700 Subject: [PATCH 091/692] Remove un-necessary call to Stringy --- src/core/Str.pm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/core/Str.pm b/src/core/Str.pm index d4c943cadab..5de2e42de6b 100644 --- a/src/core/Str.pm +++ b/src/core/Str.pm @@ -2919,11 +2919,11 @@ multi sub ords(Str $s) { } multi sub trim (Str:D $s --> Str:D) { $s.trim } -multi sub trim (Cool:D $c --> Str:D) { $c.Stringy.trim } +multi sub trim (Cool:D $c --> Str:D) { $c.trim } multi sub trim-leading (Str:D $s --> Str:D) { $s.trim-leading } -multi sub trim-leading (Cool:D $c --> Str:D) { $c.Stringy.trim-leading } +multi sub trim-leading (Cool:D $c --> Str:D) { $c.trim-leading } multi sub trim-trailing(Str:D $s --> Str:D) { $s.trim-trailing } -multi sub trim-trailing(Cool:D $c --> Str:D) { $c.Stringy.trim-trailing } +multi sub trim-trailing(Cool:D $c --> Str:D) { $c.trim-trailing } # the opposite of Real.base, used for :16($hex_str) proto sub UNBASE (|) { * } From e01e5bc3873ab78d463d6b25436cd5d08e8890d3 Mon Sep 17 00:00:00 2001 From: Cuong Manh Le Date: Mon, 18 Sep 2017 16:50:25 +0700 Subject: [PATCH 092/692] Cleanup trim* subroutines Since when Str is also Cool, there is no reason to duplicate the candidate for Cool ans Str. Per: https://irclog.perlgeek.de/perl6-dev/2017-09-18#i_15179761 --- src/core/Str.pm | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/src/core/Str.pm b/src/core/Str.pm index 5de2e42de6b..f7492739d32 100644 --- a/src/core/Str.pm +++ b/src/core/Str.pm @@ -2918,12 +2918,9 @@ multi sub ords(Str $s) { $s.ords } -multi sub trim (Str:D $s --> Str:D) { $s.trim } -multi sub trim (Cool:D $c --> Str:D) { $c.trim } -multi sub trim-leading (Str:D $s --> Str:D) { $s.trim-leading } -multi sub trim-leading (Cool:D $c --> Str:D) { $c.trim-leading } -multi sub trim-trailing(Str:D $s --> Str:D) { $s.trim-trailing } -multi sub trim-trailing(Cool:D $c --> Str:D) { $c.trim-trailing } +sub trim (Cool:D $s --> Str:D) { $s.trim } +sub trim-leading (Cool:D $s --> Str:D) { $s.trim-leading } +sub trim-trailing(Cool:D $s --> Str:D) { $s.trim-trailing } # the opposite of Real.base, used for :16($hex_str) proto sub UNBASE (|) { * } From 48406db639183f850bfd7b6d22de5fb4c794fdb8 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Mon, 18 Sep 2017 12:01:19 +0200 Subject: [PATCH 093/692] Streamline registering an encoding Not much for something that only needs to be done once, you might argue. But we're doing *7* of these at *every* perl6 startup. This shaves 1-2 milliseconds off of each perl6 startup. --- src/core/Encoding/Registry.pm | 35 +++++++++++++++++++++++++---------- 1 file changed, 25 insertions(+), 10 deletions(-) diff --git a/src/core/Encoding/Registry.pm b/src/core/Encoding/Registry.pm index b84b714ace4..d2b173d87d9 100644 --- a/src/core/Encoding/Registry.pm +++ b/src/core/Encoding/Registry.pm @@ -3,24 +3,39 @@ my class X::Encoding::AlreadyRegistered { ... } my class Encoding::Registry { my $lock := Lock.new; - my %lookup; + my $lookup := nqp::hash; method register(Encoding $enc --> Nil) { - my @names = ($enc.name, $enc.alternative-names).flat.map(*.fc); $lock.protect: { - if %lookup{@names}:k -> @bad { - X::Encoding::AlreadyRegistered.new(name => @bad[0]).throw; - } - %lookup{@names} = $enc xx *; + nqp::stmts( + nqp::if( + nqp::existskey($lookup,(my str $key = $enc.name.fc)), + X::Encoding::AlreadyRegistered.new(name => $enc.name).throw, + nqp::bindkey($lookup,$key,$enc) + ), + (my $names := + nqp::getattr($enc.alternative-names,List,'$!reified')), + (my int $elems = nqp::elems($names)), + (my int $i = -1), + nqp::while( + nqp::islt_i(($i = nqp::add_i($i,1)),$elems), + nqp::if( + nqp::existskey($lookup,($key = nqp::atpos($names,$i).fc)), + X::Encoding::AlreadyRegistered.new( + name => nqp::atpos($names,$i)).throw, + nqp::bindkey($lookup,$key,$enc) + ) + ) + ) } } method find(Str() $name) { $lock.protect: { - my $fname = $name.fc; - %lookup{$fname}:exists - ?? %lookup{$fname} - !! X::Encoding::Unknown.new(:$name).throw + nqp::ifnull( + nqp::atkey($lookup,$name.fc), + X::Encoding::Unknown.new(:$name).throw + ) } } } From 53dd776c9a2519de7c8077a2820a538e4f1d77da Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Mon, 18 Sep 2017 12:50:37 +0200 Subject: [PATCH 094/692] Add Lock::Async Which will be used in order to do concurrency control in a more scalable way for supplies. --- src/core/Lock/Async.pm | 128 ++++++++++++++++++++++++++++++++++ tools/build/moar_core_sources | 1 + 2 files changed, 129 insertions(+) create mode 100644 src/core/Lock/Async.pm diff --git a/src/core/Lock/Async.pm b/src/core/Lock/Async.pm new file mode 100644 index 00000000000..bd34f822eff --- /dev/null +++ b/src/core/Lock/Async.pm @@ -0,0 +1,128 @@ +# An asynchronous lock provides a non-blocking non-reentrant mechanism for +# mutual exclusion. The lock method returns a Promise, which will already be +# Kept if nothing was holding the lock already, so execution can proceed +# immediately. For performance reasons, in this case it returns a singleton +# Promise instance. Otherwise, a Promise in planned state will be returned, +# and Kept once the lock has been unlocked by its current holder. The lock +# and unlock do not need to take place on the same thread; that's why it's not +# reentrant. + +my class X::Lock::Async::NotLocked is Exception { + method message() { + "Cannot unlock a Lock::Async that is not currently locked" + } +} + +my class Lock::Async { + # The Holder class is an immutable object. A type object represents an + # unheld lock, an instance represents a held lock, and it has a queue of + # vows to be kept on unlock. + my class Holder { + has $!queue; + + method queue-vow(\v) { + my $new-queue := $!queue.DEFINITE + ?? nqp::clone($!queue) + !! nqp::list(); + nqp::push($new-queue, v); + nqp::p6bindattrinvres(nqp::create(Holder), Holder, '$!queue', $new-queue) + } + + method waiter-queue-length() { + nqp::elems($!queue) + } + + # Assumes it won't be called if there is no queue (SINGLE_HOLDER case + # in unlock()) + method head-vow() { + nqp::atpos($!queue, 0) + } + + # Assumes it won't be called if the queue only had one item in it (to + # mantain SINGLE_HOLDER fast path usage) + method without-head-vow() { + my $new-queue := nqp::clone($!queue); + nqp::shift($new-queue); + nqp::p6bindattrinvres(nqp::create(Holder), Holder, '$!queue', $new-queue) + } + } + + # Base states for Holder + my constant NO_HOLDER = Holder; + my constant SINGLE_HOLDER = Holder.new; + + # The current holder record, with waiters queue, of the lock. + has Holder $!holder = Holder; + + # Singleton Promise to be used when there's no need to wait. + my \KEPT-PROMISE := do { + my \p = Promise.new; + p.keep(True); + p + } + + method lock(Lock::Async:D: --> Promise) { + loop { + my $holder := ⚛$!holder; + if $holder.DEFINITE { + my $p := Promise.new; + my $v := $p.vow; + my $holder-update = $holder.queue-vow($v); + if cas($!holder, $holder, $holder-update) =:= $holder { + return $p; + } + } + else { + if cas($!holder, NO_HOLDER, SINGLE_HOLDER) =:= NO_HOLDER { + # Successfully acquired and we're the only holder + return KEPT-PROMISE; + } + } + } + } + + method unlock(Lock::Async:D: --> Nil) { + loop { + my $holder := ⚛$!holder; + if $holder =:= SINGLE_HOLDER { + # We're the single holder and there's no wait queue. + if cas($!holder, SINGLE_HOLDER, NO_HOLDER) =:= SINGLE_HOLDER { + # Successfully released to NO_HOLDER state. + return; + } + } + elsif $holder.DEFINITE { + my int $queue-length = $holder.waiter-queue-length(); + my $v := $holder.head-vow; + if $queue-length == 1 { + if cas($!holder, $holder, SINGLE_HOLDER) =:= $holder { + # Successfully released; keep the head vow, thus + # giving the lock to the next waiter. + $v.keep(True); + return; + } + } + else { + my $new-holder := $holder.without-head-vow(); + if cas($!holder, $holder, $new-holder) =:= $holder { + # Successfully released and installed remaining queue; + # keep the head vow which we successfully removed. + $v.keep(True); + return; + } + } + } + else { + die X::Lock::Async::NotLocked.new; + } + } + } + + method protect(Lock::Async:D: &code) { + my int $acquired = 0; + $*AWAITER.await(self.lock()); + $acquired = 1; + LEAVE self.unlock() if $acquired; + code() + } +} diff --git a/tools/build/moar_core_sources b/tools/build/moar_core_sources index 863dd5071da..b73e62816c4 100644 --- a/tools/build/moar_core_sources +++ b/tools/build/moar_core_sources @@ -150,6 +150,7 @@ src/core/precedence.pm src/core/Deprecations.pm src/core/Thread.pm src/core/Lock.pm +src/core/Lock/Async.pm src/core/Semaphore.pm src/core/Cancellation.pm src/core/Awaitable.pm From 4a8038c2956e863bc661a2a00e8371eb98002608 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Mon, 18 Sep 2017 13:09:56 +0200 Subject: [PATCH 095/692] Start using Lock::Async in some Supply internals No regressions in stresstest from this, which is a promising sign. --- src/core/Supply.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/Supply.pm b/src/core/Supply.pm index 77949b743c2..c94eb60222b 100644 --- a/src/core/Supply.pm +++ b/src/core/Supply.pm @@ -178,7 +178,7 @@ my class Supply does Awaitable { method serialize(Supply:D:) { $!tappable.serial ?? self !! Supply.new(class :: does SimpleOpTappable { - has $!lock = Lock.new; + has $!lock = Lock::Async.new; submethod BUILD(:$!source! --> Nil) { } @@ -370,7 +370,7 @@ my class Supply does Awaitable { has $!time; has $!scheduler; has $!last_cancellation; - has $!lock = Lock.new; + has $!lock = Lock::Async.new; submethod BUILD(:$!source!, :$!time!, :$!scheduler! --> Nil) { } From 0ffff8596cc03144bbe5b30e0775772bda2742c8 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Mon, 18 Sep 2017 13:16:22 +0200 Subject: [PATCH 096/692] Run S17-promise/lock-async.t --- t/spectest.data | 1 + 1 file changed, 1 insertion(+) diff --git a/t/spectest.data b/t/spectest.data index c51314765db..7b1d99a798e 100644 --- a/t/spectest.data +++ b/t/spectest.data @@ -839,6 +839,7 @@ S17-promise/at.t S17-promise/anyof.t S17-promise/basic.t S17-promise/in.t # slow +S17-promise/lock-async.t S17-promise/start.t # slow S17-promise/stress.t # stress S17-promise/then.t From 85bdd38afaf5855c9676e91ea49107eda655ccb7 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Mon, 18 Sep 2017 14:19:53 +0200 Subject: [PATCH 097/692] Use Lock::Async in supply sequencer --- src/core/Rakudo/Internals.pm | 2 +- src/core/stubs.pm | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/src/core/Rakudo/Internals.pm b/src/core/Rakudo/Internals.pm index f4cb966009d..0324469d45d 100644 --- a/src/core/Rakudo/Internals.pm +++ b/src/core/Rakudo/Internals.pm @@ -500,7 +500,7 @@ my class Rakudo::Internals { $!buffer-start-seq = 0; $!done-target = -1; $!bust = 0; - $!lock := Lock.new; + $!lock := Lock::Async.new; } method process(Mu \seq, Mu \data, Mu \err) { diff --git a/src/core/stubs.pm b/src/core/stubs.pm index 5eb0db9d7ca..e5e220f0292 100644 --- a/src/core/stubs.pm +++ b/src/core/stubs.pm @@ -26,6 +26,7 @@ my class Mix { ... } my class MixHash { ... } my class Lock is repr('ReentrantMutex') { ... } +my class Lock::Async { ... } sub DYNAMIC(\name) is raw { nqp::ifnull( From 388964020c863f4b03f3935187d244aa0c1878c6 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Mon, 18 Sep 2017 14:54:45 +0200 Subject: [PATCH 098/692] Use Lock::Async in Supply.interval --- src/core/Supply.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/Supply.pm b/src/core/Supply.pm index c94eb60222b..dc2f8f9ffac 100644 --- a/src/core/Supply.pm +++ b/src/core/Supply.pm @@ -140,7 +140,7 @@ my class Supply does Awaitable { method tap(&emit, |) { my $i = 0; - my $lock = Lock.new; + my $lock = Lock::Async.new; my $cancellation = $!scheduler.cue( { emit($lock.protect: { $i++ }); From 32e4a1de29471105a9ec3db20ae10df8c328f063 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Mon, 18 Sep 2017 16:30:43 +0200 Subject: [PATCH 099/692] Basic atomic reference op support on JVM backend Still missing enforcing any type checks on the container, but enough to allow for Lock::Async to work. --- src/core/atomicops.pm | 61 +++++++++---------- .../org/perl6/rakudo/RakudoContainerSpec.java | 43 +++++++++++++ 2 files changed, 73 insertions(+), 31 deletions(-) diff --git a/src/core/atomicops.pm b/src/core/atomicops.pm index 2395bd73317..764cc20f0ae 100644 --- a/src/core/atomicops.pm +++ b/src/core/atomicops.pm @@ -1,28 +1,49 @@ -#?if moar -my native atomicint is repr('P6int') is Int is ctype('atomic') { } - #-- fetching a value atomically proto sub atomic-fetch($) {*} multi sub atomic-fetch($source is rw) { nqp::atomicload($source) } -multi sub atomic-fetch(atomicint $source is rw) { - nqp::atomicload_i($source) -} proto sub prefix:<⚛>($) {*} multi sub prefix:<⚛>($source is rw) { nqp::atomicload($source) } -multi sub prefix:<⚛>(atomicint $source is rw) { - nqp::atomicload_i($source) -} #-- assigning a value atomically proto sub atomic-assign($, $) {*} multi sub atomic-assign($target is rw, \value) { nqp::atomicstore($target, value) } + +#-- atomic compare and swap +proto sub cas(|) {*} +multi sub cas($target is rw, \expected, \value) { + nqp::cas($target, expected, value) +} +multi sub cas($target is rw, &code) { + my $current := nqp::atomicload($target); + loop { + my $updated := code($current); + my $seen := nqp::cas($target, $current, $updated); + return $updated if nqp::eqaddr($seen, $current); + $current := $seen; + } +} + +# Native integer atomics only available on MoarVM +#?if moar +my native atomicint is repr('P6int') is Int is ctype('atomic') { } + +#-- fetching a value atomically +multi sub atomic-fetch(atomicint $source is rw) { + nqp::atomicload_i($source) +} + +multi sub prefix:<⚛>(atomicint $source is rw) { + nqp::atomicload_i($source) +} + +#-- assigning a value atomically multi sub atomic-assign(atomicint $target is rw, int $value) { nqp::atomicstore_i($target, $value) } @@ -162,11 +183,6 @@ sub full-barrier(--> Nil) { } #-- atomic compare and swap -proto sub cas(|) {*} -multi sub cas($target is rw, \expected, \value) { - nqp::cas($target, expected, value) -} - multi sub cas(atomicint $target is rw, int $expected, int $value) { nqp::cas_i($target, $expected, $value) } @@ -179,16 +195,6 @@ multi sub cas(atomicint $target is rw, $expected, $value) { nqp::cas_i($target, $expected.Int, $value.Int) } -multi sub cas($target is rw, &code) { - my $current := nqp::atomicload($target); - loop { - my $updated := code($current); - my $seen := nqp::cas($target, $current, $updated); - return $updated if nqp::eqaddr($seen, $current); - $current := $seen; - } -} - multi sub cas(atomicint $target is rw, &code) { my int $current = nqp::atomicload_i($target); loop { @@ -199,10 +205,3 @@ multi sub cas(atomicint $target is rw, &code) { } } #?endif - -#?if !moar -# Retain cheating cas for the sake of spectests that use it. -multi sub cas($target is rw, &code) { - $target = code($target) -} -#?endif diff --git a/src/vm/jvm/runtime/org/perl6/rakudo/RakudoContainerSpec.java b/src/vm/jvm/runtime/org/perl6/rakudo/RakudoContainerSpec.java index 09e2d928ac9..9affa521423 100644 --- a/src/vm/jvm/runtime/org/perl6/rakudo/RakudoContainerSpec.java +++ b/src/vm/jvm/runtime/org/perl6/rakudo/RakudoContainerSpec.java @@ -1,5 +1,8 @@ package org.perl6.rakudo; +import java.lang.reflect.Field; +import sun.misc.Unsafe; + import org.perl6.nqp.runtime.*; import org.perl6.nqp.sixmodel.*; @@ -116,4 +119,44 @@ public void serialize(ThreadContext tc, STable st, SerializationWriter writer) { public void deserialize(ThreadContext tc, STable st, SerializationReader reader) { /* No data to deserialize. */ } + + /* Atomic operations. */ + + private Unsafe unsafe; + private long scalarValueOffset; + + @SuppressWarnings("restriction") + private void ensureAtomicsReady(SixModelObject cont) { + if (unsafe == null) { + try { + Field unsafeField = Unsafe.class.getDeclaredField("theUnsafe"); + unsafeField.setAccessible(true); + unsafe = (Unsafe)unsafeField.get(null); + scalarValueOffset = unsafe.objectFieldOffset( + cont.getClass().getDeclaredField("field_1")); + } + catch (Exception e) { + throw new RuntimeException(e); + } + } + } + + public SixModelObject cas(ThreadContext tc, SixModelObject cont, + SixModelObject expected, SixModelObject value) { + ensureAtomicsReady(cont); + return unsafe.compareAndSwapObject(cont, scalarValueOffset, expected, value) + ? expected + : (SixModelObject)unsafe.getObjectVolatile(cont, scalarValueOffset); + } + + public SixModelObject atomic_load(ThreadContext tc, SixModelObject cont) { + ensureAtomicsReady(cont); + return (SixModelObject)unsafe.getObjectVolatile(cont, scalarValueOffset); + } + + public void atomic_store(ThreadContext tc, SixModelObject cont, + SixModelObject value) { + ensureAtomicsReady(cont); + unsafe.putObjectVolatile(cont, scalarValueOffset, cont); + } } From 6170cb9d2a6030790a52ca31c32afb6a90f20992 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Mon, 18 Sep 2017 16:31:43 +0200 Subject: [PATCH 100/692] Add Lock::Async to the JVM CORE.setting build With this, it now successfully sanity tests again (meaning that supplies, which now use Lock::Async, are working at least well enough for Proc::Async, which precomp uses). --- tools/build/jvm_core_sources | 1 + 1 file changed, 1 insertion(+) diff --git a/tools/build/jvm_core_sources b/tools/build/jvm_core_sources index 960cc98b852..06b97f878ca 100644 --- a/tools/build/jvm_core_sources +++ b/tools/build/jvm_core_sources @@ -148,6 +148,7 @@ src/core/precedence.pm src/core/Deprecations.pm src/core/Thread.pm src/core/Lock.pm +src/core/Lock/Async.pm src/core/Semaphore.pm src/core/Cancellation.pm src/core/Awaitable.pm From 66c2d05f2995522295e19b7ae014fcb803347194 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Mon, 18 Sep 2017 16:34:03 +0200 Subject: [PATCH 101/692] Fix for RT #132117 This appears to break some test in S03-operators/eqv.t , which by the looks of it, are not very good tests. --- src/core/Mu.pm | 28 ++++++++++++++++------------ 1 file changed, 16 insertions(+), 12 deletions(-) diff --git a/src/core/Mu.pm b/src/core/Mu.pm index 020bf0e8c85..2daeba7940d 100644 --- a/src/core/Mu.pm +++ b/src/core/Mu.pm @@ -902,19 +902,23 @@ multi sub infix:(Any:D \a, Any:D \b) { multi sub infix:(Iterable:D \a, Iterable:D \b) { nqp::p6bool( nqp::unless( - nqp::eqaddr(a,b), # identity - nqp::if( - nqp::eqaddr(a.WHAT,b.WHAT), # same type + nqp::eqaddr(nqp::decont(a),nqp::decont(b)), + nqp::if( # not same object + a.is-lazy || b.is-lazy, + die("Cannoy eqv lazy Iterables"), nqp::if( - nqp::iseq_i((my int $elems = a.elems),b.elems), # same # elems - nqp::stmts( - (my int $i = -1), - nqp::while( - nqp::islt_i(($i = nqp::add_i($i,1)),$elems) # not exhausted - && a.AT-POS($i) eqv b.AT-POS($i), # still same - nqp::null - ), - nqp::iseq_i($i,$elems) # exhausted = success! + nqp::eqaddr(a.WHAT,b.WHAT), + nqp::if( # same type + nqp::iseq_i((my int $elems = a.elems),b.elems), + nqp::stmts( # same # elems + (my int $i = -1), + nqp::while( + nqp::islt_i(($i = nqp::add_i($i,1)),$elems) # not exhausted + && a.AT-POS($i) eqv b.AT-POS($i), # still same + nqp::null + ), + nqp::iseq_i($i,$elems) # exhausted = success! + ) ) ) ) From 59c4117ff4c19e2df72412b76d1318b2202795d1 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Mon, 18 Sep 2017 16:46:31 +0200 Subject: [PATCH 102/692] Enforce container types in atomic ops on JVM --- .../runtime/org/perl6/rakudo/RakudoContainerSpec.java | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/src/vm/jvm/runtime/org/perl6/rakudo/RakudoContainerSpec.java b/src/vm/jvm/runtime/org/perl6/rakudo/RakudoContainerSpec.java index 9affa521423..f88b25ed034 100644 --- a/src/vm/jvm/runtime/org/perl6/rakudo/RakudoContainerSpec.java +++ b/src/vm/jvm/runtime/org/perl6/rakudo/RakudoContainerSpec.java @@ -33,7 +33,7 @@ public String fetch_s(ThreadContext tc, SixModelObject cont) { /* Stores a value in a container. Used for assignment. */ private static final CallSiteDescriptor storeThrower = new CallSiteDescriptor( new byte[] { CallSiteDescriptor.ARG_STR, CallSiteDescriptor.ARG_OBJ, CallSiteDescriptor.ARG_OBJ }, null); - public void store(ThreadContext tc, SixModelObject cont, SixModelObject value) { + private void checkStore(ThreadContext tc, SixModelObject cont, SixModelObject value) { RakOps.GlobalExt gcx = RakOps.key.getGC(tc); long rw = 0; @@ -74,12 +74,14 @@ public void store(ThreadContext tc, SixModelObject cont, SixModelObject value) { storeThrower, new Object[] { name, value, of }); } } - + } + public void store(ThreadContext tc, SixModelObject cont, SixModelObject value) { + checkStore(tc, cont, value); + RakOps.GlobalExt gcx = RakOps.key.getGC(tc); SixModelObject whence = cont.get_attribute_boxed(tc, gcx.Scalar, "$!whence", HINT_whence); if (whence != null) Ops.invokeDirect(tc, whence, WHENCE, new Object[] { }); - cont.bind_attribute_boxed(tc, gcx.Scalar, "$!value", HINT_value, value); } public void store_i(ThreadContext tc, SixModelObject cont, long value) { @@ -144,6 +146,7 @@ private void ensureAtomicsReady(SixModelObject cont) { public SixModelObject cas(ThreadContext tc, SixModelObject cont, SixModelObject expected, SixModelObject value) { ensureAtomicsReady(cont); + checkStore(tc, cont, value); return unsafe.compareAndSwapObject(cont, scalarValueOffset, expected, value) ? expected : (SixModelObject)unsafe.getObjectVolatile(cont, scalarValueOffset); @@ -157,6 +160,7 @@ public SixModelObject atomic_load(ThreadContext tc, SixModelObject cont) { public void atomic_store(ThreadContext tc, SixModelObject cont, SixModelObject value) { ensureAtomicsReady(cont); + checkStore(tc, cont, value); unsafe.putObjectVolatile(cont, scalarValueOffset, cont); } } From 6ba16f84a75602a08d1f2fd37e0873f4bb4fe2dc Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Mon, 18 Sep 2017 16:49:07 +0200 Subject: [PATCH 103/692] cas.t and cas-loop.t now pass on JVM --- t/spectest.data | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/t/spectest.data b/t/spectest.data index 7b1d99a798e..c358a57c4f1 100644 --- a/t/spectest.data +++ b/t/spectest.data @@ -817,7 +817,7 @@ S17-channel/basic.t S17-channel/stress.t # stress slow S17-lowlevel/atomic.t # moar S17-lowlevel/atomic-ops.t # moar -S17-lowlevel/cas.t # moar +S17-lowlevel/cas.t S17-lowlevel/cas-int.t # moar S17-lowlevel/cas-loop.t # moar S17-lowlevel/cas-loop-int.t # moar From a845ac3d3f3707c16299c5b8975e06b39f322e2e Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Mon, 18 Sep 2017 11:02:00 -0400 Subject: [PATCH 104/692] Fix typo in error message; MasterDuke++ --- src/core/Mu.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/Mu.pm b/src/core/Mu.pm index 2daeba7940d..7f455411d75 100644 --- a/src/core/Mu.pm +++ b/src/core/Mu.pm @@ -905,7 +905,7 @@ multi sub infix:(Iterable:D \a, Iterable:D \b) { nqp::eqaddr(nqp::decont(a),nqp::decont(b)), nqp::if( # not same object a.is-lazy || b.is-lazy, - die("Cannoy eqv lazy Iterables"), + die("Cannot eqv lazy Iterables"), nqp::if( nqp::eqaddr(a.WHAT,b.WHAT), nqp::if( # same type From 48a84d6aff9c3e58b328475ee013b8544dc9193f Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Mon, 18 Sep 2017 17:47:05 +0200 Subject: [PATCH 105/692] Return False if only either side is lazy. --- src/core/Mu.pm | 37 ++++++++++++++++++++++--------------- 1 file changed, 22 insertions(+), 15 deletions(-) diff --git a/src/core/Mu.pm b/src/core/Mu.pm index 7f455411d75..40df1f4ef79 100644 --- a/src/core/Mu.pm +++ b/src/core/Mu.pm @@ -903,21 +903,28 @@ multi sub infix:(Iterable:D \a, Iterable:D \b) { nqp::p6bool( nqp::unless( nqp::eqaddr(nqp::decont(a),nqp::decont(b)), - nqp::if( # not same object - a.is-lazy || b.is-lazy, - die("Cannot eqv lazy Iterables"), - nqp::if( - nqp::eqaddr(a.WHAT,b.WHAT), - nqp::if( # same type - nqp::iseq_i((my int $elems = a.elems),b.elems), - nqp::stmts( # same # elems - (my int $i = -1), - nqp::while( - nqp::islt_i(($i = nqp::add_i($i,1)),$elems) # not exhausted - && a.AT-POS($i) eqv b.AT-POS($i), # still same - nqp::null - ), - nqp::iseq_i($i,$elems) # exhausted = success! + nqp::if( # not same object + a.is-lazy, + nqp::if( # a lazy + b.is-lazy, + die("Cannot eqv lazy Iterables") # a && b lazy + ), + nqp::if( # a NOT lazy + b.is-lazy, + 0, # b lazy + nqp::if( # a && b NOT lazy + nqp::eqaddr(a.WHAT,b.WHAT), + nqp::if( # same type + nqp::iseq_i((my int $elems = a.elems),b.elems), + nqp::stmts( # same # elems + (my int $i = -1), + nqp::while( + nqp::islt_i(($i = nqp::add_i($i,1)),$elems) # not exhausted + && a.AT-POS($i) eqv b.AT-POS($i), # still same + nqp::null + ), + nqp::iseq_i($i,$elems) # exhausted = success! + ) ) ) ) From 476741e77d769de685dff1a34307dc58b47826c7 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Mon, 18 Sep 2017 18:37:12 +0200 Subject: [PATCH 106/692] Map/Hash have their own optimized .sort So no need to first create a Seq that generates Pairs. This should at least make Hash.perl/gist a bit more memory friendly and a bit faster. --- src/core/Hash.pm | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/core/Hash.pm b/src/core/Hash.pm index e75ebe3135e..3489657d6c4 100644 --- a/src/core/Hash.pm +++ b/src/core/Hash.pm @@ -206,14 +206,14 @@ my class Hash { # declared in BOOTSTRAP multi method perl(Hash:D \SELF:) { SELF.perlseen('Hash', { '$' x nqp::iscont(SELF) # self is always deconted - ~ '{' ~ self.pairs.sort.map({.perl}).join(', ') ~ '}' + ~ '{' ~ self.sort.map({.perl}).join(', ') ~ '}' }) } multi method gist(Hash:D:) { self.gistseen('Hash', { '{' ~ - self.pairs.sort.map( -> $elem { + self.sort.map( -> $elem { given ++$ { when 101 { '...' } when 102 { last } @@ -525,7 +525,7 @@ my class Hash { # declared in BOOTSTRAP SELF.perlseen('Hash', { self.elems ?? "(my {TValue.perl} % = { - self.pairs.sort.map({.perl}).join(', ') + self.sort.map({.perl}).join(', ') })" !! "(my {TValue.perl} %)" }) @@ -744,10 +744,10 @@ my class Hash { # declared in BOOTSTRAP my $TKey-perl := TKey.perl; my $TValue-perl := TValue.perl; $TKey-perl eq 'Any' && $TValue-perl eq 'Mu' - ?? ':{' ~ SELF.pairs.sort.map({.perl}).join(', ') ~ '}' + ?? ':{' ~ SELF.sort.map({.perl}).join(', ') ~ '}' !! self.elems ?? "(my $TValue-perl %\{$TKey-perl\} = { - self.pairs.sort.map({.perl}).join(', ') + self.sort.map({.perl}).join(', ') })" !! "(my $TValue-perl %\{$TKey-perl\})" }) From 198b84971dffabd24fb5d98cbaa18f298ac1083a Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Mon, 18 Sep 2017 20:58:19 +0200 Subject: [PATCH 107/692] Bump nqp: new libuv and fix for thread ID race --- tools/build/NQP_REVISION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/build/NQP_REVISION b/tools/build/NQP_REVISION index eae7db5dd46..a658d012013 100644 --- a/tools/build/NQP_REVISION +++ b/tools/build/NQP_REVISION @@ -1 +1 @@ -2017.09 +2017.09-2-g862cde8 From 0beeef9baa4252d8171408efdd3463c8dccb5a88 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Mon, 18 Sep 2017 22:03:03 +0200 Subject: [PATCH 108/692] Iterable eqv Iterable should check types first All S03-operators/eqv.t tests pass again --- src/core/Mu.pm | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/src/core/Mu.pm b/src/core/Mu.pm index 40df1f4ef79..bbe207ba102 100644 --- a/src/core/Mu.pm +++ b/src/core/Mu.pm @@ -904,17 +904,17 @@ multi sub infix:(Iterable:D \a, Iterable:D \b) { nqp::unless( nqp::eqaddr(nqp::decont(a),nqp::decont(b)), nqp::if( # not same object - a.is-lazy, - nqp::if( # a lazy - b.is-lazy, - die("Cannot eqv lazy Iterables") # a && b lazy - ), - nqp::if( # a NOT lazy - b.is-lazy, - 0, # b lazy - nqp::if( # a && b NOT lazy - nqp::eqaddr(a.WHAT,b.WHAT), - nqp::if( # same type + nqp::eqaddr(a.WHAT,b.WHAT), + nqp::if( # same type + a.is-lazy, + nqp::if( # a lazy + b.is-lazy, + die("Cannot eqv lazy Iterables") # a && b lazy + ), + nqp::if( # a NOT lazy + b.is-lazy, + 0, # b lazy + nqp::if( # a && b NOT lazy nqp::iseq_i((my int $elems = a.elems),b.elems), nqp::stmts( # same # elems (my int $i = -1), From 47d6c66e9fc84bf827e2ef1ecf899b65a908d256 Mon Sep 17 00:00:00 2001 From: skids Date: Mon, 18 Sep 2017 16:19:52 -0400 Subject: [PATCH 109/692] Add Scalar indicators to Hash[].perl when needed (fix RT#132119) --- src/core/Hash.pm | 29 ++++++++++++++++++----------- 1 file changed, 18 insertions(+), 11 deletions(-) diff --git a/src/core/Hash.pm b/src/core/Hash.pm index 3489657d6c4..b6b03a86bd0 100644 --- a/src/core/Hash.pm +++ b/src/core/Hash.pm @@ -523,11 +523,13 @@ my class Hash { # declared in BOOTSTRAP } multi method perl(::?CLASS:D \SELF:) { SELF.perlseen('Hash', { - self.elems - ?? "(my {TValue.perl} % = { - self.sort.map({.perl}).join(', ') - })" - !! "(my {TValue.perl} %)" + '$' x nqp::iscont(SELF) # self is always deconted + ~ (self.elems + ?? "(my {TValue.perl} % = { + self.sort.map({.perl}).join(', ') + })" + !! "(my {TValue.perl} %)" + ) }) } } @@ -744,12 +746,17 @@ my class Hash { # declared in BOOTSTRAP my $TKey-perl := TKey.perl; my $TValue-perl := TValue.perl; $TKey-perl eq 'Any' && $TValue-perl eq 'Mu' - ?? ':{' ~ SELF.sort.map({.perl}).join(', ') ~ '}' - !! self.elems - ?? "(my $TValue-perl %\{$TKey-perl\} = { - self.sort.map({.perl}).join(', ') - })" - !! "(my $TValue-perl %\{$TKey-perl\})" + ?? ( '$(' x nqp::iscont(SELF) + ~ ':{' ~ SELF.sort.map({.perl}).join(', ') ~ '}' + ~ ')' x nqp::iscont(SELF) + ) + !! '$' x nqp::iscont(SELF) + ~ (self.elems + ?? "(my $TValue-perl %\{$TKey-perl\} = { + self.sort.map({.perl}).join(', ') + })" + !! "(my $TValue-perl %\{$TKey-perl\})" + ) }) } From 0385b2aa4554eca1421081968642a43f883889cd Mon Sep 17 00:00:00 2001 From: Cuong Manh Le Date: Tue, 19 Sep 2017 11:11:53 +0700 Subject: [PATCH 110/692] Make :delete works with lazy Arrays Fixes RT#131790 --- src/core/Array.pm | 46 ++++++++++++++++++++++++++-------------------- 1 file changed, 26 insertions(+), 20 deletions(-) diff --git a/src/core/Array.pm b/src/core/Array.pm index 1f533a625e9..a8ae908b320 100644 --- a/src/core/Array.pm +++ b/src/core/Array.pm @@ -591,30 +591,36 @@ my class Array { # declared in BOOTSTRAP :what($*INDEX // 'Index'),:got($pos),:range<0..^Inf>)), nqp::if( (my $reified := nqp::getattr(self,List,'$!reified')).DEFINITE, - nqp::if( - nqp::isle_i( # something to delete - $pos,my int $end = nqp::sub_i(nqp::elems($reified),1)), - nqp::stmts( - (my $value := nqp::ifnull( # save the value - nqp::atpos($reified,$pos), - self.default - )), - nqp::bindpos($reified,$pos,nqp::null), # remove this one - nqp::if( - nqp::iseq_i($pos,$end), - nqp::stmts( # shorten from end - (my int $i = $pos), - nqp::while( - (nqp::isge_i(($i = nqp::sub_i($i,1)),0) - && nqp::not_i(nqp::existspos($reified,$i))), - nqp::null + nqp::stmts( + nqp::if( + (my $todo := nqp::getattr(self,List,'$!todo')).DEFINITE, + $todo.reify-at-least(nqp::add_i($pos,1)), + ), + nqp::if( + nqp::isle_i( # something to delete + $pos,my int $end = nqp::sub_i(nqp::elems($reified),1)), + nqp::stmts( + (my $value := nqp::ifnull( # save the value + nqp::atpos($reified,$pos), + self.default + )), + nqp::bindpos($reified,$pos,nqp::null), # remove this one + nqp::if( + nqp::iseq_i($pos,$end) && nqp::not_i(nqp::defined($todo)), + nqp::stmts( # shorten from end + (my int $i = $pos), + nqp::while( + (nqp::isge_i(($i = nqp::sub_i($i,1)),0) + && nqp::not_i(nqp::existspos($reified,$i))), + nqp::null + ), + nqp::setelems($reified,nqp::add_i($i,1)) ), - nqp::setelems($reified,nqp::add_i($i,1)) ), + $value # value, if any ), - $value # value, if any + self.default # outlander ), - self.default # outlander ), self.default # no elements ) From 93a66d75b9232eb8c444a51ba5e4d866ba05e3e4 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Tue, 19 Sep 2017 12:59:41 +0200 Subject: [PATCH 111/692] An on-demand Supply isn't magically serial/sanitry We had a case right here in CORE.setting that violated it, so user's own code sure as heck might do so also. --- src/core/Supply.pm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/core/Supply.pm b/src/core/Supply.pm index dc2f8f9ffac..7de7158f0e0 100644 --- a/src/core/Supply.pm +++ b/src/core/Supply.pm @@ -118,9 +118,9 @@ my class Supply does Awaitable { } method live(--> False) { } - method sane(--> True) { } - method serial(--> True) { } - }.new(:&producer, :&closing, :$scheduler)) + method sane(--> False) { } + method serial(--> False) { } + }.new(:&producer, :&closing, :$scheduler)).sanitize } method from-list(Supply:U: +@values, :$scheduler = CurrentThreadScheduler) { From 9e179355cf602ba54a5236cbdeaa83b9503e7944 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Tue, 19 Sep 2017 13:00:56 +0200 Subject: [PATCH 112/692] Filter out duplicate done/quit messages --- src/core/Supply.pm | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/src/core/Supply.pm b/src/core/Supply.pm index 7de7158f0e0..16de62123da 100644 --- a/src/core/Supply.pm +++ b/src/core/Supply.pm @@ -218,14 +218,18 @@ my class Supply does Awaitable { emit(value) unless $!finished; }, done => -> { - $!finished = 1; - done(); - self!cleanup($cleaned-up, $source-tap); + unless $!finished { + $!finished = 1; + done(); + self!cleanup($cleaned-up, $source-tap); + } }, quit => -> $ex { - $!finished = 1; - quit($ex); - self!cleanup($cleaned-up, $source-tap); + unless $!finished { + $!finished = 1; + quit($ex); + self!cleanup($cleaned-up, $source-tap); + } }); Tap.new({ self!cleanup($cleaned-up, $source-tap) }) } From c46be84ca3384e127a1216510f8b85420467c567 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Tue, 19 Sep 2017 14:28:03 +0200 Subject: [PATCH 113/692] Move classes outside of `REACT` sub That pattern caused some pain with `SUPPLY` before now. --- src/core.d/await.pm | 57 +++++++++++++++++++++++---------------------- 1 file changed, 29 insertions(+), 28 deletions(-) diff --git a/src/core.d/await.pm b/src/core.d/await.pm index 9a5bb26214f..e360380482f 100644 --- a/src/core.d/await.pm +++ b/src/core.d/await.pm @@ -53,40 +53,41 @@ my role X::React::Died { } } -sub REACT(&block --> Nil) { - my class ReactAwaitable does Awaitable { - has $!handle; - - method new($handle) { - self.CREATE!set-handle($handle) - } - method !set-handle($handle) { - $!handle = $handle; - self - } +my class Rakudo::Internals::ReactAwaitable does Awaitable { + has $!handle; - method get-await-handle() { $!handle } + method new($handle) { + self.CREATE!set-handle($handle) + } + method !set-handle($handle) { + $!handle = $handle; + self } - my class ReactAwaitHandle does Awaitable::Handle { - has &!react-block; - method not-ready(&react-block) { - self.CREATE!set-react-block(&react-block) - } - method !set-react-block(&react-block) { - &!react-block = &react-block; - self - } + method get-await-handle() { $!handle } +} +my class Rakudo::Internals::ReactAwaitHandle does Awaitable::Handle { + has &!react-block; - method subscribe-awaiter(&subscriber) { - SUPPLY(&!react-block).tap: - { warn "Useless use of emit in react" }, - done => { subscriber(True, Nil) }, - quit => { subscriber(False, $_) }; - } + method not-ready(&react-block) { + self.CREATE!set-react-block(&react-block) } + method !set-react-block(&react-block) { + &!react-block = &react-block; + self + } + + method subscribe-awaiter(&subscriber) { + SUPPLY(&!react-block).tap: + { warn "Useless use of emit in react" }, + done => { subscriber(True, Nil) }, + quit => { subscriber(False, $_) }; + } +} +sub REACT(&block --> Nil) { CATCH { ($_ but X::React::Died(Backtrace.new(5))).rethrow } - $*AWAITER.await(ReactAwaitable.new(ReactAwaitHandle.not-ready(&block))); + $*AWAITER.await(Rakudo::Internals::ReactAwaitable.new( + Rakudo::Internals::ReactAwaitHandle.not-ready(&block))); } From 633a15b82bf65e0763f3eab2335bcffaa5c8e3e1 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Tue, 19 Sep 2017 14:28:43 +0200 Subject: [PATCH 114/692] Sanitize per tapping, not per Supply I've put this off before now as it causes a couple of regressions in S17-supply/basic.t, but it's the right thing to do, and not doing it causes other issues. Regressions will be investigated and dealt with before this branch is merged. --- src/core/Supply.pm | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/src/core/Supply.pm b/src/core/Supply.pm index 16de62123da..bb078c94480 100644 --- a/src/core/Supply.pm +++ b/src/core/Supply.pm @@ -207,26 +207,25 @@ my class Supply does Awaitable { method sanitize() { $!tappable.sane ?? self !! Supply.new(class :: does SimpleOpTappable { - has int $!finished; - submethod BUILD(:$!source! --> Nil) { } method tap(&emit, &done, &quit) { my int $cleaned-up = 0; + my int $finished = 0; my $source-tap = $!source.tap( -> \value{ - emit(value) unless $!finished; + emit(value) unless $finished; }, done => -> { - unless $!finished { - $!finished = 1; + unless $finished { + $finished = 1; done(); self!cleanup($cleaned-up, $source-tap); } }, quit => -> $ex { - unless $!finished { - $!finished = 1; + unless $finished { + $finished = 1; quit($ex); self!cleanup($cleaned-up, $source-tap); } From ef4d16fe19fe8b0c5970152e7175d95a5c10a62e Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Tue, 19 Sep 2017 14:36:31 +0200 Subject: [PATCH 115/692] Serialize lock should be per tap, not per Supply This may allow for finer-grained concurrency in the case of supplies being used for publish/subscribe. --- src/core/Supply.pm | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/src/core/Supply.pm b/src/core/Supply.pm index bb078c94480..935190f90f1 100644 --- a/src/core/Supply.pm +++ b/src/core/Supply.pm @@ -178,24 +178,23 @@ my class Supply does Awaitable { method serialize(Supply:D:) { $!tappable.serial ?? self !! Supply.new(class :: does SimpleOpTappable { - has $!lock = Lock::Async.new; - submethod BUILD(:$!source! --> Nil) { } method tap(&emit, &done, &quit) { + my $lock = Lock::Async.new; my int $cleaned-up = 0; my $source-tap = $!source.tap( -> \value{ - $!lock.protect: { emit(value); } + $lock.protect: { emit(value); } }, done => -> { - $!lock.protect: { + $lock.protect: { done(); self!cleanup($cleaned-up, $source-tap); } }, quit => -> $ex { - $!lock.protect: { + $lock.protect: { quit($ex); self!cleanup($cleaned-up, $source-tap); } From 5a9bb4a58e4fb304f4376abb855d5a208dc25910 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Tue, 19 Sep 2017 14:38:00 +0200 Subject: [PATCH 116/692] Remove unused attribute --- src/core/Supply.pm | 1 - 1 file changed, 1 deletion(-) diff --git a/src/core/Supply.pm b/src/core/Supply.pm index 935190f90f1..264a4ee5be1 100644 --- a/src/core/Supply.pm +++ b/src/core/Supply.pm @@ -236,7 +236,6 @@ my class Supply does Awaitable { method on-close(Supply:D: &on-close) { return Supply.new(class :: does SimpleOpTappable { - has int $!finished; has &!on-close; submethod BUILD(:$!source!, :&!on-close! --> Nil) { } From bb45791c5d94cf9a1389ba0489d315764c3e45e9 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Tue, 19 Sep 2017 12:49:50 +0000 Subject: [PATCH 117/692] Make `eqv` throw typed exceptions on lazy comparisons Closes RT#132117: https://rt.perl.org/Ticket/Display.html?id=132117 P.S.: the exception's wording says "lazy lists". It's lowercased "list", which I suppose is enough wiggle room to be OK when throwing for lazy Seqs --- src/core/Mu.pm | 3 ++- src/core/Seq.pm | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/src/core/Mu.pm b/src/core/Mu.pm index bbe207ba102..888bbc83346 100644 --- a/src/core/Mu.pm +++ b/src/core/Mu.pm @@ -1,3 +1,4 @@ +my class X::Cannot::Lazy { ... } my class X::Constructor::Positional { ... } my class X::Method::NotFound { ... } my class X::Method::InvalidQualifier { ... } @@ -909,7 +910,7 @@ multi sub infix:(Iterable:D \a, Iterable:D \b) { a.is-lazy, nqp::if( # a lazy b.is-lazy, - die("Cannot eqv lazy Iterables") # a && b lazy + die(X::Cannot::Lazy.new: :action) # a && b lazy ), nqp::if( # a NOT lazy b.is-lazy, diff --git a/src/core/Seq.pm b/src/core/Seq.pm index d7c27fb87aa..a7a3c891d80 100644 --- a/src/core/Seq.pm +++ b/src/core/Seq.pm @@ -390,7 +390,7 @@ multi sub infix:(Seq:D \a, Seq:D \b) { ), nqp::if( ia.is-lazy, - (die "Cannot eqv lazy Sequences"), + die(X::Cannot::Lazy.new: :action), nqp::stmts( nqp::until( nqp::stmts( From f53d396374bb877ef46026fc9a899fc65fba1f6f Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Tue, 19 Sep 2017 16:28:01 +0200 Subject: [PATCH 118/692] Closure clone per supply/react, not per whenever Saves some work for supply/react blocks that have multiple whenever blocks inside of them. Also sprinkle some comments explaining what's going on. --- src/core/Supply.pm | 90 ++++++++++++++++++++++++++-------------------- 1 file changed, 51 insertions(+), 39 deletions(-) diff --git a/src/core/Supply.pm b/src/core/Supply.pm index 264a4ee5be1..af73f30c964 100644 --- a/src/core/Supply.pm +++ b/src/core/Supply.pm @@ -1731,54 +1731,66 @@ augment class Rakudo::Internals { submethod BUILD(:&!block --> Nil) { } method tap(&emit, &done, &quit) { + # Create state for this tapping. my $state = Rakudo::Internals::SupplyBlockState.new(:&emit, :&done, :&quit); - self!run-supply-code(&!block, $state); + + # Placed here so it can close over $state, but we only need to + # closure-clone it once per Supply block, not once per whenever. + sub add-whenever($supply, &whenever-block) { + $state.increment-active(); + my $tap = $supply.tap( + -> \value { + self!run-supply-code({ whenever-block(value) }, $state, &add-whenever) + }, + done => { + $state.delete-active-tap($tap) if $tap.DEFINITE; + my @phasers := &whenever-block.phasers('LAST'); + if @phasers { + self!run-supply-code({ .() for @phasers }, $state, &add-whenever) + } + $tap.?close; + self!deactivate-one($state); + }, + quit => -> \ex { + $state.delete-active-tap($tap) if $tap.DEFINITE; + self!run-supply-code({ + my $handled; + my $phaser := &whenever-block.phasers('QUIT')[0]; + if $phaser.DEFINITE { + $handled = $phaser(ex) === Nil; + } + if $handled { + $tap.?close; + self!deactivate-one($state); + } + elsif $state.get-and-zero-active() { + $state.quit().(ex) if $state.quit; + self!teardown($state); + } + }, $state, &add-whenever); + }); + $state.add-active-tap($tap); + $tap + } + + # Stash the close phasers away. if nqp::istype(&!block,Block) { $state.close-phasers.push(.clone) for &!block.phasers('CLOSE') } + + # Run the Supply block, then decrease active count afterwards (it + # counts as an active runner). + self!run-supply-code(&!block, $state, &add-whenever); self!deactivate-one($state); + + # Return a tap; when closed, tear down the state and all of our + # subscriptions. Tap.new(-> { self!teardown($state) }) } - method !run-supply-code(&code, $state) { + method !run-supply-code(&code, $state, &add-whenever) { $state.run-operation({ - my &*ADD-WHENEVER = sub ($supply, &whenever-block) { - $state.increment-active(); - my $tap = $supply.tap( - -> \value { - self!run-supply-code({ whenever-block(value) }, $state) - }, - done => { - $state.delete-active-tap($tap) if $tap.DEFINITE; - my @phasers := &whenever-block.phasers('LAST'); - if @phasers { - self!run-supply-code({ .() for @phasers }, $state) - } - $tap.?close; - self!deactivate-one($state); - }, - quit => -> \ex { - $state.delete-active-tap($tap) if $tap.DEFINITE; - self!run-supply-code({ - my $handled; - my $phaser := &whenever-block.phasers('QUIT')[0]; - if $phaser.DEFINITE { - $handled = $phaser(ex) === Nil; - } - if $handled { - $tap.?close; - self!deactivate-one($state); - } - elsif $state.get-and-zero-active() { - $state.quit().(ex) if $state.quit; - self!teardown($state); - } - }, $state); - }); - $state.add-active-tap($tap); - $tap - } - + my &*ADD-WHENEVER = &add-whenever; my $emitter = { my \ex := nqp::exception(); $state.emit().(nqp::getpayload(ex)) if $state.emit; From 29863a0bdc41bffc3d348446b21bfb37341d6693 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Tue, 19 Sep 2017 17:11:33 +0200 Subject: [PATCH 119/692] Fix non-blocking react { await blah() } The `react` (and also `await $some-supply`) constructs will tap the `Supply` upon the call to `subscribe-awaiter`. This causes some amount of synchronous execution to take place, and that code may then itself `await`. This broke because the continuation tag was removed by the react/await prior to this. Protect the continuation tag, so it survives. --- src/core/ThreadPoolScheduler.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index dd9407ad216..05d457e1a89 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -48,7 +48,7 @@ my class ThreadPoolScheduler does Scheduler { else { my $success; my $result; - nqp::continuationcontrol(0, THREAD_POOL_PROMPT, -> Mu \c { + nqp::continuationcontrol(1, THREAD_POOL_PROMPT, -> Mu \c { $handle.subscribe-awaiter(-> \success, \result { $success := success; $result := result; @@ -150,7 +150,7 @@ my class ThreadPoolScheduler does Scheduler { $l.unlock(); } } - nqp::continuationcontrol(0, THREAD_POOL_PROMPT, -> Mu \c { + nqp::continuationcontrol(1, THREAD_POOL_PROMPT, -> Mu \c { $continuation := c; $l.unlock; }); From dff7d9b28a3fa2bcd1611ad8b66bc1bea5a6e536 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Tue, 19 Sep 2017 17:22:22 +0000 Subject: [PATCH 120/692] Bump NQP --- tools/build/NQP_REVISION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/build/NQP_REVISION b/tools/build/NQP_REVISION index a658d012013..41efc258755 100644 --- a/tools/build/NQP_REVISION +++ b/tools/build/NQP_REVISION @@ -1 +1 @@ -2017.09-2-g862cde8 +2017.09-3-g4bc6050 From 0d2ca0d7e1aeb882c1e1d75fe63eb211d40cf760 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Tue, 19 Sep 2017 17:22:34 +0000 Subject: [PATCH 121/692] =?UTF-8?q?Test=20p6bindattrinvres=20with=20getatt?= =?UTF-8?q?r=20of=20bigint=E2=80=A6?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit …does not SEGV. RT#132128: https://rt.perl.org/Ticket/Display.html?id=132128 Rakudo fix: https://github.com/rakudo/rakudo/commit/dff7d9b28a NQP fix: https://github.com/perl6/nqp/commit/4bc6050d6e MoarVM fix: https://github.com/MoarVM/MoarVM/commit/3b4b032984 --- t/02-rakudo/10-nqp-ops.t | 9 +++++++++ 1 file changed, 9 insertions(+) create mode 100644 t/02-rakudo/10-nqp-ops.t diff --git a/t/02-rakudo/10-nqp-ops.t b/t/02-rakudo/10-nqp-ops.t new file mode 100644 index 00000000000..8e3b8f4e5a6 --- /dev/null +++ b/t/02-rakudo/10-nqp-ops.t @@ -0,0 +1,9 @@ +use Test; +use nqp; +# Tests for nqp ops that don't fit into nqp's test suit + +plan 1; + +lives-ok { + nqp::p6bindattrinvres(($ := 42), Int, q|$!value|, nqp::getattr(42, Int, q|$!value|)) +}, 'p6bindattrinvres with getattr of bigint does not crash'; From de56c056493059e161f1f620a1b5d7337c2b033e Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Tue, 19 Sep 2017 17:26:12 +0000 Subject: [PATCH 122/692] Add reference to ticket to the test --- t/02-rakudo/10-nqp-ops.t | 1 + 1 file changed, 1 insertion(+) diff --git a/t/02-rakudo/10-nqp-ops.t b/t/02-rakudo/10-nqp-ops.t index 8e3b8f4e5a6..fb8864b85e2 100644 --- a/t/02-rakudo/10-nqp-ops.t +++ b/t/02-rakudo/10-nqp-ops.t @@ -4,6 +4,7 @@ use nqp; plan 1; +# RT#132126 lives-ok { nqp::p6bindattrinvres(($ := 42), Int, q|$!value|, nqp::getattr(42, Int, q|$!value|)) }, 'p6bindattrinvres with getattr of bigint does not crash'; From 0834036dd436ac7372c8c0fe2f49511a4f5186dd Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Tue, 19 Sep 2017 18:07:06 +0000 Subject: [PATCH 123/692] Fix issues with Int.new - Fix wrong error (default constructor blah blah) with wrong args - Fix subclassed Ints returning an Int instead of subclass Fixes RT#132128: https://rt.perl.org/Ticket/Display.html?id=132128 --- src/core/Int.pm | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/src/core/Int.pm b/src/core/Int.pm index 21ecd9030b4..e08a093146f 100644 --- a/src/core/Int.pm +++ b/src/core/Int.pm @@ -22,11 +22,15 @@ my class Int does Real { # declared in BOOTSTRAP ObjAt ) } - multi method new($value) { - # clone to ensure we return a new object for any cached - # numeric constants - $value.Int.clone; + + proto method new(|) {*} + multi method new( \value) { self.new: value.Int } + multi method new(int \value) { nqp::box_i(value,self.WHAT) } + multi method new(Int:D \value = 0) { + nqp::p6bindattrinvres(self.bless, Int,'$!value', + nqp::getattr(nqp::decont(value),Int,'$!value')) } + multi method perl(Int:D:) { self.Str; } From cee1be22cff6153506e31df2916f8a0be27b5fc8 Mon Sep 17 00:00:00 2001 From: David Warring Date: Wed, 20 Sep 2017 07:11:32 +1200 Subject: [PATCH 124/692] fix subset isa method on a subset. perl6 -e'subset S of Int; subset S2 of S; say S2.isa(S)' now returns True. fully resolves RT #132073 --- src/Perl6/Metamodel/SubsetHOW.nqp | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Perl6/Metamodel/SubsetHOW.nqp b/src/Perl6/Metamodel/SubsetHOW.nqp index dc50e80dd59..705aa91892a 100644 --- a/src/Perl6/Metamodel/SubsetHOW.nqp +++ b/src/Perl6/Metamodel/SubsetHOW.nqp @@ -58,7 +58,8 @@ class Perl6::Metamodel::SubsetHOW } method isa($obj, $type) { - $!refinee.isa($type); + $!refinee.isa($type) + || nqp::p6bool(nqp::istrue($type.HOW =:= self)) } method nominalize($obj) { From 06fe4c4d2910e8beb4edf30cc5e0cec2673c7165 Mon Sep 17 00:00:00 2001 From: Steve Mynott Date: Wed, 20 Sep 2017 13:11:11 +0100 Subject: [PATCH 125/692] dogbert17++ fix harness6 by only allowing TEST_JOBS=1 --- t/harness6 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/t/harness6 b/t/harness6 index 8ee7f854184..e0a143c9aba 100644 --- a/t/harness6 +++ b/t/harness6 @@ -26,7 +26,7 @@ multi sub MAIN( Str :$tests-from-file = Str, Bool :$fudge = False, Int :$verbosity = (%*ENV // 0).Int, - Int :$jobs = (%*ENV // 6).Int, + Int :$jobs = (%*ENV // 1).Int, Bool :$quick = False, Bool :$stress = False, Bool :$randomize = False, @@ -35,6 +35,7 @@ multi sub MAIN( Str :$perl5path = 'perl', *@files, ) { + die "TEST_JOBS > 1 is currently broken" if %*ENV and %*ENV > 1; my @slow; with ($tests-from-file) { my $inline-perl5-is-installed = run( From f9400d9a2e0e1531a2e0db91c0ff9eb835dbfe85 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Wed, 20 Sep 2017 17:44:21 +0200 Subject: [PATCH 126/692] Supply.zip should eager-shift its values Otherwise we're at the mercy of the thing that runs out downstream emit in order to have correct behavior. Shaken out by refactors to Supply concurrency control. --- src/core/Supply.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/Supply.pm b/src/core/Supply.pm index af73f30c964..fc9ccb4c4d4 100644 --- a/src/core/Supply.pm +++ b/src/core/Supply.pm @@ -1170,7 +1170,7 @@ my class Supply does Awaitable { else { whenever $supply -> \val { @values[$index].push(val); - emit( $(@values.map(*.shift).list) ) if all(@values); + emit( $(@values.map(*.shift).list.eager) ) if all(@values); } } } From 26a9c313297a21c11ac30f02349497822686f507 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Wed, 20 Sep 2017 18:34:48 +0200 Subject: [PATCH 127/692] Change supply concurrency control mechanism Previously, a supply/react block would immediately accept all of the messages sent to it, put them into a queue, and then whatever thread happened to be processing the current message would help out with processing new arrivals afterwards. This could cause messages to pile up without any back-pressure up the chain to slow things down. This mechanism is also a key part of the situation discussed in RT #130716. This patch switches over to a different approach, using Lock::Async. This means that a `supply` block, from the outside, now behaves far more like everything else in a Supply chain, in that the time it costs to process the message is paid for by the sender. In the event of contention, then the current awaiter is used. This means that for code in the thread pool, an emitter that reaches a supply block that is busy processing some other message will have a continuation taken, which will be scheduled once the Supply block is available again. This change alone would lead to immediate deadlock, however, for any case where the Supply that is tapped does a synchronous emit or an `await`, or itself has a `whenever` for anything that does that. As a minimal example, `react { whenever supply { emit 1 } { .say } }` would deadlock, because the setup work running the `react` block holds the lock, and the `emit` in the `supply` block, which is run upon tap, wants it. It would thus block on the `await`, blocking the completion of the `react` block body with it, meaning nothing would happen. This was resolved by the previous queue-then-help mechanism. Therefore, a special Awaiter is installed when a `whenever` block is added. The `.tap` call is now done in a block at the root of a continuation reset. If an `await` happens, a continuation will be taken. After the processing of either the `supply` or `react` block mainline has been completed, the continuations will be invoked, with any further `await`s resulting from that also being invoked, until an empty list of continuations is reached. This in turn means that `react { whenever supply { loop { emit 1 } } { .say } }` will now spit out load of 1s, instead of hanging. It's not all good news. There is a regression in S17-supply/throttle.t and the sometimes-failing S17-supply/supplier-preserving.t is now a reliable failure. The second of these is due to the way tap objects are provided to the tapper - potentially too late. This also blocks trying to address the issue of an emitter running synchronously never terminating (we should at least fire an `on-close` or `CLOSE` block, and we may be able to make the next `emit` just tear the thing down too). The final bit of bad news is that benchmarks on Cro show quite a big slowdown from this change. It's not entirely clear why, since it's dealing with real async data sources (sockets), and so should never need to take a continuation during the setup phase. It's possible something else needs tuning for this new back-pressure mechanism, or it's possible there's some performance surprise somewhere in the changes that needs identifying. --- src/core/Supply.pm | 158 ++++++++++++++++++++++++++++----------------- 1 file changed, 99 insertions(+), 59 deletions(-) diff --git a/src/core/Supply.pm b/src/core/Supply.pm index fc9ccb4c4d4..dde3d3583cb 100644 --- a/src/core/Supply.pm +++ b/src/core/Supply.pm @@ -1653,15 +1653,61 @@ my class Supplier::Preserving is Supplier { } augment class Rakudo::Internals { + my constant ADD_WHENEVER_PROMPT = Mu.new; + + class CachedAwaitHandle does Awaitable { + has $.get-await-handle; + } + + class SupplyBlockAddWheneverAwaiter does Awaiter { + has $!continuations; + + method await(Awaitable:D $a) { + my $handle := $a.get-await-handle; + if $handle.already { + $handle.success + ?? $handle.result + !! $handle.cause.rethrow + } + else { + my $reawaitable = CachedAwaitHandle.new(get-await-handle => $handle); + $!continuations := nqp::list() unless nqp::isconcrete($!continuations); + nqp::continuationcontrol(0, ADD_WHENEVER_PROMPT, -> Mu \c { + nqp::push($!continuations, -> $delegate-awaiter { + nqp::continuationinvoke(c, { + $delegate-awaiter.await($reawaitable); + }); + }); + }); + } + } + + method await-all(Iterable:D \i) { + die "NYI"; + } + + method take-all() { + if nqp::isconcrete($!continuations) { + my \result = $!continuations; + $!continuations := Mu; + result + } + else { + Empty + } + } + } + class SupplyBlockState { has &.emit; has &.done; has &.quit; has @.close-phasers; - has $!active = 1; + has $.active = 1; has $!lock = Lock.new; has %!active-taps; - has @!queued-operations; + has $.run-async-lock = Lock::Async.new; + has $.awaiter = SupplyBlockAddWheneverAwaiter.CREATE; method increment-active() { $!lock.protect: { ++$!active } @@ -1699,30 +1745,6 @@ augment class Rakudo::Internals { } @active } - - method run-operation(&op --> Nil) { - if $!active { - my $run-now; - $!lock.protect({ - $run-now = not @!queued-operations; - @!queued-operations.push(&op); - }); - self!run-loop(&op) if $run-now; - } - } - - method !run-loop(&initial --> Nil) { - my ¤t = &initial; - while ¤t { - current(); - $!lock.protect({ - @!queued-operations.shift; - ¤t = $!active && @!queued-operations - ?? @!queued-operations[0] - !! Nil; - }); - } - } } class SupplyBlockTappable does Tappable { @@ -1737,39 +1759,43 @@ augment class Rakudo::Internals { # Placed here so it can close over $state, but we only need to # closure-clone it once per Supply block, not once per whenever. sub add-whenever($supply, &whenever-block) { + my $*AWAITER := $state.awaiter; $state.increment-active(); - my $tap = $supply.tap( - -> \value { - self!run-supply-code({ whenever-block(value) }, $state, &add-whenever) - }, - done => { - $state.delete-active-tap($tap) if $tap.DEFINITE; - my @phasers := &whenever-block.phasers('LAST'); - if @phasers { - self!run-supply-code({ .() for @phasers }, $state, &add-whenever) - } - $tap.?close; - self!deactivate-one($state); - }, - quit => -> \ex { - $state.delete-active-tap($tap) if $tap.DEFINITE; - self!run-supply-code({ - my $handled; - my $phaser := &whenever-block.phasers('QUIT')[0]; - if $phaser.DEFINITE { - $handled = $phaser(ex) === Nil; + my $tap; + nqp::continuationreset(ADD_WHENEVER_PROMPT, { + $tap = $supply.tap( + -> \value { + self!run-supply-code({ whenever-block(value) }, $state, &add-whenever) + }, + done => { + $state.delete-active-tap($tap) if $tap.DEFINITE; + my @phasers := &whenever-block.phasers('LAST'); + if @phasers { + self!run-supply-code({ .() for @phasers }, $state, &add-whenever) } + $tap.?close; + self!deactivate-one($state); + }, + quit => -> \ex { + $state.delete-active-tap($tap) if $tap.DEFINITE; + my $handled; + self!run-supply-code({ + my $phaser := &whenever-block.phasers('QUIT')[0]; + if $phaser.DEFINITE { + $handled = $phaser(ex) === Nil; + } + if !$handled && $state.get-and-zero-active() { + $state.quit().(ex) if $state.quit; + self!teardown($state); + } + }, $state, &add-whenever); if $handled { $tap.?close; self!deactivate-one($state); } - elsif $state.get-and-zero-active() { - $state.quit().(ex) if $state.quit; - self!teardown($state); - } - }, $state, &add-whenever); - }); - $state.add-active-tap($tap); + }); + $state.add-active-tap($tap); + }); $tap } @@ -1789,7 +1815,9 @@ augment class Rakudo::Internals { } method !run-supply-code(&code, $state, &add-whenever) { - $state.run-operation({ + my @run-after; + $state.run-async-lock.protect: { + return unless $state.active > 0; my &*ADD-WHENEVER = &add-whenever; my $emitter = { my \ex := nqp::exception(); @@ -1797,31 +1825,43 @@ augment class Rakudo::Internals { nqp::resume(ex) } my $done = { - $state.done().() if $state.done; $state.get-and-zero-active(); self!teardown($state); + $state.done().() if $state.done; } my $catch = { my \ex = EXCEPTION(nqp::exception()); - $state.quit().(ex) if $state.quit; $state.get-and-zero-active(); self!teardown($state); + $state.quit().(ex) if $state.quit; } nqp::handle(code(), 'EMIT', $emitter(), 'DONE', $done(), 'CATCH', $catch(), 'NEXT', 0); - }); + @run-after = $state.awaiter.take-all; + } + if @run-after { + my $nested-awaiter := SupplyBlockAddWheneverAwaiter.CREATE; + my $delegate-awaiter := $*AWAITER; + while @run-after.elems { + my $*AWAITER := $nested-awaiter; + nqp::continuationreset(ADD_WHENEVER_PROMPT, { + @run-after.shift()($delegate-awaiter); + }); + @run-after.append($nested-awaiter.take-all); + } + } } method !deactivate-one($state) { - $state.run-operation({ + $state.run-async-lock.protect: { if $state.decrement-active() == 0 { $state.done().() if $state.done; self!teardown($state); } - }); + }; } method !teardown($state) { From 963a0f0657abaa0431d465e601c75b50462b4cd2 Mon Sep 17 00:00:00 2001 From: Samantha McVey Date: Wed, 20 Sep 2017 23:38:31 -0700 Subject: [PATCH 128/692] Bump Moar/NQP: Fix 2 big utf8-c8 bugs & fix MacOS build utf8-c8: Fixes a bug where encoding values above 0x10FFFF or Surrogate codepoints would throw and fail. Fixes a bug with utf8-c8 where concatenation, replace, or ops that could cause renormalization would turn a utf8-c8 string into a normal utf8 string. Fixes MacOS build for some OS's caused by the previous fix for FreeBSD builds. MoarVM changes: 2017.09.1-16-g3b4b032..2017.09.1-21-g523725a3 523725a3 Only include libuv posix-hrtime on *BSD not Darwin f112fbcf Fix utfc-c8 enc. for values > 0x10FFFF and surrogates 2f71945d Fix concat bug with utf8c8 strings, flattening utf8c8 synths 5bdb7784 Fix FreeBSD build NQP changes: 2017.09-3-g4bc6050..2017.09-7-ga5f92f2fe ba165c8d9 Allow per-atom backtracking modifiers to override :ratchet 263257a9c Make || alternations respect :ratchet mode --- tools/build/NQP_REVISION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/build/NQP_REVISION b/tools/build/NQP_REVISION index 41efc258755..b327b804433 100644 --- a/tools/build/NQP_REVISION +++ b/tools/build/NQP_REVISION @@ -1 +1 @@ -2017.09-3-g4bc6050 +2017.09-7-ga5f92f2fe \ No newline at end of file From 99f90e652863357d7e5be9c0fdc58fff6e783496 Mon Sep 17 00:00:00 2001 From: Steve Mynott Date: Thu, 21 Sep 2017 10:27:21 +0100 Subject: [PATCH 129/692] japhb++ catch case where --jobs used --- t/harness6 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/t/harness6 b/t/harness6 index e0a143c9aba..85a0492b7a3 100644 --- a/t/harness6 +++ b/t/harness6 @@ -35,7 +35,7 @@ multi sub MAIN( Str :$perl5path = 'perl', *@files, ) { - die "TEST_JOBS > 1 is currently broken" if %*ENV and %*ENV > 1; + die "TEST_JOBS > 1 is currently broken" if $jobs and $jobs > 1; my @slow; with ($tests-from-file) { my $inline-perl5-is-installed = run( From 9d903408e3727cb2dd26e78f92a8e0a12345907a Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Thu, 21 Sep 2017 13:05:35 +0200 Subject: [PATCH 130/692] Push Tap objects down to subscribers The `.tap(...)` call now takes an optional `:&tap` named argument that will be called, synchronously and ahead of any `emit`/`done`/`quit`, with the Tap object. This means that there is now a reliable way to get the Tap object, no matter the behavior of the source Supply. There were two notable cases where we had trouble: * A Supply that started to spit out values synchronously would never return its Tap object until it was done, so the consumer had no way to turn it off * A Supply that quickly started to emit values on another thread could cause a data race. In `react { whenever $quick-emit { done } }`, if `$quick-emit` emitted a value before the code in the `react` guts had chance to stash away the Tap object, then the call to `.close` would be missed. This caused S17-supply/supplier-preserving.t to be unreliable and fail now and then. Both of these are resolved by this commit. It additionally moves the Tappable implementation classes out of the methods, which found a couple of bugs and should be a slight speedup. --- src/core/Supply.pm | 708 +++++++++++++++++++++++++-------------------- 1 file changed, 395 insertions(+), 313 deletions(-) diff --git a/src/core/Supply.pm b/src/core/Supply.pm index dde3d3583cb..8a978cd9fd2 100644 --- a/src/core/Supply.pm +++ b/src/core/Supply.pm @@ -26,7 +26,7 @@ my class Tap { # not an Iterable. Guess that's part of the duality too. Ask your local # category theorist. :-)) my role Tappable { - method tap() { ... } + method tap(&emit, &done, &quit, &tap) { ... } method live() { ... } # Taps into a live data source method serial() { ... } # Promises no concurrent emits method sane() { ... } # Matches emit* [done|quit]? grammar @@ -75,8 +75,8 @@ my class Supply does Awaitable { my \DISCARD = -> $ {}; my \NOP = -> {}; my \DEATH = -> $ex { $ex.throw }; - method tap(Supply:D: &emit = DISCARD, :&done = NOP, :&quit = DEATH) { - $!tappable.tap(&emit, &done, &quit) + method tap(Supply:D: &emit = DISCARD, :&done = NOP, :&quit = DEATH, :&tap = DISCARD) { + $!tappable.tap(&emit, &done, &quit, &tap) } method act(Supply:D: &actor, *%others) { @@ -87,40 +87,42 @@ my class Supply does Awaitable { ## Supply factories ## - method on-demand(Supply:U: &producer, :&closing, :$scheduler = CurrentThreadScheduler) { - Supply.new(class :: does Tappable { - has &!producer; - has &!closing; - has $!scheduler; - - submethod BUILD(:&!producer!, :&!closing!, :$!scheduler! --> Nil) {} - - method tap(&emit, &done, &quit) { - my int $closed = 0; - my $t = Tap.new({ - if &!closing { - &!closing() unless $closed++; - } + my class OnDemand does Tappable { + has &!producer; + has &!closing; + has $!scheduler; + + submethod BUILD(:&!producer!, :&!closing!, :$!scheduler! --> Nil) {} + + method tap(&emit, &done, &quit, &tap) { + my int $closed = 0; + my $t = Tap.new: { + if &!closing { + &!closing() unless $closed++; + } + } + tap($t); + my $p = Supplier.new; + $p.Supply.tap(&emit, + done => { + done(); + $t.close(); + }, + quit => -> \ex { + quit(ex); + $t.close(); }); - my $p = Supplier.new; - $p.Supply.tap(&emit, - done => { - done(); - $t.close(); - }, - quit => -> \ex { - quit(ex); - $t.close(); - }); - $!scheduler.cue({ &!producer($p) }, - catch => -> \ex { $p.quit(ex) }); - $t - } + $!scheduler.cue({ &!producer($p) }, + catch => -> \ex { $p.quit(ex) }); + $t + } - method live(--> False) { } - method sane(--> False) { } - method serial(--> False) { } - }.new(:&producer, :&closing, :$scheduler)).sanitize + method live(--> False) { } + method sane(--> False) { } + method serial(--> False) { } + } + method on-demand(Supply:U: &producer, :&closing, :$scheduler = CurrentThreadScheduler) { + Supply.new(OnDemand.new(:&producer, :&closing, :$scheduler)).sanitize } method from-list(Supply:U: +@values, :$scheduler = CurrentThreadScheduler) { @@ -130,17 +132,17 @@ my class Supply does Awaitable { }, :$scheduler); } - method interval(Supply:U: $interval, $delay = 0, :$scheduler = $*SCHEDULER) { - Supply.new(class :: does Tappable { - has $!scheduler; - has $!interval; - has $!delay; + my class Interval does Tappable { + has $!scheduler; + has $!interval; + has $!delay; - submethod BUILD(:$!scheduler, :$!interval, :$!delay --> Nil) { } + submethod BUILD(:$!scheduler, :$!interval, :$!delay --> Nil) { } - method tap(&emit, |) { - my $i = 0; - my $lock = Lock::Async.new; + method tap(&emit, &, &, &tap) { + my $i = 0; + my $lock = Lock::Async.new; + $lock.protect: { my $cancellation = $!scheduler.cue( { emit($lock.protect: { $i++ }); @@ -148,13 +150,18 @@ my class Supply does Awaitable { }, :every($!interval), :in($!delay) ); - Tap.new({ $cancellation.cancel }) + my $t = Tap.new({ $cancellation.cancel }); + tap($t); + $t } + } - method live(--> False) { } - method sane(--> True) { } - method serial(--> False) { } - }.new(:$interval, :$delay, :$scheduler)); + method live(--> False) { } + method sane(--> True) { } + method serial(--> False) { } + } + method interval(Supply:U: $interval, $delay = 0, :$scheduler = $*SCHEDULER) { + Supply.new(Interval.new(:$interval, :$delay, :$scheduler)); } ## @@ -176,269 +183,333 @@ my class Supply does Awaitable { } } + my class Serialize does SimpleOpTappable { + submethod BUILD(:$!source! --> Nil) { } + + method tap(&emit, &done, &quit, &tap) { + my $lock = Lock::Async.new; + my int $cleaned-up = 0; + my $source-tap; + my $t; + $!source.tap( + tap => { + $source-tap = $_; + $t = Tap.new({ self!cleanup($cleaned-up, $source-tap) }); + tap($t); + }, + -> \value{ + $lock.protect: { emit(value); } + }, + done => -> { + $lock.protect: { + done(); + self!cleanup($cleaned-up, $source-tap); + } + }, + quit => -> $ex { + $lock.protect: { + quit($ex); + self!cleanup($cleaned-up, $source-tap); + } + }); + $t + } + } method serialize(Supply:D:) { - $!tappable.serial ?? self !! Supply.new(class :: does SimpleOpTappable { - submethod BUILD(:$!source! --> Nil) { } - - method tap(&emit, &done, &quit) { - my $lock = Lock::Async.new; - my int $cleaned-up = 0; - my $source-tap = $!source.tap( - -> \value{ - $lock.protect: { emit(value); } - }, - done => -> { - $lock.protect: { - done(); - self!cleanup($cleaned-up, $source-tap); - } - }, - quit => -> $ex { - $lock.protect: { - quit($ex); - self!cleanup($cleaned-up, $source-tap); - } - }); - Tap.new({ self!cleanup($cleaned-up, $source-tap) }) - } - }.new(source => self)) + $!tappable.serial ?? self !! Supply.new(Serialize.new(source => self)) + } + + my class Sanitize does SimpleOpTappable { + submethod BUILD(:$!source! --> Nil) { } + + method tap(&emit, &done, &quit, &tap) { + my int $cleaned-up = 0; + my int $finished = 0; + my $source-tap; + my $t; + $!source.tap( + tap => { + $source-tap = $_; + $t = Tap.new({ self!cleanup($cleaned-up, $source-tap) }); + tap($t); + }, + -> \value{ + emit(value) unless $finished; + }, + done => -> { + unless $finished { + $finished = 1; + done(); + self!cleanup($cleaned-up, $source-tap); + } + }, + quit => -> $ex { + unless $finished { + $finished = 1; + quit($ex); + self!cleanup($cleaned-up, $source-tap); + } + }); + $t + } } - method sanitize() { - $!tappable.sane ?? self !! Supply.new(class :: does SimpleOpTappable { - submethod BUILD(:$!source! --> Nil) { } - - method tap(&emit, &done, &quit) { - my int $cleaned-up = 0; - my int $finished = 0; - my $source-tap = $!source.tap( - -> \value{ - emit(value) unless $finished; - }, - done => -> { - unless $finished { - $finished = 1; - done(); - self!cleanup($cleaned-up, $source-tap); - } - }, - quit => -> $ex { - unless $finished { - $finished = 1; - quit($ex); - self!cleanup($cleaned-up, $source-tap); - } - }); - Tap.new({ self!cleanup($cleaned-up, $source-tap) }) - } - }.new(source => self.serialize)) + $!tappable.sane ?? self !! Supply.new(Sanitize.new(source => self.serialize)) } - method on-close(Supply:D: &on-close) { - return Supply.new(class :: does SimpleOpTappable { - has &!on-close; + my class OnClose does SimpleOpTappable { + has &!on-close; - submethod BUILD(:$!source!, :&!on-close! --> Nil) { } + submethod BUILD(:$!source!, :&!on-close! --> Nil) { } - method tap(&emit, &done, &quit) { - my int $cleaned-up = 0; - my $source-tap = $!source.tap(&emit, :&done, :&quit); - Tap.new({ + method tap(&emit, &done, &quit, &tap) { + my int $cleaned-up = 0; + my $t; + $!source.tap: &emit, :&done, :&quit, tap => -> $source-tap { + $t = Tap.new({ &!on-close(); self!cleanup($cleaned-up, $source-tap) - }) + }); + tap($t); } - }.new(source => self, :&on-close)) + $t + } } - - method map(Supply:D: &mapper) { - Supply.new(class :: does SimpleOpTappable { - has &!mapper; - - submethod BUILD(:$!source!, :&!mapper! --> Nil) { } - - method tap(&emit, &done, &quit) { - my int $cleaned-up = 0; - my $source-tap = $!source.tap( - -> \value { - my \result = try &!mapper(value); - if $! { - quit($!); - self!cleanup($cleaned-up, $source-tap); - } - else { - emit(result) - } - }, - done => -> { - done(); + method on-close(Supply:D: &on-close) { + return Supply.new(OnClose.new(source => self, :&on-close)) + } + + my class MapSupply does SimpleOpTappable { + has &!mapper; + + submethod BUILD(:$!source!, :&!mapper! --> Nil) { } + + method tap(&emit, &done, &quit, &tap) { + my int $cleaned-up = 0; + my $source-tap; + my $t; + $!source.tap( + tap => { + $source-tap = $_; + $t = Tap.new({ self!cleanup($cleaned-up, $source-tap) }); + tap($t); + }, + -> \value { + my \result = try &!mapper(value); + if $! { + quit($!); self!cleanup($cleaned-up, $source-tap); - }, - quit => -> $ex { - quit($ex); + } + else { + emit(result) + } + }, + done => -> { + done(); + self!cleanup($cleaned-up, $source-tap); + }, + quit => -> $ex { + quit($ex); + self!cleanup($cleaned-up, $source-tap); + }); + $t + } + } + method map(Supply:D: &mapper) { + Supply.new(MapSupply.new(source => self.sanitize, :&mapper)) + } + + my class Grep does SimpleOpTappable { + has Mu $!test; + + submethod BUILD(:$!source!, Mu :$!test! --> Nil) { } + + method tap(&emit, &done, &quit, &tap) { + my int $cleaned-up = 0; + my $source-tap; + my $t; + $!source.tap( + tap => { + $source-tap = $_; + $t = Tap.new({ self!cleanup($cleaned-up, $source-tap) }); + tap($t); + }, + -> \value { + my \accepted = try $!test.ACCEPTS(value); + if accepted { + emit(value); + } + elsif $! { + quit($!); self!cleanup($cleaned-up, $source-tap); - }); - Tap.new({ self!cleanup($cleaned-up, $source-tap) }) - } - }.new(source => self.sanitize, :&mapper)) + } + }, + done => -> { + done(); + self!cleanup($cleaned-up, $source-tap); + }, + quit => -> $ex { + quit($ex); + self!cleanup($cleaned-up, $source-tap); + }); + $t + } } - method grep(Supply:D: Mu $test) { - Supply.new(class :: does SimpleOpTappable { - has Mu $!test; - - submethod BUILD(:$!source!, Mu :$!test! --> Nil) { } - - method tap(&emit, &done, &quit) { - my int $cleaned-up = 0; - my $source-tap = $!source.tap( - -> \value { - my \accepted = try $!test.ACCEPTS(value); - if accepted { - emit(value); - } - elsif $! { - quit($!); - self!cleanup($cleaned-up, $source-tap); - } - }, - done => -> { - done(); - self!cleanup($cleaned-up, $source-tap); - }, - quit => -> $ex { - quit($ex); - self!cleanup($cleaned-up, $source-tap); - }); - Tap.new({ self!cleanup($cleaned-up, $source-tap) }) - } - }.new(source => self.sanitize, :$test)) + Supply.new(Grep.new(source => self.sanitize, :$test)) + } + + my class ScheduleOn does SimpleOpTappable { + has $!scheduler; + + submethod BUILD(:$!source!, :$!scheduler! --> Nil) { } + + method tap(&emit, &done, &quit, &tap) { + my int $cleaned-up = 0; + my $source-tap; + my $t; + $!source.tap( + tap => { + $source-tap = $_; + $t = Tap.new({ self!cleanup($cleaned-up, $source-tap) }); + tap($t); + }, + -> \value { + $!scheduler.cue: { emit(value) } + }, + done => -> { + $!scheduler.cue: { done(); self!cleanup($cleaned-up, $source-tap); } + }, + quit => -> $ex { + $!scheduler.cue: { quit($ex); self!cleanup($cleaned-up, $source-tap); } + }); + $t + } } - method schedule-on(Supply:D: Scheduler $scheduler) { - Supply.new(class :: does SimpleOpTappable { - has $!scheduler; + Supply.new(ScheduleOn.new(source => self.sanitize, :$scheduler)) + } - submethod BUILD(:$!source!, :$!scheduler! --> Nil) { } + my class Start does SimpleOpTappable { + has $!value; + has &!startee; - method tap(&emit, &done, &quit) { - my int $cleaned-up = 0; - my $source-tap = $!source.tap( - -> \value { - $!scheduler.cue: { emit(value) } - }, - done => -> { - $!scheduler.cue: { done(); self!cleanup($cleaned-up, $source-tap); } - }, - quit => -> $ex { - $!scheduler.cue: { quit($ex); self!cleanup($cleaned-up, $source-tap); } - }); - Tap.new({ self!cleanup($cleaned-up, $source-tap) }) - } - }.new(source => self.sanitize, :$scheduler)) - } + submethod BUILD(:$!value, :&!startee --> Nil) { } + method tap(&emit, &done, &quit, &tap) { + my int $closed = 0; + my $t = Tap.new({ $closed = 1 }); + tap($t); + Promise.start({ &!startee($!value) }).then({ + unless $closed { + if .status == Kept { + emit(.result); + done(); + } + else { + quit(.cause); + } + } + }); + $t + } + } method start(Supply:D: &startee) { self.map: -> \value { - Supply.new(class :: does SimpleOpTappable { - has $!value; - has &!startee; - - submethod BUILD(:$!value, :&!startee --> Nil) { } - - method tap(&emit, &done, &quit) { - my int $closed = 0; - Promise.start({ &!startee($!value) }).then({ - unless $closed { - if .status == Kept { - emit(.result); - done(); - } - else { - quit(.cause); - } - } - }); - Tap.new({ $closed = 1 }) - } - }.new(:value(value), :&startee)) + Supply.new(Start.new(:value(value), :&startee)) } } - method stable(Supply:D: $time, :$scheduler = $*SCHEDULER) { - return self unless $time; - Supply.new(class :: does SimpleOpTappable { - has $!time; - has $!scheduler; - has $!last_cancellation; - has $!lock = Lock::Async.new; - - submethod BUILD(:$!source!, :$!time!, :$!scheduler! --> Nil) { } - - method tap(&emit, &done, &quit) { - my int $cleaned-up = 0; - my $source-tap = $!source.tap( - -> \value { - $!lock.protect: { - if $!last_cancellation { - $!last_cancellation.cancel; - } - $!last_cancellation = $!scheduler.cue( - :in($time), - { - $!lock.protect: { $!last_cancellation = Nil; } - try { - emit(value); - CATCH { - default { - quit($_); - self!cleanup($cleaned-up, $source-tap); - } + my class Stable does SimpleOpTappable { + has $!time; + has $!scheduler; + + submethod BUILD(:$!source!, :$!time!, :$!scheduler! --> Nil) { } + + method tap(&emit, &done, &quit, &tap) { + my int $cleaned-up = 0; + my $lock = Lock::Async.new; + my $last_cancellation; + my $source-tap; + my $t; + $!source.tap( + tap => { + $source-tap = $_; + $t = Tap.new({ self!cleanup($cleaned-up, $source-tap) }); + tap($t); + }, + -> \value { + $lock.protect: { + if $last_cancellation { + $last_cancellation.cancel; + } + $last_cancellation = $!scheduler.cue( + :in($!time), + { + $lock.protect: { $last_cancellation = Nil; } + try { + emit(value); + CATCH { + default { + quit($_); + self!cleanup($cleaned-up, $source-tap); } } - }); - } - }, - done => -> { - done(); - self!cleanup($cleaned-up, $source-tap); - }, - quit => -> $ex { - quit($ex); - self!cleanup($cleaned-up, $source-tap); - }); - Tap.new({ self!cleanup($cleaned-up, $source-tap) }) - } - }.new(source => self.sanitize, :$time, :$scheduler)) + } + }); + } + }, + done => -> { + done(); + self!cleanup($cleaned-up, $source-tap); + }, + quit => -> $ex { + quit($ex); + self!cleanup($cleaned-up, $source-tap); + }); + $t + } + } + method stable(Supply:D: $time, :$scheduler = $*SCHEDULER) { + return self unless $time; + Supply.new(Stable.new(source => self.sanitize, :$time, :$scheduler)) + } + + my class Delayed does SimpleOpTappable { + has $!time; + has $!scheduler; + + submethod BUILD(:$!source!, :$!time, :$!scheduler! --> Nil) { } + + method tap(&emit, &done, &quit, &tap) { + my int $cleaned-up = 0; + my $source-tap; + my $t; + $!source.tap( + tap => { + $source-tap = $_; + my $t = Tap.new({ self!cleanup($cleaned-up, $source-tap) }); + tap($t); + }, + -> \value { + $!scheduler.cue: { emit(value) }, :in($!time) + }, + done => -> { + $!scheduler.cue: + { done(); self!cleanup($cleaned-up, $source-tap); }, + :in($!time) + }, + quit => -> $ex { + $!scheduler.cue: + { quit($ex); self!cleanup($cleaned-up, $source-tap); }, + :in($!time) + }); + $t + } } - method delayed(Supply:D: $time, :$scheduler = $*SCHEDULER) { return self unless $time; # nothing to do - Supply.new(class :: does SimpleOpTappable { - has $!time; - has $!scheduler; - - submethod BUILD(:$!source!, :$!time, :$!scheduler! --> Nil) { } - - method tap(&emit, &done, &quit) { - my int $cleaned-up = 0; - my $source-tap = $!source.tap( - -> \value { - $!scheduler.cue: { emit(value) }, :in($time) - }, - done => -> { - $!scheduler.cue: - { done(); self!cleanup($cleaned-up, $source-tap); }, - :in($time) - }, - quit => -> $ex { - $!scheduler.cue: - { quit($ex); self!cleanup($cleaned-up, $source-tap); }, - :in($time) - }); - Tap.new({ self!cleanup($cleaned-up, $source-tap) }) - } - }.new(source => self.sanitize, :$time, :$scheduler)) + Supply.new(Delayed.new(source => self.sanitize, :$time, :$scheduler)) } ## @@ -1440,16 +1511,9 @@ my class Supplier { # need lock on modification). has Mu $!tappers; - method tap(&emit, &done, &quit) { + method tap(&emit, &done, &quit, &tap) { my $tle := TapListEntry.new(:&emit, :&done, :&quit); - $!lock.protect({ - my Mu $update := nqp::isconcrete($!tappers) - ?? nqp::clone($!tappers) - !! nqp::list(); - nqp::push($update, $tle); - $!tappers := $update; - }); - Tap.new({ + my $t = Tap.new({ $!lock.protect({ my Mu $update := nqp::list(); for nqp::hllize($!tappers) -> \entry { @@ -1457,7 +1521,16 @@ my class Supplier { } $!tappers := $update; }); - }) + }); + tap($t); + $!lock.protect({ + my Mu $update := nqp::isconcrete($!tappers) + ?? nqp::clone($!tappers) + !! nqp::list(); + nqp::push($update, $tle); + $!tappers := $update; + }); + $t } method emit(\value --> Nil) { @@ -1552,9 +1625,20 @@ my class Supplier::Preserving is Supplier { has int $!replay-done; has $!replay-lock = Lock.new; - method tap(&emit, &done, &quit) { + method tap(&emit, &done, &quit, &tap) { my $tle := TapListEntry.new(:&emit, :&done, :&quit); my int $replay = 0; + my $t = Tap.new({ + $!lock.protect({ + my Mu $update := nqp::list(); + for nqp::hllize($!tappers) -> \entry { + nqp::push($update, entry) unless entry =:= $tle; + } + $!replay-done = 0 if nqp::elems($update) == 0; + $!tappers := $update; + }); + }); + tap($t); $!lock.protect({ my Mu $update := nqp::isconcrete($!tappers) ?? nqp::clone($!tappers) @@ -1564,16 +1648,7 @@ my class Supplier::Preserving is Supplier { self!replay($tle) if $replay; $!tappers := $update; }); - Tap.new({ - $!lock.protect({ - my Mu $update := nqp::list(); - for nqp::hllize($!tappers) -> \entry { - nqp::push($update, entry) unless entry =:= $tle; - } - $!replay-done = 0 if nqp::elems($update) == 0; - $!tappers := $update; - }); - }) + $t } method emit(\value --> Nil) { @@ -1752,7 +1827,7 @@ augment class Rakudo::Internals { submethod BUILD(:&!block --> Nil) { } - method tap(&emit, &done, &quit) { + method tap(&emit, &done, &quit, &tap) { # Create state for this tapping. my $state = Rakudo::Internals::SupplyBlockState.new(:&emit, :&done, :&quit); @@ -1763,21 +1838,25 @@ augment class Rakudo::Internals { $state.increment-active(); my $tap; nqp::continuationreset(ADD_WHENEVER_PROMPT, { - $tap = $supply.tap( + $supply.tap( + tap => { + $tap = $_; + $state.add-active-tap($tap); + }, -> \value { self!run-supply-code({ whenever-block(value) }, $state, &add-whenever) }, done => { - $state.delete-active-tap($tap) if $tap.DEFINITE; + $state.delete-active-tap($tap); my @phasers := &whenever-block.phasers('LAST'); if @phasers { self!run-supply-code({ .() for @phasers }, $state, &add-whenever) } - $tap.?close; + $tap.close; self!deactivate-one($state); }, quit => -> \ex { - $state.delete-active-tap($tap) if $tap.DEFINITE; + $state.delete-active-tap($tap); my $handled; self!run-supply-code({ my $phaser := &whenever-block.phasers('QUIT')[0]; @@ -1790,11 +1869,10 @@ augment class Rakudo::Internals { } }, $state, &add-whenever); if $handled { - $tap.?close; + $tap.close; self!deactivate-one($state); } }); - $state.add-active-tap($tap); }); $tap } @@ -1804,14 +1882,18 @@ augment class Rakudo::Internals { $state.close-phasers.push(.clone) for &!block.phasers('CLOSE') } + # Create and pass on tap; when closed, tear down the state and all + # of our subscriptions. + my $t = Tap.new(-> { self!teardown($state) }); + tap($t); + # Run the Supply block, then decrease active count afterwards (it # counts as an active runner). self!run-supply-code(&!block, $state, &add-whenever); self!deactivate-one($state); - # Return a tap; when closed, tear down the state and all of our - # subscriptions. - Tap.new(-> { self!teardown($state) }) + # Evaluate to the Tap. + $t } method !run-supply-code(&code, $state, &add-whenever) { From 0d600a0cb606e59224b89049a472279c3acbafd2 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Thu, 21 Sep 2017 16:19:41 +0200 Subject: [PATCH 131/692] Don't re-acquire lock after running supply body Instead, just use the one we're already holding to decrement the active tap count. Prevents a potential deadlock if an `emit` gets in from one of the `whenever`s and then does some kind of `await`. --- src/core/Supply.pm | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/src/core/Supply.pm b/src/core/Supply.pm index 8a978cd9fd2..39bc1f8b879 100644 --- a/src/core/Supply.pm +++ b/src/core/Supply.pm @@ -1889,8 +1889,9 @@ augment class Rakudo::Internals { # Run the Supply block, then decrease active count afterwards (it # counts as an active runner). - self!run-supply-code(&!block, $state, &add-whenever); - self!deactivate-one($state); + self!run-supply-code: + { &!block(); self!deactivate-one-internal($state) }, + $state, &add-whenever; # Evaluate to the Tap. $t @@ -1938,12 +1939,14 @@ augment class Rakudo::Internals { } method !deactivate-one($state) { - $state.run-async-lock.protect: { - if $state.decrement-active() == 0 { - $state.done().() if $state.done; - self!teardown($state); - } - }; + $state.run-async-lock.protect: { self!deactivate-one-internal($state) }; + } + + method !deactivate-one-internal($state) { + if $state.decrement-active() == 0 { + $state.done().() if $state.done; + self!teardown($state); + } } method !teardown($state) { From 3da62db991721256870b7929da3251ddeeed1689 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Thu, 21 Sep 2017 20:17:24 -0400 Subject: [PATCH 132/692] Add new test file to list of test files to run --- t/spectest.data | 1 + 1 file changed, 1 insertion(+) diff --git a/t/spectest.data b/t/spectest.data index c51314765db..9dce7dd690f 100644 --- a/t/spectest.data +++ b/t/spectest.data @@ -571,6 +571,7 @@ S09-typed-arrays/native-str.t S10-packages/basic.t S10-packages/joined-namespaces.t S10-packages/precompilation.t # slow +S10-packages/require-and-use.t S10-packages/use-with-class.t S11-compunit/compunit-dependencyspecification.t S11-compunit/compunit-repository.t From 1d63dfd2a814315e9ff46e80d5106ae86d4361c3 Mon Sep 17 00:00:00 2001 From: skids Date: Thu, 21 Sep 2017 21:50:47 -0400 Subject: [PATCH 133/692] Restrict dynamic lookup metasyntax in rx EVAL (security RT#131079) --- src/Perl6/Grammar.nqp | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Perl6/Grammar.nqp b/src/Perl6/Grammar.nqp index f4303361bdf..98591810143 100644 --- a/src/Perl6/Grammar.nqp +++ b/src/Perl6/Grammar.nqp @@ -5421,6 +5421,7 @@ grammar Perl6::RegexGrammar is QRegex::P6Regex::Grammar does STD does MatchPacka } token assertion:sym { + > [ | ]> From 547839200a772e26ea164e9d1fd8c9cd4a5c2d9f Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Fri, 22 Sep 2017 11:48:31 +0200 Subject: [PATCH 134/692] Queue Supply messages on recursion This handles the case where a Supply does an emit/done/quit and there is a code path that ends up looping back to the Supply itself. Due to messages on a Supply being serialized, this would result in a deadlock after the recent changes to the Supply concurrency model. Previously, it would work out for `supply`/`react` blocks due to their queueing of messages (which we eliminated due to it being a broken backpressure model and not allowing us to fix the tap-of-a-synchronous-emitter bug) and "work" (but violate the one-message-at-a-time constraint) in other cases due to the use of a reentrant mutex to manage concurrency control in non-`supply`/`react`-block cases. This fixes it with a unified approach, by adding a mechanism whereby a recursive attempt to acquire a Lock::Async will queue the work instead of blocking on the lock (which is actually non-blocking in the thread pool). Thus, we retain the backpressure for competing senders, but allow the current holder to queue messages to resolve what would be a deadlock otherwise. A holder's recursion competes fairly with outside messages, thanks to the queueing being through Lock::Async. The recursion detection uses dynamic variables, not thread IDs. This is important because stacks including a Lock::Async acquisition may move between threads over their lifetime, so we cannot simply go on thread ID. Finally, there is also a mechanism to temporarily hide a lock from the recursion detector, since the handling of doing a `whenever` that leads to synchronous emits already exists. It's interesting to consider if the mechanisms may be unified, but not immediately clear if they can be. --- src/core/Lock/Async.pm | 50 ++++++++++++++++++++++ src/core/Supply.pm | 94 ++++++++++++++++++++++++------------------ 2 files changed, 103 insertions(+), 41 deletions(-) diff --git a/src/core/Lock/Async.pm b/src/core/Lock/Async.pm index bd34f822eff..94456b81cc1 100644 --- a/src/core/Lock/Async.pm +++ b/src/core/Lock/Async.pm @@ -125,4 +125,54 @@ my class Lock::Async { LEAVE self.unlock() if $acquired; code() } + + # This either runs the code now if we can obtain the lock, releasing the + # lock afterwards, or queues the code to run if a recursive use of the + # lock is observed. It relies on all users of the lock to use it through + # this method only. This is useful for providing back-pressure while also + # avoiding code deadlocking on itself by providing a way for it to get run + # later on. Returns Nil if the code was run now (maybe after blocking), or + # a Promise if it was queued for running later. + method protect-or-queue-on-recursion(Lock::Async:D: &code) { + my $try-acquire = self.lock(); + if $try-acquire { + # We could acquire the lock. Run the code right now. + LEAVE self.unlock(); + self!run-with-updated-recursion-list(&code); + Nil + } + elsif (@*LOCK-ASYNC-RECURSION-LIST // Empty).first(* === self) { + # Lock is already held on the stack, so we're recursing. Queue. + $try-acquire.then({ + LEAVE self.unlock(); + self!run-with-updated-recursion-list(&code); + }); + } + else { + # Lock is held but by something else. Await it's availability. + my int $acquired = 0; + $*AWAITER.await($try-acquire); + $acquired = 1; + LEAVE self.unlock() if $acquired; + self!run-with-updated-recursion-list(&code); + Nil + } + } + + method !run-with-updated-recursion-list(&code) { + my @new-held = @*LOCK-ASYNC-RECURSION-LIST // (); + @new-held.push(self); + { + my @*LOCK-ASYNC-RECURSION-LIST := @new-held; + code(); + } + } + + method with-lock-hidden-from-recursion-check(&code) { + my @new-held = (@*LOCK-ASYNC-RECURSION-LIST // ()).grep(* !=== self); + { + my @*LOCK-ASYNC-RECURSION-LIST := @new-held; + code(); + } + } } diff --git a/src/core/Supply.pm b/src/core/Supply.pm index 39bc1f8b879..c7d7bc159b2 100644 --- a/src/core/Supply.pm +++ b/src/core/Supply.pm @@ -198,16 +198,16 @@ my class Supply does Awaitable { tap($t); }, -> \value{ - $lock.protect: { emit(value); } + $lock.protect-or-queue-on-recursion: { emit(value); } }, done => -> { - $lock.protect: { + $lock.protect-or-queue-on-recursion: { done(); self!cleanup($cleaned-up, $source-tap); } }, quit => -> $ex { - $lock.protect: { + $lock.protect-or-queue-on-recursion: { quit($ex); self!cleanup($cleaned-up, $source-tap); } @@ -1834,46 +1834,48 @@ augment class Rakudo::Internals { # Placed here so it can close over $state, but we only need to # closure-clone it once per Supply block, not once per whenever. sub add-whenever($supply, &whenever-block) { - my $*AWAITER := $state.awaiter; - $state.increment-active(); my $tap; - nqp::continuationreset(ADD_WHENEVER_PROMPT, { - $supply.tap( - tap => { - $tap = $_; - $state.add-active-tap($tap); - }, - -> \value { - self!run-supply-code({ whenever-block(value) }, $state, &add-whenever) - }, - done => { - $state.delete-active-tap($tap); - my @phasers := &whenever-block.phasers('LAST'); - if @phasers { - self!run-supply-code({ .() for @phasers }, $state, &add-whenever) - } - $tap.close; - self!deactivate-one($state); - }, - quit => -> \ex { - $state.delete-active-tap($tap); - my $handled; - self!run-supply-code({ - my $phaser := &whenever-block.phasers('QUIT')[0]; - if $phaser.DEFINITE { - $handled = $phaser(ex) === Nil; - } - if !$handled && $state.get-and-zero-active() { - $state.quit().(ex) if $state.quit; - self!teardown($state); + $state.run-async-lock.with-lock-hidden-from-recursion-check: { + my $*AWAITER := $state.awaiter; + $state.increment-active(); + nqp::continuationreset(ADD_WHENEVER_PROMPT, { + $supply.tap( + tap => { + $tap = $_; + $state.add-active-tap($tap); + }, + -> \value { + self!run-supply-code({ whenever-block(value) }, $state, &add-whenever) + }, + done => { + $state.delete-active-tap($tap); + my @phasers := &whenever-block.phasers('LAST'); + if @phasers { + self!run-supply-code({ .() for @phasers }, $state, &add-whenever) } - }, $state, &add-whenever); - if $handled { $tap.close; self!deactivate-one($state); - } - }); - }); + }, + quit => -> \ex { + $state.delete-active-tap($tap); + my $handled; + self!run-supply-code({ + my $phaser := &whenever-block.phasers('QUIT')[0]; + if $phaser.DEFINITE { + $handled = $phaser(ex) === Nil; + } + if !$handled && $state.get-and-zero-active() { + $state.quit().(ex) if $state.quit; + self!teardown($state); + } + }, $state, &add-whenever); + if $handled { + $tap.close; + self!deactivate-one($state); + } + }); + }); + } $tap } @@ -1899,7 +1901,7 @@ augment class Rakudo::Internals { method !run-supply-code(&code, $state, &add-whenever) { my @run-after; - $state.run-async-lock.protect: { + my $queued := $state.run-async-lock.protect-or-queue-on-recursion: { return unless $state.active > 0; my &*ADD-WHENEVER = &add-whenever; my $emitter = { @@ -1925,6 +1927,15 @@ augment class Rakudo::Internals { 'NEXT', 0); @run-after = $state.awaiter.take-all; } + if $queued.defined { + $queued.then({ self!run-add-whenever-awaits(@run-after) }); + } + else { + self!run-add-whenever-awaits(@run-after); + } + } + + method !run-add-whenever-awaits(@run-after --> Nil) { if @run-after { my $nested-awaiter := SupplyBlockAddWheneverAwaiter.CREATE; my $delegate-awaiter := $*AWAITER; @@ -1939,7 +1950,8 @@ augment class Rakudo::Internals { } method !deactivate-one($state) { - $state.run-async-lock.protect: { self!deactivate-one-internal($state) }; + $state.run-async-lock.protect-or-queue-on-recursion: + { self!deactivate-one-internal($state) }; } method !deactivate-one-internal($state) { From 397692aca5d229c860bfd2d7a421d418a827ca01 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Fri, 22 Sep 2017 12:27:52 +0200 Subject: [PATCH 135/692] Some small optimizations to `supply`/`react` --- src/core/Supply.pm | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/src/core/Supply.pm b/src/core/Supply.pm index c7d7bc159b2..0e5e36a5071 100644 --- a/src/core/Supply.pm +++ b/src/core/Supply.pm @@ -1745,7 +1745,7 @@ augment class Rakudo::Internals { !! $handle.cause.rethrow } else { - my $reawaitable = CachedAwaitHandle.new(get-await-handle => $handle); + my $reawaitable := CachedAwaitHandle.new(get-await-handle => $handle); $!continuations := nqp::list() unless nqp::isconcrete($!continuations); nqp::continuationcontrol(0, ADD_WHENEVER_PROMPT, -> Mu \c { nqp::push($!continuations, -> $delegate-awaiter { @@ -1906,19 +1906,22 @@ augment class Rakudo::Internals { my &*ADD-WHENEVER = &add-whenever; my $emitter = { my \ex := nqp::exception(); - $state.emit().(nqp::getpayload(ex)) if $state.emit; + my $emit-handler := $state.emit; + $emit-handler(nqp::getpayload(ex)) if $emit-handler.DEFINITE; nqp::resume(ex) } my $done = { $state.get-and-zero-active(); self!teardown($state); - $state.done().() if $state.done; + my $done-handler := $state.done; + $done-handler() if $done-handler.DEFINITE; } my $catch = { my \ex = EXCEPTION(nqp::exception()); $state.get-and-zero-active(); self!teardown($state); - $state.quit().(ex) if $state.quit; + my $quit-handler = $state.quit; + $quit-handler(ex) if $quit-handler; } nqp::handle(code(), 'EMIT', $emitter(), @@ -1956,7 +1959,8 @@ augment class Rakudo::Internals { method !deactivate-one-internal($state) { if $state.decrement-active() == 0 { - $state.done().() if $state.done; + my $done-handler = $state.done; + $done-handler() if $done-handler; self!teardown($state); } } From e0e5e6fac9a2f666e4d2ff67c7edc41d400828bf Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Fri, 22 Sep 2017 12:37:19 +0200 Subject: [PATCH 136/692] Handle await-all during adding a whenever --- src/core/Supply.pm | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/src/core/Supply.pm b/src/core/Supply.pm index 0e5e36a5071..d12b5bf4e68 100644 --- a/src/core/Supply.pm +++ b/src/core/Supply.pm @@ -1758,7 +1758,14 @@ augment class Rakudo::Internals { } method await-all(Iterable:D \i) { - die "NYI"; + $!continuations := nqp::list() unless nqp::isconcrete($!continuations); + nqp::continuationcontrol(0, ADD_WHENEVER_PROMPT, -> Mu \c { + nqp::push($!continuations, -> $delegate-awaiter { + nqp::continuationinvoke(c, { + $delegate-awaiter.await-all(i); + }); + }); + }); } method take-all() { From b16aba019b31d1616931e09fb72fe96fed48d953 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Fri, 22 Sep 2017 12:59:45 +0200 Subject: [PATCH 137/692] Optimize recursion handling in Lock::Async No semantic changes, this just rewrites a hot path in a more optimal way, without too much cost to its overall clarity. --- src/core/Lock/Async.pm | 39 +++++++++++++++++++++++++++++++++------ 1 file changed, 33 insertions(+), 6 deletions(-) diff --git a/src/core/Lock/Async.pm b/src/core/Lock/Async.pm index 94456b81cc1..ae6f97e8522 100644 --- a/src/core/Lock/Async.pm +++ b/src/core/Lock/Async.pm @@ -141,7 +141,7 @@ my class Lock::Async { self!run-with-updated-recursion-list(&code); Nil } - elsif (@*LOCK-ASYNC-RECURSION-LIST // Empty).first(* === self) { + elsif self!on-recursion-list() { # Lock is already held on the stack, so we're recursing. Queue. $try-acquire.then({ LEAVE self.unlock(); @@ -159,19 +159,46 @@ my class Lock::Async { } } + method !on-recursion-list() { + my $rec-list := nqp::getlexdyn('$*LOCK-ASYNC-RECURSION-LIST'); + if nqp::isnull($rec-list) { + False + } + else { + my int $n = nqp::elems($rec-list); + loop (my int $i = 0; $i < $n; $i++) { + return True if nqp::eqaddr(nqp::atpos($rec-list, $i), self); + } + False + } + } + method !run-with-updated-recursion-list(&code) { - my @new-held = @*LOCK-ASYNC-RECURSION-LIST // (); - @new-held.push(self); + my $current := nqp::getlexdyn('$*LOCK-ASYNC-RECURSION-LIST'); + my $new-held := nqp::isnull($current) ?? nqp::list() !! nqp::clone($current); + nqp::push($new-held, self); { - my @*LOCK-ASYNC-RECURSION-LIST := @new-held; + my $*LOCK-ASYNC-RECURSION-LIST := $new-held; code(); } } method with-lock-hidden-from-recursion-check(&code) { - my @new-held = (@*LOCK-ASYNC-RECURSION-LIST // ()).grep(* !=== self); + my $current := nqp::getlexdyn('$*LOCK-ASYNC-RECURSION-LIST'); + my $new-held; + if nqp::isnull($current) { + $new-held := nqp::null(); + } + else { + $new-held := nqp::list(); + my int $n = nqp::elems($current); + loop (my int $i = 0; $i < $n; $i++) { + my $lock := nqp::atpos($current, $i); + nqp::push($new-held, $lock) unless nqp::eqaddr($lock, self); + } + } { - my @*LOCK-ASYNC-RECURSION-LIST := @new-held; + my $*LOCK-ASYNC-RECURSION-LIST := $new-held; code(); } } From d8890a82840e2d15a3615c94ca962e797154c3ae Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Fri, 22 Sep 2017 13:40:42 +0200 Subject: [PATCH 138/692] Bump NQP to get the latest Moar async fixes --- tools/build/NQP_REVISION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/build/NQP_REVISION b/tools/build/NQP_REVISION index b327b804433..90892943756 100644 --- a/tools/build/NQP_REVISION +++ b/tools/build/NQP_REVISION @@ -1 +1 @@ -2017.09-7-ga5f92f2fe \ No newline at end of file +2017.09-18-g59612c4 From 73aeee6ce7bfe24e4e57ce97fb6972c3be00c76f Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Fri, 22 Sep 2017 15:12:32 +0200 Subject: [PATCH 139/692] Avoid one lock acquire/release per `whenever` --- src/core/Supply.pm | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/src/core/Supply.pm b/src/core/Supply.pm index d12b5bf4e68..f0ca9589e71 100644 --- a/src/core/Supply.pm +++ b/src/core/Supply.pm @@ -1791,10 +1791,6 @@ augment class Rakudo::Internals { has $.run-async-lock = Lock::Async.new; has $.awaiter = SupplyBlockAddWheneverAwaiter.CREATE; - method increment-active() { - $!lock.protect: { ++$!active } - } - method decrement-active() { $!lock.protect: { --$!active } } @@ -1809,6 +1805,7 @@ augment class Rakudo::Internals { method add-active-tap($tap --> Nil) { $!lock.protect: { + ++$!active; %!active-taps{nqp::objectid($tap)} = $tap; } } @@ -1844,7 +1841,6 @@ augment class Rakudo::Internals { my $tap; $state.run-async-lock.with-lock-hidden-from-recursion-check: { my $*AWAITER := $state.awaiter; - $state.increment-active(); nqp::continuationreset(ADD_WHENEVER_PROMPT, { $supply.tap( tap => { From 2a8262383102ead726d1bef1f6b71ae67c6185d2 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Fri, 22 Sep 2017 15:48:29 +0200 Subject: [PATCH 140/692] Optimize creation of supply block state object --- src/core/Supply.pm | 20 ++++++++++++++++---- 1 file changed, 16 insertions(+), 4 deletions(-) diff --git a/src/core/Supply.pm b/src/core/Supply.pm index f0ca9589e71..7ecf8c8dc65 100644 --- a/src/core/Supply.pm +++ b/src/core/Supply.pm @@ -1785,11 +1785,23 @@ augment class Rakudo::Internals { has &.done; has &.quit; has @.close-phasers; - has $.active = 1; - has $!lock = Lock.new; + has $.active; + has $!lock; has %!active-taps; - has $.run-async-lock = Lock::Async.new; - has $.awaiter = SupplyBlockAddWheneverAwaiter.CREATE; + has $.run-async-lock; + has $.awaiter; + + method new(:&emit!, :&done!, :&quit!) { + self.CREATE!SET-SELF(&emit, &done, &quit) + } + + method !SET-SELF(&!emit, &!done, &!quit) { + $!active = 1; + $!lock := Lock.new; + $!run-async-lock := Lock::Async.new; + $!awaiter := SupplyBlockAddWheneverAwaiter.CREATE; + self + } method decrement-active() { $!lock.protect: { --$!active } From 3deda842247f9c83e9a5b06134b185babf72e949 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Fri, 22 Sep 2017 15:51:38 +0200 Subject: [PATCH 141/692] Avoid a closure per emit into a supply/react block --- src/core/Supply.pm | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/src/core/Supply.pm b/src/core/Supply.pm index 7ecf8c8dc65..0f5baf74ae1 100644 --- a/src/core/Supply.pm +++ b/src/core/Supply.pm @@ -1860,13 +1860,15 @@ augment class Rakudo::Internals { $state.add-active-tap($tap); }, -> \value { - self!run-supply-code({ whenever-block(value) }, $state, &add-whenever) + self!run-supply-code(&whenever-block, value, $state, + &add-whenever) }, done => { $state.delete-active-tap($tap); my @phasers := &whenever-block.phasers('LAST'); if @phasers { - self!run-supply-code({ .() for @phasers }, $state, &add-whenever) + self!run-supply-code({ .() for @phasers }, Nil, $state, + &add-whenever) } $tap.close; self!deactivate-one($state); @@ -1883,7 +1885,7 @@ augment class Rakudo::Internals { $state.quit().(ex) if $state.quit; self!teardown($state); } - }, $state, &add-whenever); + }, Nil, $state, &add-whenever); if $handled { $tap.close; self!deactivate-one($state); @@ -1908,13 +1910,13 @@ augment class Rakudo::Internals { # counts as an active runner). self!run-supply-code: { &!block(); self!deactivate-one-internal($state) }, - $state, &add-whenever; + Nil, $state, &add-whenever; # Evaluate to the Tap. $t } - method !run-supply-code(&code, $state, &add-whenever) { + method !run-supply-code(&code, \value, $state, &add-whenever) { my @run-after; my $queued := $state.run-async-lock.protect-or-queue-on-recursion: { return unless $state.active > 0; @@ -1938,7 +1940,7 @@ augment class Rakudo::Internals { my $quit-handler = $state.quit; $quit-handler(ex) if $quit-handler; } - nqp::handle(code(), + nqp::handle(code(value), 'EMIT', $emitter(), 'DONE', $done(), 'CATCH', $catch(), From f58ac99918634a7bdb5e90abc61e1cf11056d44c Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Fri, 22 Sep 2017 16:34:27 +0200 Subject: [PATCH 142/692] Streamline async socket message Supply Implement the Tappable interface directly, rather than going through the `Supply.on-demand` machinery that adds extra safety checks and indirections. This boosts the number of requests per second in a simple Cro HTTP example by around 13%; for more direct users of IO::Socket::Async it will be more significant than that. --- src/core/IO/Socket/Async.pm | 21 +--------- src/core/Supply.pm | 76 +++++++++++++++++++++++++++++++++++++ 2 files changed, 78 insertions(+), 19 deletions(-) diff --git a/src/core/IO/Socket/Async.pm b/src/core/IO/Socket/Async.pm index 84408b052ac..20e237e00d3 100644 --- a/src/core/IO/Socket/Async.pm +++ b/src/core/IO/Socket/Async.pm @@ -42,27 +42,10 @@ my class IO::Socket::Async { $p } - my sub capture(\supply) { - my $ss = Rakudo::Internals::SupplySequencer.new( - on-data-ready => -> \data { supply.emit(data) }, - on-completed => -> { supply.done() }, - on-error => -> \err { supply.quit(err) }); - -> Mu \seq, Mu \data, Mu \err { $ss.process(seq, data, err) } - } - multi method Supply(IO::Socket::Async:D: :$bin, :$buf = buf8.new, :$enc, :$scheduler = $*SCHEDULER) { if $bin { - my $cancellation; - Supply.on-demand: - -> $supply { - $cancellation := nqp::asyncreadbytes($!VMIO, - $scheduler.queue(:hint-affinity), - capture($supply), nqp::decont($buf), SocketCancellation); - $!close-promise.then({ $supply.done }); - }, - closing => { - $cancellation && nqp::cancel($cancellation) - } + Supply.new: Rakudo::Internals::IOReaderTappable.new: + :$!VMIO, :$scheduler, :$buf, :$!close-promise } else { my $bin-supply = self.Supply(:bin); diff --git a/src/core/Supply.pm b/src/core/Supply.pm index 0f5baf74ae1..1e4c4b8ebe4 100644 --- a/src/core/Supply.pm +++ b/src/core/Supply.pm @@ -1728,6 +1728,82 @@ my class Supplier::Preserving is Supplier { } augment class Rakudo::Internals { + class IOReaderTappable does Tappable { + my class ReaderCancellation is repr('AsyncTask') { } + + has $!VMIO; + has $!scheduler; + has $!buf; + has $!close-promise; + + method new(Mu :$VMIO!, :$scheduler!, :$buf!, :$close-promise!) { + self.CREATE!SET-SELF($VMIO, $scheduler, $buf, $close-promise) + } + + method !SET-SELF(Mu $!VMIO, $!scheduler, $!buf, $!close-promise) { self } + + method tap(&emit, &done, &quit, &tap) { + my $buffer := nqp::list(); + my int $buffer-start-seq = 0; + my int $done-target = -1; + my int $finished = 0; + + sub emit-events() { + until nqp::elems($buffer) == 0 || nqp::isnull(nqp::atpos($buffer, 0)) { + emit(nqp::shift($buffer)); + $buffer-start-seq = $buffer-start-seq + 1; + } + if $buffer-start-seq == $done-target { + done(); + $finished = 1; + } + } + + my $lock = Lock::Async.new; + my $tap; + $lock.protect: { + my $cancellation := nqp::asyncreadbytes(nqp::decont($!VMIO), + $!scheduler.queue(:hint-affinity), + -> Mu \seq, Mu \data, Mu \err { + $lock.protect: { + unless $finished { + if err { + quit(err); + $finished = 1; + } + elsif nqp::isconcrete(data) { + my int $insert-pos = seq - $buffer-start-seq; + nqp::bindpos($buffer, $insert-pos, data); + emit-events(); + } + else { + $done-target = seq; + emit-events(); + } + } + } + }, + nqp::decont($!buf), ReaderCancellation); + $tap := Tap.new({ nqp::cancel($cancellation) }); + tap($tap); + } + $!close-promise.then: { + $lock.protect: { + unless $finished { + done(); + $finished = 1; + } + } + } + + $tap + } + + method live(--> False) { } + method sane(--> True) { } + method serial(--> True) { } + } + my constant ADD_WHENEVER_PROMPT = Mu.new; class CachedAwaitHandle does Awaitable { From 40c2d0cd52ba698b9f5db48ae2c796e90d3d57d3 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Fri, 22 Sep 2017 17:33:45 +0200 Subject: [PATCH 143/692] Move socket reader tappable into socket class The initial idea was to share it with Proc::Async, but it turns out they're just different enough it's probably not worth it. --- src/core/IO/Socket/Async.pm | 76 ++++++++++++++++++++++++++++++++++++- src/core/Supply.pm | 76 ------------------------------------- 2 files changed, 75 insertions(+), 77 deletions(-) diff --git a/src/core/IO/Socket/Async.pm b/src/core/IO/Socket/Async.pm index 20e237e00d3..5fd4fb63f81 100644 --- a/src/core/IO/Socket/Async.pm +++ b/src/core/IO/Socket/Async.pm @@ -42,9 +42,83 @@ my class IO::Socket::Async { $p } + my class SocketReaderTappable does Tappable { + has $!VMIO; + has $!scheduler; + has $!buf; + has $!close-promise; + + method new(Mu :$VMIO!, :$scheduler!, :$buf!, :$close-promise!) { + self.CREATE!SET-SELF($VMIO, $scheduler, $buf, $close-promise) + } + + method !SET-SELF(Mu $!VMIO, $!scheduler, $!buf, $!close-promise) { self } + + method tap(&emit, &done, &quit, &tap) { + my $buffer := nqp::list(); + my int $buffer-start-seq = 0; + my int $done-target = -1; + my int $finished = 0; + + sub emit-events() { + until nqp::elems($buffer) == 0 || nqp::isnull(nqp::atpos($buffer, 0)) { + emit(nqp::shift($buffer)); + $buffer-start-seq = $buffer-start-seq + 1; + } + if $buffer-start-seq == $done-target { + done(); + $finished = 1; + } + } + + my $lock = Lock::Async.new; + my $tap; + $lock.protect: { + my $cancellation := nqp::asyncreadbytes(nqp::decont($!VMIO), + $!scheduler.queue(:hint-affinity), + -> Mu \seq, Mu \data, Mu \err { + $lock.protect: { + unless $finished { + if err { + quit(err); + $finished = 1; + } + elsif nqp::isconcrete(data) { + my int $insert-pos = seq - $buffer-start-seq; + nqp::bindpos($buffer, $insert-pos, data); + emit-events(); + } + else { + $done-target = seq; + emit-events(); + } + } + } + }, + nqp::decont($!buf), SocketCancellation); + $tap := Tap.new({ nqp::cancel($cancellation) }); + tap($tap); + } + $!close-promise.then: { + $lock.protect: { + unless $finished { + done(); + $finished = 1; + } + } + } + + $tap + } + + method live(--> False) { } + method sane(--> True) { } + method serial(--> True) { } + } + multi method Supply(IO::Socket::Async:D: :$bin, :$buf = buf8.new, :$enc, :$scheduler = $*SCHEDULER) { if $bin { - Supply.new: Rakudo::Internals::IOReaderTappable.new: + Supply.new: SocketReaderTappable.new: :$!VMIO, :$scheduler, :$buf, :$!close-promise } else { diff --git a/src/core/Supply.pm b/src/core/Supply.pm index 1e4c4b8ebe4..0f5baf74ae1 100644 --- a/src/core/Supply.pm +++ b/src/core/Supply.pm @@ -1728,82 +1728,6 @@ my class Supplier::Preserving is Supplier { } augment class Rakudo::Internals { - class IOReaderTappable does Tappable { - my class ReaderCancellation is repr('AsyncTask') { } - - has $!VMIO; - has $!scheduler; - has $!buf; - has $!close-promise; - - method new(Mu :$VMIO!, :$scheduler!, :$buf!, :$close-promise!) { - self.CREATE!SET-SELF($VMIO, $scheduler, $buf, $close-promise) - } - - method !SET-SELF(Mu $!VMIO, $!scheduler, $!buf, $!close-promise) { self } - - method tap(&emit, &done, &quit, &tap) { - my $buffer := nqp::list(); - my int $buffer-start-seq = 0; - my int $done-target = -1; - my int $finished = 0; - - sub emit-events() { - until nqp::elems($buffer) == 0 || nqp::isnull(nqp::atpos($buffer, 0)) { - emit(nqp::shift($buffer)); - $buffer-start-seq = $buffer-start-seq + 1; - } - if $buffer-start-seq == $done-target { - done(); - $finished = 1; - } - } - - my $lock = Lock::Async.new; - my $tap; - $lock.protect: { - my $cancellation := nqp::asyncreadbytes(nqp::decont($!VMIO), - $!scheduler.queue(:hint-affinity), - -> Mu \seq, Mu \data, Mu \err { - $lock.protect: { - unless $finished { - if err { - quit(err); - $finished = 1; - } - elsif nqp::isconcrete(data) { - my int $insert-pos = seq - $buffer-start-seq; - nqp::bindpos($buffer, $insert-pos, data); - emit-events(); - } - else { - $done-target = seq; - emit-events(); - } - } - } - }, - nqp::decont($!buf), ReaderCancellation); - $tap := Tap.new({ nqp::cancel($cancellation) }); - tap($tap); - } - $!close-promise.then: { - $lock.protect: { - unless $finished { - done(); - $finished = 1; - } - } - } - - $tap - } - - method live(--> False) { } - method sane(--> True) { } - method serial(--> True) { } - } - my constant ADD_WHENEVER_PROMPT = Mu.new; class CachedAwaitHandle does Awaitable { From c46de00f0b090588a3e7ec3463e702f230c5ed2f Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Fri, 22 Sep 2017 17:34:31 +0200 Subject: [PATCH 144/692] Optimize IO::Socket::Async.listen Supply Again, by avoiding Supply.on-demand and its various protections. Gives a performance boost to async socket servers; in Cro it amounts to ~4% more requests per second. --- src/core/IO/Socket/Async.pm | 111 +++++++++++++++++++++++++----------- 1 file changed, 77 insertions(+), 34 deletions(-) diff --git a/src/core/IO/Socket/Async.pm b/src/core/IO/Socket/Async.pm index 5fd4fb63f81..b93b9257475 100644 --- a/src/core/IO/Socket/Async.pm +++ b/src/core/IO/Socket/Async.pm @@ -171,43 +171,86 @@ my class IO::Socket::Async { $p } - method listen(IO::Socket::Async:U: Str() $host, Int() $port, Int() $backlog = 128, - :$enc = 'utf-8', :$scheduler = $*SCHEDULER) { - my $cancellation; - my $encoding = Encoding::Registry.find($enc); - Supply.on-demand(-> $s { - $cancellation := nqp::asynclisten( - $scheduler.queue(:hint-affinity), - -> Mu \socket, Mu \err, Mu \peer-host, Mu \peer-port, Mu \socket-host, Mu \socket-port { - if err { - $s.quit(err); - } - else { - my $client_socket := nqp::create(self); - nqp::bindattr($client_socket, IO::Socket::Async, '$!VMIO', socket); - nqp::bindattr($client_socket, IO::Socket::Async, '$!enc', - $encoding.name); - nqp::bindattr($client_socket, IO::Socket::Async, '$!encoder', - $encoding.encoder()); - nqp::bindattr($client_socket, IO::Socket::Async, '$!peer-host', peer-host); - nqp::bindattr($client_socket, IO::Socket::Async, '$!peer-port', peer-port); - nqp::bindattr($client_socket, IO::Socket::Async, '$!socket-host', socket-host); - nqp::bindattr($client_socket, IO::Socket::Async, '$!socket-port', socket-port); + my class SocketListenerTappable does Tappable { + has $!host; + has $!port; + has $!backlog; + has $!encoding; + has $!scheduler; - setup-close($client_socket); - $s.emit($client_socket); + method new(:$host!, :$port!, :$backlog!, :$encoding!, :$scheduler!) { + self.CREATE!SET-SELF($host, $port, $backlog, $encoding, $scheduler) + } + + method !SET-SELF($!host, $!port, $!backlog, $!encoding, $!scheduler) { self } + + method tap(&emit, &done, &quit, &tap) { + my $lock := Lock::Async.new; + my $tap; + my int $finished = 0; + $lock.protect: { + my $cancellation := nqp::asynclisten( + $!scheduler.queue(:hint-affinity), + -> Mu \socket, Mu \err, Mu \peer-host, Mu \peer-port, + Mu \socket-host, Mu \socket-port { + $lock.protect: { + if $finished { + # do nothing + } + elsif err { + say "here with error"; + quit(X::AdHoc.new(message => err)); + $finished = 1; + } + else { + my $client_socket := nqp::create(IO::Socket::Async); + nqp::bindattr($client_socket, IO::Socket::Async, + '$!VMIO', socket); + nqp::bindattr($client_socket, IO::Socket::Async, + '$!enc', $!encoding.name); + nqp::bindattr($client_socket, IO::Socket::Async, + '$!encoder', $!encoding.encoder()); + nqp::bindattr($client_socket, IO::Socket::Async, + '$!peer-host', peer-host); + nqp::bindattr($client_socket, IO::Socket::Async, + '$!peer-port', peer-port); + nqp::bindattr($client_socket, IO::Socket::Async, + '$!socket-host', socket-host); + nqp::bindattr($client_socket, IO::Socket::Async, + '$!socket-port', socket-port); + setup-close($client_socket); + emit($client_socket); + } + } + }, + $!host, $!port, $!backlog, SocketCancellation); + $tap = Tap.new: { + my $p = Promise.new; + my $v = $p.vow; + nqp::cancelnotify($cancellation, $!scheduler.queue, { $v.keep(True); }); + $p + } + tap($tap); + CATCH { + default { + tap($tap = Tap.new({ Nil })) unless $tap; + quit($_); } - }, - $host, $port, $backlog, SocketCancellation); - }, - closing => { - if $cancellation { - my $p = Promise.new; - my $v = $p.vow; - nqp::cancelnotify($cancellation, $scheduler.queue, { $v.keep(True); }); - $p + } } - }); + $tap + } + + method live(--> False) { } + method sane(--> True) { } + method serial(--> True) { } + } + + method listen(IO::Socket::Async:U: Str() $host, Int() $port, Int() $backlog = 128, + :$enc = 'utf-8', :$scheduler = $*SCHEDULER) { + my $encoding = Encoding::Registry.find($enc); + Supply.new: SocketListenerTappable.new: + :$host, :$port, :$backlog, :$encoding, :$scheduler } sub setup-close(\socket --> Nil) { From 17aead2759cf95ee95a24ea6a64c0a5b901428b0 Mon Sep 17 00:00:00 2001 From: usev6 Date: Fri, 22 Sep 2017 22:32:37 +0200 Subject: [PATCH 145/692] [jvm] Update requirement for jdk 1.8 It's no longer possible to build NPQ with JDK 1.7, since nqp::codes requires Java8 (cmp. nqp commits de18e88970 and 8d8bb5d3bc). --- INSTALL.txt | 2 +- README.md | 2 +- tools/build/Makefile-JVM.in | 2 +- tools/build/create-jvm-runner.pl | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/INSTALL.txt b/INSTALL.txt index 4cbc851ed02..88d610a4925 100644 --- a/INSTALL.txt +++ b/INSTALL.txt @@ -33,7 +33,7 @@ $ perl Configure.pl --gen-moar --gen-nqp --backends=moar # Moar only or: - $ perl Configure.pl --gen-nqp --backends=jvm # needs JDK 1.7 installed + $ perl Configure.pl --gen-nqp --backends=jvm # needs JDK 1.8 installed then: $ make diff --git a/README.md b/README.md index 9dd4dc584f3..bf235ac1afc 100644 --- a/README.md +++ b/README.md @@ -52,7 +52,7 @@ https://github.com/MoarVM/MoarVM manually and install them individually. ### Configuring Rakudo to run on the JVM -Note that to run Rakudo on JVM, JDK 1.7 must be installed. To automatically +Note that to run Rakudo on JVM, JDK 1.8 must be installed. To automatically download, build, and install a fresh NQP, run: perl Configure.pl --gen-nqp --backends=jvm diff --git a/tools/build/Makefile-JVM.in b/tools/build/Makefile-JVM.in index 86a0f2781fa..9058451d0a3 100644 --- a/tools/build/Makefile-JVM.in +++ b/tools/build/Makefile-JVM.in @@ -87,7 +87,7 @@ j-all: $(PERL6_JAR) $(SETTING_JAR) $(SETTING_D_JAR) $(J_RUNNER) eval-client.pl $(RUNTIME_JAR): $(RUNTIME_JAVAS) $(MKPATH) bin - $(JAVAC) -source 1.7 -cp $(BLD_NQP_JARS) -g -d bin -encoding UTF8 $(RUNTIME_JAVAS) + $(JAVAC) -source 1.8 -cp $(BLD_NQP_JARS) -g -d bin -encoding UTF8 $(RUNTIME_JAVAS) $(JAR) cf0 rakudo-runtime.jar -C bin/ . $(PERL6_ML_JAR): src/Perl6/ModuleLoader.nqp src/vm/jvm/ModuleLoaderVMConfig.nqp src/vm/jvm/Perl6/JavaModuleLoader.nqp diff --git a/tools/build/create-jvm-runner.pl b/tools/build/create-jvm-runner.pl index 02c7c44d3de..156e031ce53 100644 --- a/tools/build/create-jvm-runner.pl +++ b/tools/build/create-jvm-runner.pl @@ -77,5 +77,5 @@ sub install { else { install "perl6-j", "java $jopts perl6 $blib"; install "perl6-jdb-server", "java $jdbopts $jopts perl6 $blib"; - install "perl6-eval-server", "java -Xmx3000m -XX:MaxPermSize=200m $jopts org.perl6.nqp.tools.EvalServer"; + install "perl6-eval-server", "java -Xmx3000m $jopts org.perl6.nqp.tools.EvalServer"; } From ffd17990d0136f72e0b57b3178762964c1491351 Mon Sep 17 00:00:00 2001 From: Nick Logan Date: Fri, 22 Sep 2017 17:11:58 -0400 Subject: [PATCH 146/692] [jvm] Update requirement for jdk 1.8 See: https://github.com/rakudo/rakudo/commit/17aead2759cf95ee95a24ea6a64c0a5b901428b0 --- .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index 82d5bad4c37..3a2210871af 100644 --- a/.travis.yml +++ b/.travis.yml @@ -19,7 +19,7 @@ addons: packages: # install toolchains - gcc-6 - - openjdk-7-jdk + - openjdk-8-jdk script: - perl Configure.pl $RAKUDO_OPTIONS --moar-option=--cc=$(command -v gcc-6 >/dev/null 2>&1; if [ $? -eq 1 ]; then printf "gcc"; else printf "gcc-6"; fi) From 7af339b91d2a56a4a4eb065952cd548c188bd124 Mon Sep 17 00:00:00 2001 From: Nick Logan Date: Fri, 22 Sep 2017 19:49:38 -0400 Subject: [PATCH 147/692] Use proper java 8 jdk package --- .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index 3a2210871af..5c8bf0514bc 100644 --- a/.travis.yml +++ b/.travis.yml @@ -19,7 +19,7 @@ addons: packages: # install toolchains - gcc-6 - - openjdk-8-jdk + - oracle-java8-installer script: - perl Configure.pl $RAKUDO_OPTIONS --moar-option=--cc=$(command -v gcc-6 >/dev/null 2>&1; if [ $? -eq 1 ]; then printf "gcc"; else printf "gcc-6"; fi) From 91cefc1a78dc52f1229825bc5228b5fb89b104c1 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Sat, 23 Sep 2017 14:39:03 +0200 Subject: [PATCH 148/692] Remove debugging leftover --- src/core/IO/Socket/Async.pm | 1 - 1 file changed, 1 deletion(-) diff --git a/src/core/IO/Socket/Async.pm b/src/core/IO/Socket/Async.pm index b93b9257475..3c4128d6d4c 100644 --- a/src/core/IO/Socket/Async.pm +++ b/src/core/IO/Socket/Async.pm @@ -198,7 +198,6 @@ my class IO::Socket::Async { # do nothing } elsif err { - say "here with error"; quit(X::AdHoc.new(message => err)); $finished = 1; } From cf95ce81c4f606c5c48bd22156de30a7d0f83a4c Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 23 Sep 2017 08:40:28 -0400 Subject: [PATCH 149/692] Slightly improve Cool.subst-mutate error MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit …when called on non-writable invocants. Use param name more suitable to the context where the error occurs. - Str.subst-mutate doesn't need similar treatment, as those methods are multies and we just get an X::Multi::NoMatch from them. --- src/core/Cool.pm | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/src/core/Cool.pm b/src/core/Cool.pm index 5046a1b0f55..87bfd876bc2 100644 --- a/src/core/Cool.pm +++ b/src/core/Cool.pm @@ -174,11 +174,13 @@ my class Cool { # declared in BOOTSTRAP self.Stringy.subst(|c); } - method subst-mutate(Cool:D $self is rw: |c) { + # `$value-to-subst-mutate` will show up in errors when called on non-rw + # container, so use more descriptive name instead of just `$self` + method subst-mutate(Cool:D $value-to-subst-mutate is rw: |c) { $/ := nqp::getlexcaller('$/'); - my $str = $self.Str; + my $str = $value-to-subst-mutate.Str; my $match = $str.subst-mutate(|c); - $self = $str; + $value-to-subst-mutate = $str; $match } From 21f05e3f1e6e5f7e72861e719022fa70ef9f9987 Mon Sep 17 00:00:00 2001 From: Nick Logan Date: Sat, 23 Sep 2017 11:08:46 -0400 Subject: [PATCH 150/692] Remove unused attributes --- src/core/Proc/Async.pm | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/core/Proc/Async.pm b/src/core/Proc/Async.pm index 9453e21bada..22518c66829 100644 --- a/src/core/Proc/Async.pm +++ b/src/core/Proc/Async.pm @@ -109,8 +109,6 @@ my class Proc::Async { has CharsOrBytes $!stderr_type; has $!merge_supply; has CharsOrBytes $!merge_type; - has $!stdout_fd_promise; - has $!stderr_fd_promise; has $!stdin-fd; has $!stdout-fd; has $!stderr-fd; From 0b15f6728a4aff6945c1f170c10321c002697a08 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 23 Sep 2017 11:43:28 -0400 Subject: [PATCH 151/692] Implement $*USAGE - Provides default USAGE message the program would generate - Available as dynvar $*USAGE inside MAIN and USAGE subs; USAGE sub can use it as a base to generate custom usage, for example. - Speculation describes $?USAGE, but we renamed[^1] it since at compile time we don't know if we'll ever need it - Die if user attempts to assign into it [1] https://irclog.perlgeek.de/perl6-dev/2017-09-23#i_15206569 --- src/core/Main.pm | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/core/Main.pm b/src/core/Main.pm index 134c12f8bbe..aa6afd5d7a6 100644 --- a/src/core/Main.pm +++ b/src/core/Main.pm @@ -1,7 +1,4 @@ # TODO: -# * $?USAGE -# * Create $?USAGE at compile time -# * Make $?USAGE available globally # * Command-line parsing # * Allow both = and space before argument of double-dash args # * Comma-separated list values @@ -185,9 +182,12 @@ my sub MAIN_HELPER($retval = 0) { # Generate default $?USAGE message my $usage; - my $?USAGE := Proxy.new( + my $*USAGE := Proxy.new( FETCH => -> | { $usage || ($usage = gen-usage()) }, - STORE => -> | { } + STORE => -> | { + die 'Cannot assign to $*USAGE. Please use `sub USAGE {}` to ' + ~ 'output custom usage message' + } ); # Get a list of candidates that match according to the dispatcher @@ -211,11 +211,11 @@ my sub MAIN_HELPER($retval = 0) { # We could not find a user defined USAGE sub! # Let's display the default USAGE message if $n { - $*OUT.say($?USAGE); + $*OUT.say($*USAGE); exit 0; } else { - $*ERR.say($?USAGE); + $*ERR.say($*USAGE); exit 2; } } From ebd6440c27ea07e2bfde4809fa4e97dac1491e69 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sun, 24 Sep 2017 13:31:28 +0200 Subject: [PATCH 152/692] Make task[2] always contain the full attribute name To make the first 3 values of the task in the BUILDALLPLAN always the same: 0 = type of action, 1 = object type, 2 = full attribute name. This makes refactoring the BUILDPLAN logic easier. --- src/Perl6/Metamodel/BUILDPLAN.nqp | 4 ++-- src/core/Mu.pm | 40 +++++++++++++++---------------- 2 files changed, 22 insertions(+), 22 deletions(-) diff --git a/src/Perl6/Metamodel/BUILDPLAN.nqp b/src/Perl6/Metamodel/BUILDPLAN.nqp index a77bfe16534..f7d16b7599c 100644 --- a/src/Perl6/Metamodel/BUILDPLAN.nqp +++ b/src/Perl6/Metamodel/BUILDPLAN.nqp @@ -58,8 +58,8 @@ role Perl6::Metamodel::BUILDPLAN { nqp::push(@plan,[ nqp::add_i(0,nqp::objprimspec($_.type)), $obj, - nqp::substr((my $attr_name := $_.name), 2), - $attr_name + $_.name, + nqp::substr($_.name, 2) ]); } } diff --git a/src/core/Mu.pm b/src/core/Mu.pm index 888bbc83346..b82400ec093 100644 --- a/src/core/Mu.pm +++ b/src/core/Mu.pm @@ -174,25 +174,25 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" nqp::if( # >0 nqp::isle_i($code,3), nqp::if( # 1|2|3 - nqp::existskey($init,nqp::atpos($task,2)), + nqp::existskey($init,nqp::atpos($task,3)), nqp::if( # can initialize nqp::iseq_i($code,1), nqp::bindattr_i(self, # 1 nqp::atpos($task,1), - nqp::atpos($task,3), - nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,2))) + nqp::atpos($task,2), + nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,3))) ), nqp::if( nqp::iseq_i($code,2), nqp::bindattr_n(self, # 2 nqp::atpos($task,1), - nqp::atpos($task,3), - nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,2))) + nqp::atpos($task,2), + nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,3))) ), nqp::bindattr_s(self, # 3 nqp::atpos($task,1), - nqp::atpos($task,3), - nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,2))) + nqp::atpos($task,2), + nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,3))) ) ) ) @@ -280,9 +280,9 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" ))))))), nqp::if( # 0 - nqp::existskey($init,nqp::atpos($task,2)), - (nqp::getattr(self,nqp::atpos($task,1),nqp::atpos($task,3)) - = %attrinit.AT-KEY(nqp::atpos($task,2))), + nqp::existskey($init,nqp::atpos($task,3)), + (nqp::getattr(self,nqp::atpos($task,1),nqp::atpos($task,2)) + = %attrinit.AT-KEY(nqp::atpos($task,3))), ) ) ) @@ -320,25 +320,25 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" nqp::if( # >0 nqp::isle_i($code,3), nqp::if( # 1|2|3 - nqp::existskey($init,nqp::atpos($task,2)), + nqp::existskey($init,nqp::atpos($task,3)), nqp::if( # can initialize nqp::iseq_i($code,1), nqp::bindattr_i(self, # 1 nqp::atpos($task,1), - nqp::atpos($task,3), - nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,2))) + nqp::atpos($task,2), + nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,3))) ), nqp::if( nqp::iseq_i($code,2), nqp::bindattr_n(self, # 2 nqp::atpos($task,1), - nqp::atpos($task,3), - nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,2))) + nqp::atpos($task,2), + nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,3))) ), nqp::bindattr_s(self, # 3 nqp::atpos($task,1), - nqp::atpos($task,3), - nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,2))) + nqp::atpos($task,2), + nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,3))) ) ) ) @@ -451,9 +451,9 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" )))))))), nqp::if( # 0 - nqp::existskey($init,nqp::atpos($task,2)), - (nqp::getattr(self,nqp::atpos($task,1),nqp::atpos($task,3)) - = %attrinit.AT-KEY(nqp::atpos($task,2))), + nqp::existskey($init,nqp::atpos($task,3)), + (nqp::getattr(self,nqp::atpos($task,1),nqp::atpos($task,2)) + = %attrinit.AT-KEY(nqp::atpos($task,3))), ) ) ) From 3f0f32146941b7d8d4b5e97ed2d5f245904a4ac6 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Mon, 25 Sep 2017 09:44:18 +0000 Subject: [PATCH 153/692] Remove trailing whitespace --- src/core/Exception.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/Exception.pm b/src/core/Exception.pm index 599f2d10867..059f481f99b 100644 --- a/src/core/Exception.pm +++ b/src/core/Exception.pm @@ -164,7 +164,7 @@ my class X::Method::NotFound is Exception { when Cool { %suggestions{$_} = 0 for ; } default { %suggestions{$_} = 0 for ; } } - + } elsif $.method eq 'bytes' { %suggestions = 0; @@ -2215,7 +2215,7 @@ my class X::Assignment::RO is Exception { method message { "Cannot modify an immutable {$.value.^name} ({$.value.gist})" } - method typename { $.value.^name } + method typename { $.value.^name } } my class X::Assignment::RO::Comp does X::Comp { From 6bdb2dd368b356a728a74d653ea6e2618c3b1a67 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Mon, 25 Sep 2017 10:17:02 +0000 Subject: [PATCH 154/692] Rename $*INITTIME to $*INIT-INSTANT - $*INITTIME was never specced - Use kebob-case as all of our other multi-word dynamics use - Encode the value type in the name Part of 6.d-prep featurelist: https://github.com/perl6/6.d-prep/blob/master/TODO/FEATURES.md --- src/core/Exception.pm | 2 +- src/core/Instant.pm | 10 ++++++++-- t/spectest.data | 1 + 3 files changed, 10 insertions(+), 3 deletions(-) diff --git a/src/core/Exception.pm b/src/core/Exception.pm index 059f481f99b..2d30a50c38b 100644 --- a/src/core/Exception.pm +++ b/src/core/Exception.pm @@ -1554,7 +1554,7 @@ my class X::Syntax::Perl5Var does X::Syntax { '$^O' => 'VM.osname', '$^R' => 'an explicit result variable', '$^S' => 'context function', - '$^T' => '$*INITTIME', + '$^T' => '$*INIT-INSTANT', '$^V' => '$*PERL.version or $*PERL.compiler.version', '$^W' => '$*WARNING', '$^X' => '$*EXECUTABLE-NAME', diff --git a/src/core/Instant.pm b/src/core/Instant.pm index 64e4029df96..682183e4019 100644 --- a/src/core/Instant.pm +++ b/src/core/Instant.pm @@ -117,10 +117,16 @@ sub term:() { ) } -Rakudo::Internals.REGISTER-DYNAMIC: '$*INITTIME', { - PROCESS::<$INITTIME> := nqp::create(Instant).SET-SELF( +Rakudo::Internals.REGISTER-DYNAMIC: '$*INIT-INSTANT', { + PROCESS::<$INIT-INSTANT> := nqp::create(Instant).SET-SELF( Rakudo::Internals.tai-from-posix(Rakudo::Internals.INITTIME,0).Rat ) } +Rakudo::Internals.REGISTER-DYNAMIC: '$*INITTIME', { + my ($file, $line) = .file, .line with callframe 3; + DEPRECATED('$*INIT-INSTANT', '2017.09.84.gb.02.da.4.d.1.a', '2017.08', + :what<$*INITTIME>, :$file, :$line); + $*INIT-INSTANT +} # vim: ft=perl6 expandtab sw=4 diff --git a/t/spectest.data b/t/spectest.data index fbfdb9ad62e..87dc69cb319 100644 --- a/t/spectest.data +++ b/t/spectest.data @@ -938,6 +938,7 @@ S26-documentation/why-both.t S26-documentation/why-trailing.t S26-documentation/why-leading.t S28-named-variables/cwd.t +S28-named-variables/init-instant.t S28-named-variables/slangs.t # moar S29-any/cmp.t S29-any/deg-trans.t From 1af2a745fcd551daaeb046fadd5f8626389ecf05 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Mon, 25 Sep 2017 18:06:42 +0000 Subject: [PATCH 155/692] Revert "Temporary fix for RT #131626" MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This reverts commit a13bad95b2e1ad48a1d1a023e84912b1b5950faa. The commit breaks Version ≥ Version, Date ≥ Date, and possibly more. I looked at trying to plug up those candidates in a similar fashion, but seems quite messy and doesn't guarantee total fix. For something that's meant to be just temporary, feels like overkill. --- src/core/Numeric.pm | 50 ++++++++++++++++++++------------------------- 1 file changed, 22 insertions(+), 28 deletions(-) diff --git a/src/core/Numeric.pm b/src/core/Numeric.pm index 140a077002e..b0e2233c734 100644 --- a/src/core/Numeric.pm +++ b/src/core/Numeric.pm @@ -286,34 +286,28 @@ multi sub infix:<≅>(\a, \b, :$tolerance = $*TOLERANCE) { } sub infix:<=~=>(|c) { infix:<≅>(|c) } -proto sub infix:(Mu $?, Mu $?) is pure { * } -multi sub infix:($? --> True) { } -multi sub infix:(Mu \a, Mu \b) { not a == b } -proto sub infix:<≠>(Mu $?, Mu $?) is pure { * } # should be alias, RT 131626 -multi sub infix:<≠>($? --> True) { } -multi sub infix:<≠>(Mu \a, Mu \b) { not a == b } - -proto sub infix:«<»(Mu $?, Mu $?) is pure { * } -multi sub infix:«<»($? --> True) { } -multi sub infix:«<»(\a, \b) { a.Real < b.Real } - -proto sub infix:«<=»(Mu $?, Mu $?) is pure { * } -multi sub infix:«<=»($? --> True) { } -multi sub infix:«<=»(\a, \b) { a.Real <= b.Real } -proto sub infix:«≤»(Mu $?, Mu $?) is pure { * } # should be alias, RT 131626 -multi sub infix:«≤»($? --> True) { } -multi sub infix:«≤»(\a, \b) { a.Real <= b.Real } - -proto sub infix:«>»(Mu $?, Mu $?) is pure { * } -multi sub infix:«>»($? --> True) { } -multi sub infix:«>»(\a, \b) { a.Real > b.Real } - -proto sub infix:«>=»(Mu $?, Mu $?) is pure { * } -multi sub infix:«>=»($? --> True) { } -multi sub infix:«>=»(\a, \b) { a.Real >= b.Real } -proto sub infix:«≥»(Mu $?, Mu $?) is pure { * } # should be alias, RT 131626 -multi sub infix:«≥»($? --> True) { } -multi sub infix:«≥»(\a, \b) { a.Real >= b.Real } +proto sub infix:(Mu $?, Mu $?) is pure { * } +multi sub infix:($?) { Bool::True } +multi sub infix:(Mu \a, Mu \b) { not a == b } +sub infix:<≠>(|c) is pure { infix:(|c) } + +proto sub infix:«<»(Mu $?, Mu $?) is pure { * } +multi sub infix:«<»($?) { Bool::True } +multi sub infix:«<»(\a, \b) { a.Real < b.Real } + +proto sub infix:«<=»(Mu $?, Mu $?) is pure { * } +multi sub infix:«<=»($?) { Bool::True } +multi sub infix:«<=»(\a, \b) { a.Real <= b.Real } +sub infix:«≤»(|c) is pure { infix:«<=»(|c) } + +proto sub infix:«>»(Mu $?, Mu $?) is pure { * } +multi sub infix:«>»($?) { Bool::True } +multi sub infix:«>»(\a, \b) { a.Real > b.Real } + +proto sub infix:«>=»(Mu $?, Mu $?) is pure { * } +multi sub infix:«>=»($?) { Bool::True } +multi sub infix:«>=»(\a, \b) { a.Real >= b.Real } +sub infix:«≥»(|c) is pure { infix:«>=»(|c) } ## bitwise operators From 8be3eb8ec89e355785262e947bdbfc74840b142a Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Mon, 25 Sep 2017 21:36:53 -0400 Subject: [PATCH 156/692] Remove trailing whitespace --- src/Perl6/Optimizer.nqp | 54 ++++++++++++++++++++--------------------- 1 file changed, 27 insertions(+), 27 deletions(-) diff --git a/src/Perl6/Optimizer.nqp b/src/Perl6/Optimizer.nqp index 0800e59e3a7..1b035b9656f 100644 --- a/src/Perl6/Optimizer.nqp +++ b/src/Perl6/Optimizer.nqp @@ -92,7 +92,7 @@ my class Symbols { $!fake_top_routine := NQPMu; $result; } - + # Accessors for interesting symbols/scopes. method GLOBALish() { $!GLOBALish } method UNIT() { $!UNIT } @@ -702,7 +702,7 @@ my class JunctionOptimizer { $!optimizer := $optimizer; $!symbols := $symbols; } - + # Check if the junction is in a context where we can optimize. method is_outer_foldable($op) { if $op.op eq "call" { @@ -923,13 +923,13 @@ class Perl6::Optimizer { $past } - + # Called when we encounter a block in the tree. method visit_block($block) { # Push block onto block stack and create vars tracking. $!symbols.push_block($block); @!block_var_stack.push(BlockVarOptimizer.new); - + # Visit children. if $block.ann('DYNAMICALLY_COMPILED') { my $*DYNAMICALLY_COMPILED := 1; @@ -938,7 +938,7 @@ class Perl6::Optimizer { else { self.visit_children($block, :resultchild(+@($block) - 1),:void_default); } - + # Pop block from block stack and get computed block var info. $!symbols.pop_block(); my $vars_info := @!block_var_stack.pop(); @@ -980,7 +980,7 @@ class Perl6::Optimizer { } } } - + # If we have no interesting ones, then we can inline the # statements. if +@sigsyms == 0 { @@ -1015,7 +1015,7 @@ class Perl6::Optimizer { $op } } - + # Range operators we can optimize into loops, and how to do it. sub get_bound($node) { if nqp::istype($node, QAST::Want) && $node[1] eq 'Ii' { @@ -1339,20 +1339,20 @@ class Perl6::Optimizer { my $opt_result := self.optimize_nameless_call($op); return $opt_result if $opt_result; } - + # If it's a private method call, we can sometimes resolve it at # compile time. If so, we can reduce it to a sub call in some cases. elsif $!level >= 2 && $optype eq 'callmethod' && $op.name eq 'dispatch:' { self.optimize_private_method_call($op); } - + # If we end up here, just leave op as is. if $op.op eq 'chain' { $!chain_depth := $!chain_depth - 1; } $op } - + method visit_op_children($op) { my int $orig_void := $!void_context; $!void_context := $op.op eq 'callmethod' && $op.name eq 'sink'; @@ -1725,7 +1725,7 @@ class Perl6::Optimizer { } } else { - $!problems.add_exception(['X', 'Method', 'NotFound'], $op, + $!problems.add_exception(['X', 'Method', 'NotFound'], $op, :private(nqp::p6bool(1)), :method($name), :typename($pkg.HOW.name($pkg)), :invocant($pkg)); } @@ -1790,7 +1790,7 @@ class Perl6::Optimizer { $!void_context := $orig_void; $op } - + # Handles visiting a QAST::Want node. method visit_want($want) { note("method visit_want $!void_context\n" ~ $want.dump) if $!debug; @@ -1841,7 +1841,7 @@ class Perl6::Optimizer { $want; } - + # Handles visit a variable node. method visit_var($var) { # Track usage. @@ -1889,7 +1889,7 @@ class Perl6::Optimizer { $var; } - + # Checks arguments to see if we're going to be able to do compile # time analysis of the call. my @allo_map := ['', 'Ii', 'Nn', 'Ss']; @@ -1902,7 +1902,7 @@ class Perl6::Optimizer { my @allomorphs; my int $num_prim := 0; my int $num_allo := 0; - + # Initial analysis. for @($op) { if !nqp::can($_,'flat') { @@ -1913,7 +1913,7 @@ class Perl6::Optimizer { if $_.flat || $_.named ne '' { return []; } - + # See if we know the node's type; if so, check it. my $type := $_.returns(); if $type =:= NQPMu { @@ -1947,7 +1947,7 @@ class Perl6::Optimizer { return []; } } - + # See if we have an allomorphic constant that may allow us to do # a native dispatch with it; takes at least one declaratively # native argument to make this happen. @@ -1958,14 +1958,14 @@ class Perl6::Optimizer { @flags[$allo_idx] := $prim_flag +| $ARG_IS_LITERAL; } } - + # Alternatively, a single arg that is allomorphic will prefer # the literal too. if @types == 1 && $num_allo == 1 { my $rev := %allo_rev{@allomorphs[0]}; @flags[0] := nqp::defined($rev) ?? $rev +| $ARG_IS_LITERAL !! 0; } - + [@types, @flags] } @@ -1991,7 +1991,7 @@ class Perl6::Optimizer { $!problems.add_exception(['X', 'TypeCheck', 'Argument'], $op, |%opts); } - + # Signature list for multis. sub multi_sig_list($dispatcher) { my @sigs := []; @@ -2000,7 +2000,7 @@ class Perl6::Optimizer { } @sigs } - + # Visits all of a nodes children, and dispatches appropriately. method visit_children($node, :$skip_selectors, :$resultchild, :$first, :$void_default) { my int $r := $resultchild // -1; @@ -2113,7 +2113,7 @@ class Perl6::Optimizer { # Copy over interesting stuff in declaration section. for @($decls) { - if nqp::istype($_, QAST::Op) && ($_.op eq 'p6bindsig' || + if nqp::istype($_, QAST::Op) && ($_.op eq 'p6bindsig' || $_.op eq 'bind' && $_[0].name eq 'call_sig') { # Don't copy this binder call or setup. } @@ -2155,14 +2155,14 @@ class Perl6::Optimizer { return $stmts; } } - + # Inlines a call to a sub. method inline_call($call, $code_obj) { # If the code object is marked soft, can't inline it. if nqp::can($code_obj, 'soft') && $code_obj.soft { return $call; } - + # Bind the arguments to temporaries, if they are used more than once. my $inlined := QAST::Stmts.new(); my @subs; @@ -2184,7 +2184,7 @@ class Perl6::Optimizer { } $idx++; } - + # Now do the inlining. $inlined.push($code_obj.inline_info.substitute_inline_placeholders(@subs)); if $call.named -> $name { @@ -2201,7 +2201,7 @@ class Perl6::Optimizer { $inlined } - + # If we decide a dispatch at compile time, this emits the direct call. # Note that we do not do this on MoarVM, since it can actually make a # much better job of these than we are able to here and we don't have a @@ -2272,7 +2272,7 @@ class Perl6::Optimizer { } } } - + my @prim_spec_ops := ['', 'p6box_i', 'p6box_n', 'p6box_s']; my @prim_spec_flags := ['', 'Ii', 'Nn', 'Ss']; sub copy_returns($to, $from) { From 36f0ab4f0809f0c4a5373630dbbd9079419a39c2 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Tue, 26 Sep 2017 01:53:37 +0000 Subject: [PATCH 157/692] Simplify conditional No code behaviour change (other than removal of duplicated check) --- src/Perl6/Optimizer.nqp | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/src/Perl6/Optimizer.nqp b/src/Perl6/Optimizer.nqp index 1b035b9656f..4303d259e41 100644 --- a/src/Perl6/Optimizer.nqp +++ b/src/Perl6/Optimizer.nqp @@ -1332,11 +1332,10 @@ class Perl6::Optimizer { # Calls are especially interesting as we may wish to do some # kind of inlining. - elsif $optype eq 'call' && $op.name ne '' { - my $opt_result := self.optimize_call($op); - return $opt_result if $opt_result; - } elsif $optype eq 'call' && $op.name eq '' { - my $opt_result := self.optimize_nameless_call($op); + elsif $optype eq 'call' { + my $opt_result := $op.name eq '' + ?? self.optimize_nameless_call($op) + !! self.optimize_call($op); return $opt_result if $opt_result; } From b0af549dafe65c3c962a7c7621d81ba56e1f5140 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Tue, 26 Sep 2017 08:58:30 +0200 Subject: [PATCH 158/692] Remove trailing whitespace --- src/core/Baggy.pm | 6 +++--- src/core/Encoding/Builtin.pm | 2 +- src/core/Enumeration.pm | 2 +- src/core/Lock/Async.pm | 2 +- src/core/Rakudo/QuantHash.pm | 4 ++-- 5 files changed, 8 insertions(+), 8 deletions(-) diff --git a/src/core/Baggy.pm b/src/core/Baggy.pm index ef6f04e567c..dc37bfed57d 100644 --- a/src/core/Baggy.pm +++ b/src/core/Baggy.pm @@ -306,7 +306,7 @@ my role Baggy does QuantHash { method default(Baggy:D: --> 0) { } multi method Str(Baggy:D: --> Str:D) { - nqp::join(' ',Rakudo::QuantHash.RAW-VALUES-MAP(self, { + nqp::join(' ',Rakudo::QuantHash.RAW-VALUES-MAP(self, { nqp::if( (my $value := nqp::getattr($_,Pair,'$!value')) == 1, nqp::getattr($_,Pair,'$!key').gist, @@ -320,7 +320,7 @@ my role Baggy does QuantHash { nqp::concat(self.^name,'('), nqp::join(', ', Rakudo::Sorting.MERGESORT-str( - Rakudo::QuantHash.RAW-VALUES-MAP(self, { + Rakudo::QuantHash.RAW-VALUES-MAP(self, { nqp::if( (my $value := nqp::getattr($_,Pair,'$!value')) == 1, nqp::getattr($_,Pair,'$!key').gist, @@ -340,7 +340,7 @@ my role Baggy does QuantHash { nqp::concat( '(', nqp::join(',', - Rakudo::QuantHash.RAW-VALUES-MAP(self, { + Rakudo::QuantHash.RAW-VALUES-MAP(self, { nqp::if( (my $value := nqp::getattr($_,Pair,'$!value')) == 1, nqp::getattr($_,Pair,'$!key').perl, diff --git a/src/core/Encoding/Builtin.pm b/src/core/Encoding/Builtin.pm index 137201ee8fd..1bf52fac428 100644 --- a/src/core/Encoding/Builtin.pm +++ b/src/core/Encoding/Builtin.pm @@ -68,7 +68,7 @@ Encoding::Registry.register( "latin1", "latin-1", "csisolatin1:", - "l1", + "l1", "ibm819", "cp819" ) diff --git a/src/core/Enumeration.pm b/src/core/Enumeration.pm index 0b3d8f4c25e..3dc81ee33fe 100644 --- a/src/core/Enumeration.pm +++ b/src/core/Enumeration.pm @@ -23,7 +23,7 @@ my role Enumeration { multi method Int(::?CLASS:D:) { $!value.Int } multi method Real(::?CLASS:D:) { $!value.Real } - multi method WHICH(::?CLASS:D:) { + multi method WHICH(::?CLASS:D:) { nqp::box_s( nqp::concat(self.^name,nqp::concat("|",$!index)), ObjAt diff --git a/src/core/Lock/Async.pm b/src/core/Lock/Async.pm index ae6f97e8522..5d01524dfb8 100644 --- a/src/core/Lock/Async.pm +++ b/src/core/Lock/Async.pm @@ -33,7 +33,7 @@ my class Lock::Async { } # Assumes it won't be called if there is no queue (SINGLE_HOLDER case - # in unlock()) + # in unlock()) method head-vow() { nqp::atpos($!queue, 0) } diff --git a/src/core/Rakudo/QuantHash.pm b/src/core/Rakudo/QuantHash.pm index d5456b888c0..a7f70db1226 100644 --- a/src/core/Rakudo/QuantHash.pm +++ b/src/core/Rakudo/QuantHash.pm @@ -425,7 +425,7 @@ my class Rakudo::QuantHash { method SUB-PAIRS-FROM-SET(\elems, \iterator) { nqp::stmts( (my $elems := nqp::clone(elems)), - nqp::until( + nqp::until( nqp::eqaddr( # end of iterator? (my $pulled := iterator.pull-one), IterationEnd @@ -1511,7 +1511,7 @@ my class Rakudo::QuantHash { Pair, '$!value' )) - > # value in A should be <= than B + > # value in A should be <= than B ($right := nqp::getattr( nqp::iterval($iter),Pair,'$!value' )), From 8cf083c709e6bdee2cbadbb75a4611aae7e611d2 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Tue, 26 Sep 2017 09:18:22 +0200 Subject: [PATCH 159/692] Remove trailing whitespace in NQP land --- src/Perl6/DebugPod.nqp | 14 +++---- src/Perl6/Metamodel/Archetypes.nqp | 16 ++++---- src/Perl6/Metamodel/ArrayType.nqp | 6 +-- src/Perl6/Metamodel/AttributeContainer.nqp | 8 ++-- src/Perl6/Metamodel/BUILDPLAN.nqp | 8 ++-- src/Perl6/Metamodel/BaseType.nqp | 6 +-- src/Perl6/Metamodel/BoolificationProtocol.nqp | 6 +-- src/Perl6/Metamodel/C3MRO.nqp | 10 ++--- src/Perl6/Metamodel/ClassHOW.nqp | 28 ++++++------- src/Perl6/Metamodel/ConcreteRoleHOW.nqp | 28 ++++++------- src/Perl6/Metamodel/ContainerDescriptor.nqp | 10 ++--- src/Perl6/Metamodel/CurriedRoleHOW.nqp | 30 +++++++------- src/Perl6/Metamodel/DefaultParent.nqp | 6 +-- src/Perl6/Metamodel/DefiniteHOW.nqp | 8 ++-- src/Perl6/Metamodel/Dispatchers.nqp | 20 +++++----- src/Perl6/Metamodel/EnumHOW.nqp | 32 +++++++-------- src/Perl6/Metamodel/GenericHOW.nqp | 10 ++--- src/Perl6/Metamodel/InvocationProtocol.nqp | 14 +++---- .../Metamodel/MROBasedMethodDispatch.nqp | 6 +-- src/Perl6/Metamodel/MROBasedTypeChecking.nqp | 6 +-- src/Perl6/Metamodel/MethodContainer.nqp | 14 +++---- src/Perl6/Metamodel/MethodDelegation.nqp | 6 +-- src/Perl6/Metamodel/ModuleHOW.nqp | 2 +- src/Perl6/Metamodel/MultiMethodContainer.nqp | 8 ++-- src/Perl6/Metamodel/MultipleInheritance.nqp | 12 +++--- src/Perl6/Metamodel/NativeHOW.nqp | 12 +++--- src/Perl6/Metamodel/PackageHOW.nqp | 6 +-- .../Metamodel/ParametricRoleGroupHOW.nqp | 18 ++++----- src/Perl6/Metamodel/ParametricRoleHOW.nqp | 40 +++++++++---------- .../Metamodel/PrivateMethodContainer.nqp | 6 +-- src/Perl6/Metamodel/REPRComposeProtocol.nqp | 16 ++++---- src/Perl6/Metamodel/RoleContainer.nqp | 4 +- src/Perl6/Metamodel/RolePunning.nqp | 20 +++++----- src/Perl6/Metamodel/RoleToClassApplier.nqp | 10 ++--- src/Perl6/Metamodel/RoleToRoleApplier.nqp | 8 ++-- src/Perl6/Metamodel/SubsetHOW.nqp | 20 +++++----- src/Perl6/Metamodel/Trusting.nqp | 10 ++--- src/Perl6/Metamodel/TypePretense.nqp | 6 +-- src/Perl6/Pod.nqp | 6 +-- 39 files changed, 248 insertions(+), 248 deletions(-) diff --git a/src/Perl6/DebugPod.nqp b/src/Perl6/DebugPod.nqp index 7386b12edf0..b77486d467e 100644 --- a/src/Perl6/DebugPod.nqp +++ b/src/Perl6/DebugPod.nqp @@ -10,9 +10,9 @@ # Perl6::DebugPod::foo(...); class Perl6::DebugPod { - + #============================================ - # subs for debugging + # subs for debugging #============================================ our sub is_type($obj) { return 'list' if nqp::islist($obj); @@ -23,7 +23,7 @@ class Perl6::DebugPod { my $s := $obj.ast; die("FATAL: Unknown type '$s'"); } - + our sub debug_rows($desc, @rows) { say("======================================================================="); say($desc); @@ -43,13 +43,13 @@ class Perl6::DebugPod { } print("\n"); } - $i := $i + 1; + $i := $i + 1; } say("======================================================================="); say("End 'debug_rows'"); say("======================================================================="); } - + our sub debug_array($desc, @arr) { say("======================================================================="); say($desc); @@ -71,14 +71,14 @@ class Perl6::DebugPod { $j := ' '; } print(" '$j'"); - $i := $i + 1; + $i := $i + 1; } print(" ]\n"); say("======================================================================="); say("End 'debug_array'"); say("======================================================================="); } - + our sub debug_hdr_content($desc, $headers, $content) { say("======================================================================="); say($desc); diff --git a/src/Perl6/Metamodel/Archetypes.nqp b/src/Perl6/Metamodel/Archetypes.nqp index 907eb7e09e4..0cae61bbf74 100644 --- a/src/Perl6/Metamodel/Archetypes.nqp +++ b/src/Perl6/Metamodel/Archetypes.nqp @@ -8,26 +8,26 @@ class Perl6::Metamodel::Archetypes { # Can this serve as a nominal type? Implies memoizability # amongst other things. has $!nominal; - + # If it's not nominal, does it know how to provide a nominal # type part of itself? has $!nominalizable; - + # Can this be inherited from? has $!inheritable; - + # If it's not inheritable, does it know how to produce something # that is? has $!inheritalizable; - + # Can this be composed (either with flattening composition, or used # as a mixin)? has $!composable; - + # If it's not composable, does it know how to produce something # that is? has $!composalizable; - + # Is it generic, in the sense of "we don't know what type this is # yet"? Note that a parametric type would not be generic - even if # it has missing parts, it defines a type. A type variable is generic, @@ -35,7 +35,7 @@ class Perl6::Metamodel::Archetypes { # delayed) reification. In some contexts, an unresolved generic is # fatal. has $!generic; - + # Is it a parametric type - that is, it has missing bits that need # to be filled out before it can be used? Unlike generic, something # that is parametric does define a type - though we may need the gaps @@ -50,7 +50,7 @@ class Perl6::Metamodel::Archetypes { # Are we allowed to augment the type? has $!augmentable; - + method nominal() { $!nominal // 0 } method nominalizable() { $!nominalizable // 0 } method inheritable() { $!inheritable // 0 } diff --git a/src/Perl6/Metamodel/ArrayType.nqp b/src/Perl6/Metamodel/ArrayType.nqp index 3f0640df2b4..2ceebff5e32 100644 --- a/src/Perl6/Metamodel/ArrayType.nqp +++ b/src/Perl6/Metamodel/ArrayType.nqp @@ -3,15 +3,15 @@ role Perl6::Metamodel::ArrayType { has int $!is_array_type; has $!array_type; - + method is_array_type($obj) { $!is_array_type } - + method array_type($obj) { $!array_type } - + method set_array_type($obj, $type) { $!is_array_type := 1; $!array_type := $type; diff --git a/src/Perl6/Metamodel/AttributeContainer.nqp b/src/Perl6/Metamodel/AttributeContainer.nqp index 50d65afa0c6..8b5904a766d 100644 --- a/src/Perl6/Metamodel/AttributeContainer.nqp +++ b/src/Perl6/Metamodel/AttributeContainer.nqp @@ -2,7 +2,7 @@ role Perl6::Metamodel::AttributeContainer { # Attributes list. has @!attributes; has %!attribute_lookup; - + # Do we default them to rw? has $!attr_rw_by_default; @@ -41,18 +41,18 @@ role Perl6::Metamodel::AttributeContainer { !! $_.compose($obj) } } - + # Makes setting the type represented by the meta-object rw mean that its # attributes are rw by default. method set_rw($obj) { $!attr_rw_by_default := 1; } - + # Is this type's attributes rw by default? method rw($obj) { $!attr_rw_by_default } - + # Gets the attribute meta-object for an attribute if it exists. # This is called by the parser so it should only return attributes # that are visible inside the current package. diff --git a/src/Perl6/Metamodel/BUILDPLAN.nqp b/src/Perl6/Metamodel/BUILDPLAN.nqp index f7d16b7599c..19823bb331e 100644 --- a/src/Perl6/Metamodel/BUILDPLAN.nqp +++ b/src/Perl6/Metamodel/BUILDPLAN.nqp @@ -1,7 +1,7 @@ role Perl6::Metamodel::BUILDPLAN { has @!BUILDALLPLAN; has @!BUILDPLAN; - + # Creates the plan for building up the object. This works # out what we'll need to do up front, so we can just zip # through the "todo list" each time we need to make an object. @@ -42,7 +42,7 @@ role Perl6::Metamodel::BUILDPLAN { %attrs_untouched{$_.name} := NQPMu; } } - + # Does it have its own BUILD? my $build := $obj.HOW.find_method($obj, 'BUILD', :no_fallback(1)); if !nqp::isnull($build) && $build { @@ -125,11 +125,11 @@ role Perl6::Metamodel::BUILDPLAN { # if same number of elems and no noops, identical, so just keep 1 copy @!BUILDALLPLAN := $noops || +@all_plan != +@plan ?? @all_plan !! @plan; } - + method BUILDPLAN($obj) { @!BUILDPLAN } - + method BUILDALLPLAN($obj) { @!BUILDALLPLAN } diff --git a/src/Perl6/Metamodel/BaseType.nqp b/src/Perl6/Metamodel/BaseType.nqp index 80f13186aa3..151f7a01a89 100644 --- a/src/Perl6/Metamodel/BaseType.nqp +++ b/src/Perl6/Metamodel/BaseType.nqp @@ -5,7 +5,7 @@ role Perl6::Metamodel::BaseType { has $!base_type; has $!base_type_set; has @!mro; - + method set_base_type($obj, $base_type) { if $!base_type_set { nqp::die("Base type has already been set for " ~ self.name($obj)); @@ -13,7 +13,7 @@ role Perl6::Metamodel::BaseType { $!base_type := $base_type; $!base_type_set := 1; } - + # Our MRO is just that of base type. method mro($obj) { unless @!mro { @@ -24,7 +24,7 @@ role Perl6::Metamodel::BaseType { } @!mro } - + method parents($obj, :$local, :$excl, :$all) { my @parents := [$!base_type]; unless $local { diff --git a/src/Perl6/Metamodel/BoolificationProtocol.nqp b/src/Perl6/Metamodel/BoolificationProtocol.nqp index ecdfd770587..a60f7661323 100644 --- a/src/Perl6/Metamodel/BoolificationProtocol.nqp +++ b/src/Perl6/Metamodel/BoolificationProtocol.nqp @@ -1,14 +1,14 @@ role Perl6::Metamodel::BoolificationProtocol { has $!boolification_mode; - + method get_boolification_mode($obj) { $!boolification_mode } - + method set_boolification_mode($obj, $mode) { $!boolification_mode := $mode; } - + method publish_boolification_spec($obj) { if $!boolification_mode == 0 { my $meth := self.find_method($obj, 'Bool', :no_fallback(1)); diff --git a/src/Perl6/Metamodel/C3MRO.nqp b/src/Perl6/Metamodel/C3MRO.nqp index 3f300cf746d..5cea83e233c 100644 --- a/src/Perl6/Metamodel/C3MRO.nqp +++ b/src/Perl6/Metamodel/C3MRO.nqp @@ -1,10 +1,10 @@ role Perl6::Metamodel::C3MRO { # Storage of the MRO. has @!mro; - + # The MRO minus anything that is hidden. has @!mro_unhidden; - + # Computes C3 MRO. method compute_mro($class) { my @immediate_parents := $class.HOW.parents($class, :local); @@ -29,7 +29,7 @@ role Perl6::Metamodel::C3MRO { # Put this class on the start of the list, and we're done. @result.unshift($class); @!mro := @result; - + # Also compute the unhidden MRO (all the things in the MRO that # are not somehow hidden). my @unhidden; @@ -51,7 +51,7 @@ role Perl6::Metamodel::C3MRO { } } @!mro_unhidden := @unhidden; - + @!mro } @@ -134,7 +134,7 @@ role Perl6::Metamodel::C3MRO { self.compute_mro($obj) } } - + # Introspects the Method Resolution Order without anything that has # been hidden. method mro_unhidden($obj) { diff --git a/src/Perl6/Metamodel/ClassHOW.nqp b/src/Perl6/Metamodel/ClassHOW.nqp index 4b8682f06aa..551b121406c 100644 --- a/src/Perl6/Metamodel/ClassHOW.nqp +++ b/src/Perl6/Metamodel/ClassHOW.nqp @@ -34,7 +34,7 @@ class Perl6::Metamodel::ClassHOW method archetypes() { $archetypes } - + method new(*%named) { nqp::findmethod(NQPMu, 'BUILDALL')(nqp::create(self), |%named) } @@ -50,7 +50,7 @@ class Perl6::Metamodel::ClassHOW nqp::setboolspec($obj, 5, nqp::null()); $obj } - + # Adds a new fallback for method dispatch. Expects the specified # condition to have been met (passes it the object and method name), # and if it is calls $calculator with the object and method name to @@ -58,7 +58,7 @@ class Perl6::Metamodel::ClassHOW method add_fallback($obj, $condition, $calculator) { # Adding a fallback means any method cache is no longer authoritative. nqp::setmethcacheauth($obj, 0); - + # Add it. my %desc; %desc := $condition; @@ -83,7 +83,7 @@ class Perl6::Metamodel::ClassHOW } self.compute_mro($obj); # to the best of our knowledge, because the role applier wants it. RoleToClassApplier.apply($obj, @ins_roles); - + # Add them to the typecheck list, and pull in their # own type check lists also. for @ins_roles { @@ -147,10 +147,10 @@ class Perl6::Metamodel::ClassHOW self.publish_type_cache($obj); self.publish_method_cache($obj); self.publish_boolification_spec($obj); - + # Create BUILDPLAN. self.create_BUILDPLAN($obj); - + # Compose the representation, provided this isn't an augment. unless $was_composed { self.compose_repr($obj); @@ -158,13 +158,13 @@ class Perl6::Metamodel::ClassHOW # Compose the meta-methods. self.compose_meta_methods($obj); - + # Compose invocation protocol. self.compose_invocation($obj); $obj } - + method roles($obj, :$local, :$transitive = 1) { my @result; for @!roles { @@ -189,11 +189,11 @@ class Perl6::Metamodel::ClassHOW } @result } - + method role_typecheck_list($obj) { @!role_typecheck_list } - + method concretization($obj, $ptype) { for @!concretizations { if nqp::decont($_[0]) =:= nqp::decont($ptype) { @@ -202,7 +202,7 @@ class Perl6::Metamodel::ClassHOW } nqp::die("No concretization found for " ~ $ptype.HOW.name($ptype)); } - + method is_composed($obj) { $!composed } @@ -215,7 +215,7 @@ class Perl6::Metamodel::ClassHOW $junction_type := $type; $junction_autothreader := $autothreader; } - + # Handles the various dispatch fallback cases we have. method find_method_fallback($obj, $name) { # If the object is a junction, need to do a junction dispatch. @@ -225,7 +225,7 @@ class Perl6::Metamodel::ClassHOW $junction_autothreader($p6name, |@pos_args, |%named_args) }; } - + # Consider other fallbacks, if we have any. for @!fallbacks { if ($_)($obj, $name) { @@ -236,7 +236,7 @@ class Perl6::Metamodel::ClassHOW # Otherwise, didn't find anything. nqp::null() } - + # Does the type have any fallbacks? method has_fallbacks($obj) { return nqp::istype($obj, $junction_type) || +@!fallbacks; diff --git a/src/Perl6/Metamodel/ConcreteRoleHOW.nqp b/src/Perl6/Metamodel/ConcreteRoleHOW.nqp index 2cd27854499..4d027f90c19 100644 --- a/src/Perl6/Metamodel/ConcreteRoleHOW.nqp +++ b/src/Perl6/Metamodel/ConcreteRoleHOW.nqp @@ -11,14 +11,14 @@ class Perl6::Metamodel::ConcreteRoleHOW { # Any collisions to resolve. has @!collisions; - + # The (parametric) role(s) that this concrete one was directly derived # from. has @!roles; - + # Full flat list of done roles. has @!role_typecheck_list; - + # Are we composed yet? has $!composed; @@ -26,11 +26,11 @@ class Perl6::Metamodel::ConcreteRoleHOW method archetypes() { $archetypes } - + method new(*%named) { nqp::findmethod(NQPMu, 'BUILDALL')(nqp::create(self), |%named) } - + my class Collision { has $!name; has @!roles; @@ -50,7 +50,7 @@ class Perl6::Metamodel::ConcreteRoleHOW $metarole.set_auth($obj, $auth) if $auth; $obj; } - + method add_collision($obj, $colliding_name, @role_names, :$private = 0, :$multi) { @!collisions[+@!collisions] := Collision.new( :name($colliding_name), :roles(@role_names), :$private, :$multi @@ -75,15 +75,15 @@ class Perl6::Metamodel::ConcreteRoleHOW $!composed := 1; $obj } - + method is_composed($obj) { $!composed ?? 1 !! 0 } - + method collisions($obj) { @!collisions } - + method roles($obj, :$transitive = 1) { if $transitive { my @trans; @@ -98,15 +98,15 @@ class Perl6::Metamodel::ConcreteRoleHOW @!roles } } - + method add_to_role_typecheck_list($obj, $type) { @!role_typecheck_list[+@!role_typecheck_list] := $type; } - + method role_typecheck_list($obj) { @!role_typecheck_list } - + method type_check($obj, $checkee) { my $decont := nqp::decont($checkee); if $decont =:= $obj.WHAT { @@ -119,13 +119,13 @@ class Perl6::Metamodel::ConcreteRoleHOW } 0 } - + method publish_type_cache($obj) { my @types := [$obj.WHAT]; for @!role_typecheck_list { @types.push($_) } nqp::settypecache($obj, @types) } - + method mro($obj) { [$obj] } diff --git a/src/Perl6/Metamodel/ContainerDescriptor.nqp b/src/Perl6/Metamodel/ContainerDescriptor.nqp index 1c2da4cfb0d..c2f4330168c 100644 --- a/src/Perl6/Metamodel/ContainerDescriptor.nqp +++ b/src/Perl6/Metamodel/ContainerDescriptor.nqp @@ -4,7 +4,7 @@ class Perl6::Metamodel::ContainerDescriptor { has str $!name; has $!default; has int $!dynamic; - + method BUILD(:$of, :$rw, :$name, :$default, :$dynamic) { $!of := $of; $!rw := $rw; @@ -12,22 +12,22 @@ class Perl6::Metamodel::ContainerDescriptor { $!default := $default; $!dynamic := $dynamic; } - + method of() { $!of } method rw() { $!rw } method name() { $!name } method default() { $!default } method dynamic() { $!dynamic } - + method set_of($of) { $!of := $of; self } method set_rw($rw) { $!rw := $rw; self } method set_default($default) { $!default := $default; self } method set_dynamic($dynamic) { $!dynamic := $dynamic; self } - + method is_generic() { $!of.HOW.archetypes.generic } - + method instantiate_generic($type_environment) { my $ins_of := $!of.HOW.instantiate_generic($!of, $type_environment); my $ins := nqp::clone(self); diff --git a/src/Perl6/Metamodel/CurriedRoleHOW.nqp b/src/Perl6/Metamodel/CurriedRoleHOW.nqp index 6fc1180b0f2..c469d654bf9 100644 --- a/src/Perl6/Metamodel/CurriedRoleHOW.nqp +++ b/src/Perl6/Metamodel/CurriedRoleHOW.nqp @@ -1,15 +1,15 @@ # Sometimes, we see references to roles that provide parameters but # do not fully resolve them. For example, in: -# +# # class C does R[T] { } # # We need to represent R[T], but we cannot yet fully specialize the # role because we don't have the first parameter to hand. We may also # run into the issue where we have things like: -# +# # sub foo(R[T] $x) { ... } # if $x ~~ R[T] { ... } -# +# # Where we clearly want to talk about a partial parameterization of a # role and actually want to do so in a way distinct from a particular # instantiation of it. This meta-object represents those "partial types" @@ -41,11 +41,11 @@ class Perl6::Metamodel::CurriedRoleHOW } $archetypes_ng } - + method new(*%named) { nqp::findmethod(NQPMu, 'BUILDALL')(nqp::create(self), |%named) } - + method new_type($curried_role, *@pos_args, *%named_args) { # construct a name my $name := $curried_role.HOW.name($curried_role); @@ -62,7 +62,7 @@ class Perl6::Metamodel::CurriedRoleHOW my $type := nqp::settypehll(nqp::newtype($meta, 'Uninstantiable'), 'perl6'); nqp::settypecheckmode($type, 2) } - + method instantiate_generic($obj, $type_env) { my @new_pos; my %new_named; @@ -78,32 +78,32 @@ class Perl6::Metamodel::CurriedRoleHOW } self.new_type($!curried_role, |@new_pos, |%new_named) } - + method specialize($obj, $first_arg) { $!curried_role.HOW.specialize($!curried_role, $first_arg, |@!pos_args, |%!named_args); } - + method curried_role($obj) { $!curried_role } - + method role_arguments($obj) { @!pos_args } - + method roles($obj, :$transitive = 1) { $!curried_role.HOW.roles($obj, :$transitive) } - + method role_typecheck_list($obj) { $!curried_role.HOW.role_typecheck_list($obj) } - + method type_check($obj, $checkee) { $!curried_role.HOW.type_check($!curried_role, $checkee) } - + method accepts_type($obj, $checkee) { # First, we locate candidate curryings to check against. If # the checkee is itself a curried role, it also goes in. Note @@ -125,7 +125,7 @@ class Perl6::Metamodel::CurriedRoleHOW } } } - + # Provided we have some candidates, check the arguments. my $num_args := +@!pos_args; if @cands { @@ -147,7 +147,7 @@ class Perl6::Metamodel::CurriedRoleHOW } } } - + 0; } diff --git a/src/Perl6/Metamodel/DefaultParent.nqp b/src/Perl6/Metamodel/DefaultParent.nqp index 2fdfb482d2e..da83c2c1bf7 100644 --- a/src/Perl6/Metamodel/DefaultParent.nqp +++ b/src/Perl6/Metamodel/DefaultParent.nqp @@ -1,14 +1,14 @@ role Perl6::Metamodel::DefaultParent { my @default_parent_type; - + method set_default_parent_type($type) { @default_parent_type[0] := $type; } - + method has_default_parent_type() { +@default_parent_type } - + method get_default_parent_type() { @default_parent_type[0] } diff --git a/src/Perl6/Metamodel/DefiniteHOW.nqp b/src/Perl6/Metamodel/DefiniteHOW.nqp index 725274bbd30..e75c738e11e 100644 --- a/src/Perl6/Metamodel/DefiniteHOW.nqp +++ b/src/Perl6/Metamodel/DefiniteHOW.nqp @@ -6,10 +6,10 @@ class Perl6::Metamodel::DefiniteHOW #~ does Perl6::Metamodel::Naming does Perl6::Metamodel::Documenting - + #~ does Perl6::Metamodel::MethodDelegation #~ does Perl6::Metamodel::TypePretense - + #~ does Perl6::Metamodel::Stashing #~ does Perl6::Metamodel::AttributeContainer #~ does Perl6::Metamodel::MethodContainer @@ -83,7 +83,7 @@ class Perl6::Metamodel::DefiniteHOW #~ } #~ @!mro #~ } - + #~ method parents($obj, :$local, :$excl, :$all) { #~ my @parents := [$!base_type]; #~ unless $local { @@ -128,7 +128,7 @@ class Perl6::Metamodel::DefiniteHOW BEGIN { my $root := nqp::newtype(Perl6::Metamodel::DefiniteHOW, 'Uninstantiable'); nqp::settypehll($root, 'perl6'); - + nqp::setparameterizer($root, sub ($type, $params) { # Re-use same HOW. my $thing := nqp::settypehll(nqp::newtype($type.HOW, 'Uninstantiable'), 'perl6'); diff --git a/src/Perl6/Metamodel/Dispatchers.nqp b/src/Perl6/Metamodel/Dispatchers.nqp index e7092422676..e7e2ce78864 100644 --- a/src/Perl6/Metamodel/Dispatchers.nqp +++ b/src/Perl6/Metamodel/Dispatchers.nqp @@ -3,11 +3,11 @@ class Perl6::Metamodel::BaseDispatcher { has $!idx; method candidates() { @!candidates } - + method exhausted() { $!idx >= +@!candidates } - + method last() { @!candidates := [] } - + method call_with_args(*@pos, *%named) { my $call := @!candidates[$!idx]; $!idx := $!idx + 1; @@ -21,7 +21,7 @@ class Perl6::Metamodel::BaseDispatcher { $call(|@pos, |%named); } } - + method call_with_capture($capture) { my $call := @!candidates[$!idx]; $!idx := $!idx + 1; @@ -46,7 +46,7 @@ class Perl6::Metamodel::MethodDispatcher is Perl6::Metamodel::BaseDispatcher { nqp::bindattr($disp, Perl6::Metamodel::MethodDispatcher, '$!obj', $obj); $disp } - + method vivify_for($sub, $lexpad, $args) { my $obj := $lexpad; my $name := $sub.name; @@ -62,7 +62,7 @@ class Perl6::Metamodel::MethodDispatcher is Perl6::Metamodel::BaseDispatcher { } self.new(:candidates(@methods), :obj($obj), :idx(1)) } - + method has_invocant() { 1 } method invocant() { $!obj } } @@ -79,7 +79,7 @@ class Perl6::Metamodel::MultiDispatcher is Perl6::Metamodel::BaseDispatcher { nqp::bindattr($disp, Perl6::Metamodel::MultiDispatcher, '$!has_invocant', $has_invocant); $disp } - + method vivify_for($sub, $lexpad, $args) { my $disp := $sub.dispatcher(); my $has_invocant := nqp::existskey($lexpad, 'self'); @@ -102,11 +102,11 @@ class Perl6::Metamodel::WrapDispatcher is Perl6::Metamodel::BaseDispatcher { } method has_invocant() { 0 } - + method add($wrapper) { self.candidates.unshift($wrapper) } - + method remove($wrapper) { my @cands := self.candidates; my $i := 0; @@ -119,7 +119,7 @@ class Perl6::Metamodel::WrapDispatcher is Perl6::Metamodel::BaseDispatcher { } return 0; } - + method enter(*@pos, *%named) { my $fresh := nqp::clone(self); my $first := self.candidates[0]; diff --git a/src/Perl6/Metamodel/EnumHOW.nqp b/src/Perl6/Metamodel/EnumHOW.nqp index 5adc6926abd..cced4360f33 100644 --- a/src/Perl6/Metamodel/EnumHOW.nqp +++ b/src/Perl6/Metamodel/EnumHOW.nqp @@ -21,20 +21,20 @@ class Perl6::Metamodel::EnumHOW { # Hash representing enumeration keys to values. has %!values; - + # Reverse mapping hash. has %!value_to_enum; - + # List of enum values (actual enum objects). has @!enum_value_list; - + # Roles that we do. has @!role_typecheck_list; - + # Role'd version of the enum. has $!role; has int $!roled; - + # Are we composed yet? has $!composed; @@ -46,11 +46,11 @@ class Perl6::Metamodel::EnumHOW method archetypes() { $archetypes } - + method new(*%named) { nqp::findmethod(NQPMu, 'BUILDALL')(nqp::create(self), |%named) } - + method new_type(:$name!, :$base_type?, :$repr = 'P6opaque') { my $meta := self.new(); my $obj := nqp::settypehll(nqp::newtype($meta, $repr), 'perl6'); @@ -64,7 +64,7 @@ class Perl6::Metamodel::EnumHOW method add_parent($obj, $parent) { self.set_base_type($obj, $parent); } - + method add_enum_value($obj, $value) { %!values{nqp::unbox_s($value.key)} := $value.value; @!enum_value_list[+@!enum_value_list] := $value; @@ -77,11 +77,11 @@ class Perl6::Metamodel::EnumHOW method enum_values($obj) { %!values } - + method elems($obj) { nqp::elems(%!values) } - + method enum_from_value($obj, $value) { unless %!value_to_enum { for @!enum_value_list { @@ -92,7 +92,7 @@ class Perl6::Metamodel::EnumHOW ?? %!value_to_enum{$value} !! $obj.WHAT; } - + method enum_value_list($obj) { @!enum_value_list } @@ -120,7 +120,7 @@ class Perl6::Metamodel::EnumHOW } } } - + # Incorporate any new multi candidates (needs MRO built). self.incorporate_multi_candidates($obj); @@ -132,19 +132,19 @@ class Perl6::Metamodel::EnumHOW # Publish type and method caches. self.publish_type_cache($obj); self.publish_method_cache($obj); - + # Publish boolification spec. self.publish_boolification_spec($obj); - + # Create BUILDPLAN. self.create_BUILDPLAN($obj); - + # Compose the representation. unless $!composed { self.compose_repr($obj); $!composed := 1; } - + # Compose invocation protocol. self.compose_invocation($obj); diff --git a/src/Perl6/Metamodel/GenericHOW.nqp b/src/Perl6/Metamodel/GenericHOW.nqp index 1345d0be367..61b44b4f15e 100644 --- a/src/Perl6/Metamodel/GenericHOW.nqp +++ b/src/Perl6/Metamodel/GenericHOW.nqp @@ -9,11 +9,11 @@ class Perl6::Metamodel::GenericHOW method archetypes() { $archetypes } - + method new(*%named) { nqp::findmethod(NQPMu, 'BUILDALL')(nqp::create(self), |%named) } - + # The name we're created with is both the name we'll claim # to be if asked, but also the name we'll look up in a # supplied type environment when we want to instantiate @@ -30,14 +30,14 @@ class Perl6::Metamodel::GenericHOW my $found := nqp::getlexrel($type_environment, $name); nqp::isnull($found) ?? $obj !! $found } - + method compose($obj) { } - + method find_method($obj, $name) { nqp::null() } - + method type_check($obj, $checkee) { 0 } diff --git a/src/Perl6/Metamodel/InvocationProtocol.nqp b/src/Perl6/Metamodel/InvocationProtocol.nqp index ac865970908..628223391ef 100644 --- a/src/Perl6/Metamodel/InvocationProtocol.nqp +++ b/src/Perl6/Metamodel/InvocationProtocol.nqp @@ -2,7 +2,7 @@ role Perl6::Metamodel::InvocationProtocol { has int $!has_invocation_attr; has $!invocation_attr_class; has str $!invocation_attr_name; - + has int $!has_invocation_handler; has $!invocation_handler; @@ -10,27 +10,27 @@ role Perl6::Metamodel::InvocationProtocol { has $!md_attr_class; has str $!md_valid_attr_name; has str $!md_cache_attr_name; - + my $default_invoke_handler; method set_default_invoke_handler($h) { $default_invoke_handler := $h; } - + method set_invocation_attr($obj, $class, str $name) { $!has_invocation_attr := 1; $!invocation_attr_class := $class; $!invocation_attr_name := $name; } - + method set_invocation_handler($obj, $handler) { $!has_invocation_handler := 1; $!invocation_handler := $handler; } - + method has_invocation_attr($obj) { $!has_invocation_attr } method invocation_attr_class($obj) { $!invocation_attr_class } method invocation_attr_name($obj) { $!invocation_attr_name } - + method has_invocation_handler($obj) { $!has_invocation_handler } method invocation_handler($obj) { $!invocation_handler } @@ -44,7 +44,7 @@ role Perl6::Metamodel::InvocationProtocol { method multi_attr_class($obj) { $!md_attr_class } method multi_valid_attr_name($obj) { $!md_valid_attr_name } method multi_cache_attr_name($obj) { $!md_cache_attr_name } - + method compose_invocation($obj) { # Check if we have a invoke, and if so install # the default invocation forwarder. Otherwise, see if we or diff --git a/src/Perl6/Metamodel/MROBasedMethodDispatch.nqp b/src/Perl6/Metamodel/MROBasedMethodDispatch.nqp index f7816ee2333..44254945782 100644 --- a/src/Perl6/Metamodel/MROBasedMethodDispatch.nqp +++ b/src/Perl6/Metamodel/MROBasedMethodDispatch.nqp @@ -19,7 +19,7 @@ role Perl6::Metamodel::MROBasedMethodDispatch { self.find_method_fallback($obj, $name) !! nqp::null(); } - + method find_method_qualified($obj, $qtype, $name) { if $qtype.HOW.archetypes.parametric && nqp::can(self, 'concretization') { # Resolve it via the concrete form of this parametric. @@ -66,12 +66,12 @@ role Perl6::Metamodel::MROBasedMethodDispatch { $authable := 0; } } - + # Also add submethods. for $obj.HOW.submethod_table($obj) { %cache{$_.key} := $_.value; } - + nqp::setmethcache($obj, %cache); unless nqp::can(self, 'has_fallbacks') && self.has_fallbacks($obj) { nqp::setmethcacheauth($obj, $authable); diff --git a/src/Perl6/Metamodel/MROBasedTypeChecking.nqp b/src/Perl6/Metamodel/MROBasedTypeChecking.nqp index 2e359a101d3..9c39fe7bb63 100644 --- a/src/Perl6/Metamodel/MROBasedTypeChecking.nqp +++ b/src/Perl6/Metamodel/MROBasedTypeChecking.nqp @@ -6,11 +6,11 @@ role Perl6::Metamodel::MROBasedTypeChecking { } 0 } - + method does($obj, $type) { nqp::p6bool(nqp::istype($obj, $type)) } - + method type_check($obj, $checkee) { # The only time we end up in here is if the type check cache was # not yet published, which means the class isn't yet fully composed. @@ -29,7 +29,7 @@ role Perl6::Metamodel::MROBasedTypeChecking { } 0 } - + method publish_type_cache($obj) { my @tc; for self.mro($obj) { diff --git a/src/Perl6/Metamodel/MethodContainer.nqp b/src/Perl6/Metamodel/MethodContainer.nqp index 7ed457d1a41..b5c2a46d1e9 100644 --- a/src/Perl6/Metamodel/MethodContainer.nqp +++ b/src/Perl6/Metamodel/MethodContainer.nqp @@ -5,7 +5,7 @@ role Perl6::Metamodel::MethodContainer { # The order that the methods were added in. has @!method_order; - + # Cache that expires when we add methods (primarily to support NFA stuff). # The hash here is readonly; we copy/replace in on addition, for thread # safety (additions are dominated by lookups, so a lock - even a rw-lock - @@ -25,9 +25,9 @@ role Perl6::Metamodel::MethodContainer { ~ $name ~ "' (did you mean to declare a multi-method?)"); } - + # Add to correct table depending on if it's a Submethod. - if !nqp::isnull(Perl6::Metamodel::Configuration.submethod_type) + if !nqp::isnull(Perl6::Metamodel::Configuration.submethod_type) && nqp::istype($code_obj, Perl6::Metamodel::Configuration.submethod_type) { %!submethods{$name} := $code_obj; } @@ -60,7 +60,7 @@ role Perl6::Metamodel::MethodContainer { } } } - + # Return result list. @meths } @@ -70,18 +70,18 @@ role Perl6::Metamodel::MethodContainer { method method_table($obj) { %!methods } - + # Gets the submethods table. method submethod_table($obj) { %!submethods } - + # Checks if this package (not its parents) declares a given # method. Checks submethods also. method declares_method($obj, $name) { %!methods{$name} || %!submethods{$name} ?? 1 !! 0 } - + # Looks up a method with the provided name, for introspection purposes. method lookup($obj, $name) { for self.mro($obj) { diff --git a/src/Perl6/Metamodel/MethodDelegation.nqp b/src/Perl6/Metamodel/MethodDelegation.nqp index b28e24b2943..9da58383eae 100644 --- a/src/Perl6/Metamodel/MethodDelegation.nqp +++ b/src/Perl6/Metamodel/MethodDelegation.nqp @@ -1,14 +1,14 @@ role Perl6::Metamodel::MethodDelegation { my $delegate_type; - + method delegate_methods_to($type) { $delegate_type := $type } - + method delegating_methods_to() { $delegate_type } - + method find_method($obj, $name) { $delegate_type.HOW.find_method($delegate_type, $name); } diff --git a/src/Perl6/Metamodel/ModuleHOW.nqp b/src/Perl6/Metamodel/ModuleHOW.nqp index d8825db09d4..919a4415755 100644 --- a/src/Perl6/Metamodel/ModuleHOW.nqp +++ b/src/Perl6/Metamodel/ModuleHOW.nqp @@ -12,7 +12,7 @@ class Perl6::Metamodel::ModuleHOW method archetypes() { $archetypes } - + method new(*%named) { nqp::findmethod(NQPMu, 'BUILDALL')(nqp::create(self), |%named) } diff --git a/src/Perl6/Metamodel/MultiMethodContainer.nqp b/src/Perl6/Metamodel/MultiMethodContainer.nqp index ecc9cd09c52..7bb96f7ab1a 100644 --- a/src/Perl6/Metamodel/MultiMethodContainer.nqp +++ b/src/Perl6/Metamodel/MultiMethodContainer.nqp @@ -2,10 +2,10 @@ role Perl6::Metamodel::MultiMethodContainer { # Set of multi-methods to incorporate. Not just the method handles; # each is a hash containing keys name and body. has @!multi_methods_to_incorporate; - + # The proto we'll clone. my $autogen_proto; - + # Sets the proto we'll auto-gen based on. method set_autogen_proto($proto) { $autogen_proto := $proto @@ -33,7 +33,7 @@ role Perl6::Metamodel::MultiMethodContainer { method multi_methods_to_incorporate($obj) { @!multi_methods_to_incorporate } - + # Incorporates the multi candidates into the appropriate proto. Need to # implement proto incorporation yet. method incorporate_multi_candidates($obj) { @@ -56,7 +56,7 @@ role Perl6::Metamodel::MultiMethodContainer { $dispatcher.add_dispatchee($code); } else { - nqp::die("Cannot have a multi candidate for '" ~ $name ~ + nqp::die("Cannot have a multi candidate for '" ~ $name ~ "' when an only method is also in the package '" ~ self.name($obj) ~ "'"); } diff --git a/src/Perl6/Metamodel/MultipleInheritance.nqp b/src/Perl6/Metamodel/MultipleInheritance.nqp index 05e7707498f..d15d1234792 100644 --- a/src/Perl6/Metamodel/MultipleInheritance.nqp +++ b/src/Perl6/Metamodel/MultipleInheritance.nqp @@ -1,13 +1,13 @@ role Perl6::Metamodel::MultipleInheritance { # Array of parents. has @!parents; - + # Are any of the parents hidden? has @!hides; - + # Is this class hidden? has $!hidden; - + # Classes to exclude from the parents list in introspection by default. my @excluded; method exclude_parent($parent) { @@ -78,15 +78,15 @@ role Perl6::Metamodel::MultipleInheritance { @parents } } - + method hides($obj) { @!hides } - + method hidden($obj) { $!hidden ?? 1 !! 0 } - + method set_hidden($obj) { $!hidden := 1; } diff --git a/src/Perl6/Metamodel/NativeHOW.nqp b/src/Perl6/Metamodel/NativeHOW.nqp index d94006d0902..5d2a22ea0fa 100644 --- a/src/Perl6/Metamodel/NativeHOW.nqp +++ b/src/Perl6/Metamodel/NativeHOW.nqp @@ -3,7 +3,7 @@ class Perl6::Metamodel::NativeHOW does Perl6::Metamodel::Documenting does Perl6::Metamodel::Versioning does Perl6::Metamodel::Stashing - does Perl6::Metamodel::MultipleInheritance + does Perl6::Metamodel::MultipleInheritance does Perl6::Metamodel::C3MRO does Perl6::Metamodel::MROBasedMethodDispatch does Perl6::Metamodel::MROBasedTypeChecking @@ -16,7 +16,7 @@ class Perl6::Metamodel::NativeHOW method archetypes() { $archetypes } - + method new(*%named) { nqp::findmethod(NQPMu, 'BUILDALL')(nqp::create(self), |%named) } @@ -53,7 +53,7 @@ class Perl6::Metamodel::NativeHOW } $!composed := 1; } - + method is_composed($obj) { $!composed } @@ -104,15 +104,15 @@ class Perl6::Metamodel::NativeHOW method nativesize($obj) { $!nativesize } - + method set_unsigned($obj, $unsigned) { $!unsigned := $unsigned ?? 1 !! 0 } - + method unsigned($obj) { $!unsigned } - + method method_table($obj) { nqp::hash() } method submethod_table($obj) { nqp::hash() } } diff --git a/src/Perl6/Metamodel/PackageHOW.nqp b/src/Perl6/Metamodel/PackageHOW.nqp index 442127e20bf..e15f9812968 100644 --- a/src/Perl6/Metamodel/PackageHOW.nqp +++ b/src/Perl6/Metamodel/PackageHOW.nqp @@ -11,11 +11,11 @@ class Perl6::Metamodel::PackageHOW method archetypes() { $archetypes } - + method new(*%named) { nqp::findmethod(NQPMu, 'BUILDALL')(nqp::create(self), |%named) } - + method new_type(:$name = '', :$repr, :$ver, :$auth) { if $repr { nqp::die("'package' does not support custom representations") } my $metaclass := nqp::create(self); @@ -27,7 +27,7 @@ class Perl6::Metamodel::PackageHOW method compose($obj, :$compiler_services) { $!composed := 1; } - + method is_composed($obj) { $!composed } diff --git a/src/Perl6/Metamodel/ParametricRoleGroupHOW.nqp b/src/Perl6/Metamodel/ParametricRoleGroupHOW.nqp index 2e57d769ffe..933b3d93814 100644 --- a/src/Perl6/Metamodel/ParametricRoleGroupHOW.nqp +++ b/src/Perl6/Metamodel/ParametricRoleGroupHOW.nqp @@ -1,10 +1,10 @@ # This represents a group of parametric roles. For example, given # we have the declarations: -# +# # role Foo[] { } # (which is same as role Foo { }) # role Foo[::T] { } # role Foo[::T1, ::T2] { } -# +# # Each of them results in a type object that has a HOW of type # Perl6::Metamodel::ParametricRoleHOW. In here, we keep the whole # group of those, and know how to specialize to a certain parameter @@ -26,11 +26,11 @@ class Perl6::Metamodel::ParametricRoleGroupHOW method archetypes() { $archetypes } - + method new(*%named) { nqp::findmethod(NQPMu, 'BUILDALL')(nqp::create(self), |%named) } - + my $selector_creator; method set_selector_creator($sc) { $selector_creator := $sc; @@ -86,13 +86,13 @@ class Perl6::Metamodel::ParametricRoleGroupHOW $curried.HOW.set_pun_repr($curried, self.pun_repr($obj)); $curried } - + method add_possibility($obj, $possible) { @!candidates[+@!candidates] := $possible; $!selector.add_dispatchee($possible.HOW.body_block($possible)); self.update_role_typecheck_list($obj); } - + method specialize($obj, *@pos_args, *%named_args) { # Use multi-dispatcher to pick the body block of the best role. my $error; @@ -129,7 +129,7 @@ class Perl6::Metamodel::ParametricRoleGroupHOW # Having picked the appropriate one, specialize it. $selected.HOW.specialize($selected, |@pos_args, |%named_args); } - + method update_role_typecheck_list($obj) { for @!candidates { if !$_.HOW.signatured($_) { @@ -137,11 +137,11 @@ class Perl6::Metamodel::ParametricRoleGroupHOW } } } - + method role_typecheck_list($obj) { @!role_typecheck_list } - + method type_check($obj, $checkee) { my $decont := nqp::decont($checkee); if $decont =:= $obj.WHAT { diff --git a/src/Perl6/Metamodel/ParametricRoleHOW.nqp b/src/Perl6/Metamodel/ParametricRoleHOW.nqp index 98275e3a422..e4db3d0912d 100644 --- a/src/Perl6/Metamodel/ParametricRoleHOW.nqp +++ b/src/Perl6/Metamodel/ParametricRoleHOW.nqp @@ -27,7 +27,7 @@ class Perl6::Metamodel::ParametricRoleHOW method archetypes() { $archetypes } - + method new(*%named) { nqp::findmethod(NQPMu, 'BUILDALL')(nqp::create(self), |%named) } @@ -44,28 +44,28 @@ class Perl6::Metamodel::ParametricRoleHOW } self.add_stash($type); } - + method parameterize($obj, *@pos_args, *%named_args) { $currier.new_type($obj, |@pos_args, |%named_args) } - + method set_body_block($obj, $block) { $!body_block := $block } - + method body_block($obj) { $!body_block } - + method signatured($obj) { $!signatured } - + method set_group($obj, $group) { $!group := $group; $!in_group := 1; } - + method group($obj) { $!in_group ?? $!group !! $obj } @@ -85,11 +85,11 @@ class Perl6::Metamodel::ParametricRoleHOW $!composed := 1; $obj } - + method is_composed($obj) { $!composed } - + method roles($obj, :$transitive = 1) { if $transitive { my @result; @@ -105,11 +105,11 @@ class Perl6::Metamodel::ParametricRoleHOW self.roles_to_compose($obj) } } - + method role_typecheck_list($obj) { @!role_typecheck_list } - + method type_check($obj, $checkee) { my $decont := nqp::decont($checkee); if $decont =:= $obj.WHAT { @@ -130,7 +130,7 @@ class Perl6::Metamodel::ParametricRoleHOW } 0 } - + method specialize($obj, *@pos_args, *%named_args) { # We only allow one specialization of a role to take place at a time, # since the body block captures the methods into its lexical scope, @@ -157,18 +157,18 @@ class Perl6::Metamodel::ParametricRoleHOW self.specialize_with($obj, $type_env, @pos_args) }) } - + method specialize_with($obj, $type_env, @pos_args) { # Create a concrete role. my $conc := $concrete.new_type(:roles([$obj]), :name(self.name($obj))); - + # Go through attributes, reifying as needed and adding to # the concrete role. for self.attributes($obj, :local(1)) { $conc.HOW.add_attribute($conc, $_.is_generic ?? $_.instantiate_generic($type_env) !! $_); } - + # Go through methods and instantiate them; we always do this # unconditionally, since we need the clone anyway. for self.method_table($obj) { @@ -183,7 +183,7 @@ class Perl6::Metamodel::ParametricRoleHOW for self.multi_methods_to_incorporate($obj) { $conc.HOW.add_multi_method($conc, $_.name, $_.code.instantiate_generic($type_env)) } - + # Roles done by this role need fully specializing also; all # they'll be missing is the target class (e.g. our first arg). for self.roles_to_compose($obj) { @@ -194,7 +194,7 @@ class Perl6::Metamodel::ParametricRoleHOW } $conc.HOW.add_role($conc, $r.HOW.specialize($r, @pos_args[0])); } - + # Pass along any parents that have been added, resolving them in # the case they're generic (role Foo[::T] is T { }) for self.parents($obj, :local(1)) { @@ -204,7 +204,7 @@ class Perl6::Metamodel::ParametricRoleHOW } $conc.HOW.add_parent($conc, $p); } - + # Resolve any array type being passed along (only really used in the # punning case, since roles are the way we get generic types). if self.is_array_type($obj) { @@ -214,11 +214,11 @@ class Perl6::Metamodel::ParametricRoleHOW } $conc.HOW.set_array_type($conc, $at); } - + $conc.HOW.compose($conc); return $conc; } - + method mro($obj) { [$obj] } diff --git a/src/Perl6/Metamodel/PrivateMethodContainer.nqp b/src/Perl6/Metamodel/PrivateMethodContainer.nqp index d201e9dbbbd..35a96912634 100644 --- a/src/Perl6/Metamodel/PrivateMethodContainer.nqp +++ b/src/Perl6/Metamodel/PrivateMethodContainer.nqp @@ -1,6 +1,6 @@ role Perl6::Metamodel::PrivateMethodContainer { has %!private_methods; - + # Adds a private method. method add_private_method($obj, $name, $code) { if nqp::existskey(%!private_methods, $name) { @@ -9,12 +9,12 @@ role Perl6::Metamodel::PrivateMethodContainer { } %!private_methods{$name} := $code; } - + # Gets the table of private methods. method private_method_table($obj) { %!private_methods } - + # Locates a private method, and hands back null if it doesn't exist. method find_private_method($obj, $name) { nqp::existskey(%!private_methods, $name) ?? diff --git a/src/Perl6/Metamodel/REPRComposeProtocol.nqp b/src/Perl6/Metamodel/REPRComposeProtocol.nqp index 02b4d349703..0fc040d63f7 100644 --- a/src/Perl6/Metamodel/REPRComposeProtocol.nqp +++ b/src/Perl6/Metamodel/REPRComposeProtocol.nqp @@ -1,6 +1,6 @@ role Perl6::Metamodel::REPRComposeProtocol { has $!composed_repr; - + method compose_repr($obj) { unless $!composed_repr { # Is it an array type? @@ -11,21 +11,21 @@ role Perl6::Metamodel::REPRComposeProtocol { nqp::composetype(nqp::decont($obj), nqp::hash('array', nqp::hash('type', nqp::decont(self.array_type($obj))))); } - + # Otherwise, presume it's an attribute type. else { # Use any attribute information to produce attribute protocol # data. The protocol consists of an array... my @repr_info; - + # ...which contains an array per MRO entry... for self.mro($obj) -> $type_obj { my @type_info; nqp::push(@repr_info, @type_info); - + # ...which in turn contains the current type in the MRO... nqp::push(@type_info, $type_obj); - + # ...then an array of hashes per attribute... my @attrs; nqp::push(@type_info, @attrs); @@ -51,15 +51,15 @@ role Perl6::Metamodel::REPRComposeProtocol { } nqp::push(@attrs, %attr_info); } - + # ...followed by a list of immediate parents. nqp::push(@type_info, $type_obj.HOW.parents($type_obj, :local)); } - + # Compose the representation using it. nqp::composetype(nqp::decont($obj), nqp::hash('attribute', @repr_info)); } - + $!composed_repr := 1; } } diff --git a/src/Perl6/Metamodel/RoleContainer.nqp b/src/Perl6/Metamodel/RoleContainer.nqp index d6468f6eb3e..97638e726fd 100644 --- a/src/Perl6/Metamodel/RoleContainer.nqp +++ b/src/Perl6/Metamodel/RoleContainer.nqp @@ -1,10 +1,10 @@ role Perl6::Metamodel::RoleContainer { has @!roles_to_compose; - + method add_role($obj, $role) { @!roles_to_compose[+@!roles_to_compose] := $role } - + method roles_to_compose($obj) { @!roles_to_compose } diff --git a/src/Perl6/Metamodel/RolePunning.nqp b/src/Perl6/Metamodel/RolePunning.nqp index 60550136294..20689c8b2e0 100644 --- a/src/Perl6/Metamodel/RolePunning.nqp +++ b/src/Perl6/Metamodel/RolePunning.nqp @@ -1,33 +1,33 @@ role Perl6::Metamodel::RolePunning { # Meta-object we use to make a pun. my $pun_meta; - + # Exceptions to the punning. Hash of name to actual object to call on. my %exceptions; - + # The pun for the current meta-object. has $!pun; - + # Did we make a pun? has $!made_pun; - + # Representation to pun to, if any. has str $!pun_repr; - + # Configures the punning. method configure_punning($my_pun_meta, %my_exceptions) { $pun_meta := $my_pun_meta; %exceptions := %my_exceptions; } - + method set_pun_repr($obj, $repr) { $!pun_repr := $repr } - + method pun_repr($obj) { $!pun_repr } - + # Produces the pun. method make_pun($obj) { my $pun := $!pun_repr @@ -41,7 +41,7 @@ role Perl6::Metamodel::RolePunning { } $pun } - + # Returns the pun (only creating it if it wasn't already created) method pun($obj) { unless $!made_pun { @@ -55,7 +55,7 @@ role Perl6::Metamodel::RolePunning { method inheritalize($obj) { self.pun($obj) } - + # Do a pun-based dispatch. If we pun, return a thunk that will delegate. method find_method($obj, $name) { if nqp::existskey(%exceptions, $name) { diff --git a/src/Perl6/Metamodel/RoleToClassApplier.nqp b/src/Perl6/Metamodel/RoleToClassApplier.nqp index b7c70185c8e..c92d8ba31c8 100644 --- a/src/Perl6/Metamodel/RoleToClassApplier.nqp +++ b/src/Perl6/Metamodel/RoleToClassApplier.nqp @@ -20,7 +20,7 @@ my class RoleToClassApplier { return 0; } } - + sub has_private_method($target, $name) { my %pmt := $target.HOW.private_method_table($target); return nqp::existskey(%pmt, $name) @@ -137,7 +137,7 @@ my class RoleToClassApplier { } } } - + # Compose in any multi-methods, looking for any requirements and # ensuring they are met. if nqp::can($to_compose_meta, 'multi_methods_to_incorporate') { @@ -193,7 +193,7 @@ my class RoleToClassApplier { } $target.HOW.add_attribute($target, $_); } - + # Compose in any parents. if nqp::can($to_compose_meta, 'parents') { my @parents := $to_compose_meta.parents($to_compose, :local(1)); @@ -201,7 +201,7 @@ my class RoleToClassApplier { $target.HOW.add_parent($target, $_); } } - + # Copy any array_type. if nqp::can($target.HOW, 'is_array_type') && !$target.HOW.is_array_type($target) { if nqp::can($to_compose_meta, 'is_array_type') { @@ -210,7 +210,7 @@ my class RoleToClassApplier { } } } - + 1; } } diff --git a/src/Perl6/Metamodel/RoleToRoleApplier.nqp b/src/Perl6/Metamodel/RoleToRoleApplier.nqp index b115bc548df..0ec5fd7998a 100644 --- a/src/Perl6/Metamodel/RoleToRoleApplier.nqp +++ b/src/Perl6/Metamodel/RoleToRoleApplier.nqp @@ -4,7 +4,7 @@ my class RoleToRoleApplier { unless +@roles { return []; } - + # Aggregate all of the methods sharing names, eliminating # any duplicates (a method can't collide with itself). my %meth_info; @@ -75,7 +75,7 @@ my class RoleToRoleApplier { @impl_meths.push($_); } } - + # If there's still more than one possible - add to collisions list. # If we got down to just one, add it. If they were all requirements, # just choose one. @@ -91,7 +91,7 @@ my class RoleToRoleApplier { } } } - + # Process private method list. if nqp::can($target.HOW, 'private_method_table') { my %target_priv_meth_info := $target.HOW.private_method_table($target); @@ -228,7 +228,7 @@ my class RoleToRoleApplier { $target.HOW.add_attribute($target, $add_attr); } } - + # Any parents can also just be copied over. if nqp::can($how, 'parents') { my @parents := $how.parents($_, :local(1)); diff --git a/src/Perl6/Metamodel/SubsetHOW.nqp b/src/Perl6/Metamodel/SubsetHOW.nqp index 705aa91892a..aff9f6296ee 100644 --- a/src/Perl6/Metamodel/SubsetHOW.nqp +++ b/src/Perl6/Metamodel/SubsetHOW.nqp @@ -5,7 +5,7 @@ class Perl6::Metamodel::SubsetHOW { # The subset type or nominal type that we refine. has $!refinee; - + # The block implementing the refinement. has $!refinement; @@ -13,11 +13,11 @@ class Perl6::Metamodel::SubsetHOW method archetypes() { $archetypes } - + method new(*%named) { nqp::findmethod(NQPMu, 'BUILDALL')(nqp::create(self), |%named) } - + method BUILD(:$refinee, :$refinement) { $!refinee := $refinee; $!refinement := $refinement; @@ -30,7 +30,7 @@ class Perl6::Metamodel::SubsetHOW nqp::settypecheckmode($type, 2); self.add_stash($type) } - + method set_of($obj, $refinee) { my $archetypes := $!refinee.HOW.archetypes; unless $archetypes.nominal || $archetypes.nominalizable { @@ -48,11 +48,11 @@ class Perl6::Metamodel::SubsetHOW } } } - + method refinee($obj) { $!refinee } - + method refinement($obj) { $!refinement } @@ -61,26 +61,26 @@ class Perl6::Metamodel::SubsetHOW $!refinee.isa($type) || nqp::p6bool(nqp::istrue($type.HOW =:= self)) } - + method nominalize($obj) { $!refinee.HOW.archetypes.nominal ?? $!refinee !! $!refinee.HOW.nominalize($!refinee) } - + # Should have the same methods of the (eventually nominal) type # that we refine. (For the performance win, work out a way to # steal its method cache.) method find_method($obj, $name) { $!refinee.HOW.find_method($!refinee, $name) } - + # Do check when we're on LHS of smartmatch (e.g. Even ~~ Int). method type_check($obj, $checkee) { nqp::p6bool(nqp::istrue($checkee.HOW =:= self) || nqp::istype($!refinee, $checkee)) } - + # Here we check the value itself (when on RHS on smartmatch). method accepts_type($obj, $checkee) { nqp::p6bool( diff --git a/src/Perl6/Metamodel/Trusting.nqp b/src/Perl6/Metamodel/Trusting.nqp index 5a227b950ed..d0dce275356 100644 --- a/src/Perl6/Metamodel/Trusting.nqp +++ b/src/Perl6/Metamodel/Trusting.nqp @@ -2,17 +2,17 @@ role Perl6::Metamodel::Trusting { # Who do we trust? has @!trustees; - + # Adds a type that we trust. method add_trustee($obj, $trustee) { @!trustees[+@!trustees] := $trustee; } - + # Introspect the types that we trust. method trusts($obj) { @!trustees } - + # Checks if we trust a certain type. Can be used by the compiler # to check if a private call is allowable. method is_trusted($obj, $claimant) { @@ -20,14 +20,14 @@ role Perl6::Metamodel::Trusting { if $claimant.WHAT =:= $obj.WHAT { return 1; } - + # Otherwise, look through our trustee list. for @!trustees { if $_.WHAT =:= $claimant.WHAT { return 1; } } - + # If we get here, not trusted. 0 } diff --git a/src/Perl6/Metamodel/TypePretense.nqp b/src/Perl6/Metamodel/TypePretense.nqp index 7c839f2b8b5..d8c3bc131af 100644 --- a/src/Perl6/Metamodel/TypePretense.nqp +++ b/src/Perl6/Metamodel/TypePretense.nqp @@ -1,14 +1,14 @@ role Perl6::Metamodel::TypePretense { my @pretending; - + method pretend_to_be(@types) { @pretending := @types; } - + method pretending_to_be() { @pretending } - + method type_check($obj, $checkee) { if $obj =:= $checkee { return 1; diff --git a/src/Perl6/Pod.nqp b/src/Perl6/Pod.nqp index 0f2e9dc69ff..46e316f57c5 100644 --- a/src/Perl6/Pod.nqp +++ b/src/Perl6/Pod.nqp @@ -18,7 +18,7 @@ class Perl6::Pod { my $csep2 := /\h '=' \h/; my $csep3 := /\h '_' \h/; my $csep4 := /\h \h/; - + my $has_table_col_sep := / [ | $csep0 @@ -33,7 +33,7 @@ class Perl6::Pod { my %table_pod_line_info := []; # save debug info on each incoming line my $max_num_table_row_cells := 0; # all table rows must have the same number of cells my $error_msg := ''; - + our sub document($/, $what, $with, :$leading, :$trailing) { if $leading && $trailing || !$leading && !$trailing { nqp::die("You must provide one of leading or trailing to Perl6::Pod::document"); @@ -323,7 +323,7 @@ class Perl6::Pod { } } } - + # chomp (this is needed for later processing, but may be moved later) @rows[$i] := subst(@rows[$i], /\n$/, ''); $i := $i + 1; From 33e113a2afcf14134911ad4e6f2c1793ead076a6 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Tue, 26 Sep 2017 13:39:30 +0200 Subject: [PATCH 160/692] Make auto-generated accessors have :D on the invocant This should provide for a better error message when called as a class method. It doesn't yet, though, but at least the signature is correct. So this is still a work in progress. --- src/Perl6/World.nqp | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index 5e56702bf53..65772a8b672 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -2994,15 +2994,17 @@ class Perl6::World is HLL::World { $!w.cur_lexpad()[0].push($block); my $sig; - if $package_type =:= $!acc_sig_cache_type { + my $invocant_type := + $!w.create_definite_type( $!w.find_symbol(['Metamodel','DefiniteHOW']), $package_type, 1 ); + if $invocant_type =:= $!acc_sig_cache_type { $sig := $!acc_sig_cache; } else { my %sig_info := nqp::hash('parameters', []); $sig := $!w.create_signature_and_params(NQPMu, %sig_info, - $block, 'Any', :method, invocant_type => $package_type); + $block, 'Any', :method, :$invocant_type); $!acc_sig_cache := $sig; - $!acc_sig_cache_type := $package_type; + $!acc_sig_cache_type := $invocant_type; } my $code := $!w.create_code_object($block, 'Method', $sig); From a92d0369f858f57725996ab113fce090a5a35348 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Tue, 26 Sep 2017 16:14:53 +0000 Subject: [PATCH 161/692] Fix poisoning of chain depth detection Affects all `chain` ops. Makes 6x faster: `2 < 2; 3 < 3` (10_000_000 iterations) Makes 36x faster: `2 < 3; 2 < 3 < 4; 2 (elem) 4` (1000_000 iterations) There is logic that converts a `chain` op with two non-chain kids into a `call` op. This `call` op is then optimized and we get out of `visit_op`, but... we never decrease the `chain` depth. This means after the first `chain` op is optimized that way, we never optimize any other chain ops, so they miss out on constant folding and other optimizations. This commit fixes the issue and passes stresstest, but I suspect the descrease of chain depth needs to be done somewhere else to make it more polished. I tried decreasing it right inside the `chain`->`call` optimization, but that had stresstest fallout. I also tried omiting the `&& $!chain_depth == 1` condition in this patch, but that too had a bit of fall out. I'm guessing there's a missing chain depth decrement somewhere inside optimize_call/optimize_nameless_call. --- src/Perl6/Optimizer.nqp | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/Perl6/Optimizer.nqp b/src/Perl6/Optimizer.nqp index 4303d259e41..458fff933af 100644 --- a/src/Perl6/Optimizer.nqp +++ b/src/Perl6/Optimizer.nqp @@ -1336,7 +1336,11 @@ class Perl6::Optimizer { my $opt_result := $op.name eq '' ?? self.optimize_nameless_call($op) !! self.optimize_call($op); - return $opt_result if $opt_result; + if $opt_result { + $!chain_depth := $!chain_depth - 1 + if $op.op eq 'chain' && $!chain_depth == 1; + return $opt_result; + } } # If it's a private method call, we can sometimes resolve it at From e5c1746232687247e0214c0a1437892534a4b7bd Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Tue, 26 Sep 2017 18:08:26 +0200 Subject: [PATCH 162/692] Liberalize await handle result argument type So that `await` on an already kept Promise, when kept with a non-Any value, will not explode. --- src/core/Awaitable.pm | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/core/Awaitable.pm b/src/core/Awaitable.pm index 02ee2722cca..10fdedb6894 100644 --- a/src/core/Awaitable.pm +++ b/src/core/Awaitable.pm @@ -24,20 +24,20 @@ my role Awaitable::Handle { has Mu $.result; has Exception $.cause; - method already-success(\result) { + method already-success(Mu \result) { nqp::create(self)!already-success(result) } - method !already-success(\result) { + method !already-success(Mu \result) { $!already := True; $!success := True; $!result := result; self } - method already-failure(\cause) { + method already-failure(Mu \cause) { self.CREATE!already-failure(cause) } - method !already-failure(\cause) { + method !already-failure(Mu \cause) { $!already := True; $!success := False; $!cause := cause; From 6e42b37e1b2384ad67d45d59a51da5b092d8fc7c Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Tue, 26 Sep 2017 18:12:31 +0200 Subject: [PATCH 163/692] Add "no queue progress" deadlock heuristic Will want some further tuning, but this handles the case where we do not start enough threads because we are working hard on, say, events fired by the timer queue, but not making any real progress because the general queue is not making any progress at all. Fixes hang that some low-core-count users observed in S17-supply/syntax.t. --- src/core/ThreadPoolScheduler.pm | 26 +++++++++++++++++++++++++- 1 file changed, 25 insertions(+), 1 deletion(-) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index 05d457e1a89..00541063919 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -197,6 +197,9 @@ my class ThreadPoolScheduler does Scheduler { # Working is 1 if the worker is currently busy, 0 if not. has int $.working; + # Number of times take-completed has returned zero in a row. + has int $.times-nothing-completed; + # Resets the completed to zero. method take-completed() { #?if moar @@ -207,6 +210,12 @@ my class ThreadPoolScheduler does Scheduler { my int $taken = $!completed; $!completed = 0; #?endif + if $taken == 0 { + $!times-nothing-completed++; + } + else { + $!times-nothing-completed = 0; + } $taken } @@ -495,9 +504,11 @@ my class ThreadPoolScheduler does Scheduler { # is at lesat one worker free to process things in the queue, so we # don't need to add one. my int $total-completed; + my int $total-times-nothing-completed; worker-list.map: { return unless .working; $total-completed += .take-completed; + $total-times-nothing-completed += .times-nothing-completed; } # If we didn't complete anything, then consider adding more threads. @@ -513,9 +524,22 @@ my class ThreadPoolScheduler does Scheduler { # Otherwise, consider utilization. If it's very little then a # further thread may be needed for deadlock breaking. elsif $per-core-util < 2 { - scheduler-debug "Heuristic deadlock situation detected"; + scheduler-debug "Heuristic low utilization deadlock situation detected"; add-worker(); } + + # Another form of deadlock can happen when one kind of queue + # is being processed but another is not. In that case, the + # number of iterations since nothing was completed by any + # worker will grow. + else { + my int $average-times-nothing-completed = + $total-times-nothing-completed div (worker-list.elems || 1); + if $average-times-nothing-completed > 20 { + scheduler-debug "Heuristic queue progress deadlock situation detected"; + add-worker(); + } + } } else { scheduler-debug "Will not add extra worker; hit $!max_threads thread limit"; From c9f1e05a5b0b775cf477703fbee0d929be373891 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Tue, 26 Sep 2017 16:23:19 +0000 Subject: [PATCH 164/692] Simplify statement The conditional restricts the value to 1, so we know the result already, no need to calculate it. --- src/Perl6/Optimizer.nqp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Perl6/Optimizer.nqp b/src/Perl6/Optimizer.nqp index 458fff933af..b81801778a9 100644 --- a/src/Perl6/Optimizer.nqp +++ b/src/Perl6/Optimizer.nqp @@ -1337,7 +1337,7 @@ class Perl6::Optimizer { ?? self.optimize_nameless_call($op) !! self.optimize_call($op); if $opt_result { - $!chain_depth := $!chain_depth - 1 + $!chain_depth := 0 if $op.op eq 'chain' && $!chain_depth == 1; return $opt_result; } From 6ec21cb47394527983f48282d9a61319a4cb1f26 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Tue, 26 Sep 2017 17:18:07 +0000 Subject: [PATCH 165/692] =?UTF-8?q?Restore=20perf=20of=20=E2=89=A5,=20?= =?UTF-8?q?=E2=89=A4,=20and=20=E2=89=A0=20to=20be=20same=20as=20Texas=20ve?= =?UTF-8?q?rsions?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit By having static optimizer change them to Texas variants. Fixes(?) RT#131626: https://rt.perl.org/Ticket/Display.html?id=131626 --- src/Perl6/Optimizer.nqp | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/src/Perl6/Optimizer.nqp b/src/Perl6/Optimizer.nqp index b81801778a9..371ad380945 100644 --- a/src/Perl6/Optimizer.nqp +++ b/src/Perl6/Optimizer.nqp @@ -1376,11 +1376,23 @@ class Perl6::Optimizer { } } + method convert_mexico_op_to_texas($op) { + if $!symbols.is_from_core: $op.name { + my $name := $op.name; + if ($name eq '&infix:<≤>') { $op.name: '&infix:«<=»' } + elsif ($name eq '&infix:<≥>') { $op.name: '&infix:«>=»' } + elsif ($name eq '&infix:<≠>') { $op.name: '&infix:' } + } + } + method optimize_call($op) { # See if we can find the thing we're going to call. my $obj; my int $found := 0; note("method optimize_call $!void_context\n" ~ $op.dump) if $!debug; + + self.convert_mexico_op_to_texas($op); + try { $obj := $!symbols.find_lexical($op.name); $found := 1; From 0961abe8fff033acb2f1805088cd2350c64a5eea Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Tue, 26 Sep 2017 19:16:22 +0000 Subject: [PATCH 166/692] Fix infinilop in .^roles of class that does Rational Bug find: https://irclog.perlgeek.de/perl6/2017-09-26#i_15219316 --- src/core/Rational.pm | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/core/Rational.pm b/src/core/Rational.pm index 625f2adb9f0..49cd2af8fb4 100644 --- a/src/core/Rational.pm +++ b/src/core/Rational.pm @@ -1,6 +1,4 @@ -my role Rational does Rational[Int] { } -my role Rational[::T] does Rational[T,T] { } -my role Rational[::NuT, ::DeT] does Real { +my role Rational[::NuT = Int, ::DeT = ::("NuT")] does Real { has NuT $.numerator = 0; has DeT $.denominator = 1; From 9dba498f7fb93710803d0dca0fb30b6b813a9b19 Mon Sep 17 00:00:00 2001 From: Samantha McVey Date: Tue, 26 Sep 2017 17:11:48 -0700 Subject: [PATCH 167/692] Bump NQP/Moar for uniname fixes Adds hex digits to end of non-unique Unicode names, and returns noncharacter property for noncharacters as well as not returning except for codepoints that are less than 0. NQP changes: 2017.09-18-g59612c4..2017.09-36-g1f0a598e3 1f0a598e3 Bump MoarVM to get uniname fixes 8e780a82c Test that division by zero throws an exception 4513eb66c [js] Make div_i by zero throw an exception 771c89339 [js] Implement int16 and int32 a254cd808 Test nqp::base_I with base 36 259998e51 [js] Make nqp::base_I handle bigger bases 723b8aa2b [js] Stop skipping bitshift tests 3365b793d [js] Fix bit shifts a2581d130 [js] Allow a HLL to override unboxing 2050e517c [js] Make nqp::ord return the full codepoint fdf62277a Test nqp::iscont{_i, _n, _s} on native attribute refs db7bffa3b [js] Make nqp::iscont{_i, _n, _s} return 0 on type objects 4cca70236 Test nqp::pow_n(1, nqp::nan) f2ad8c17b [js] Fix 1 ** NaN ef22bf695 Test QAST::NVal with infinities 80f1bcf65 [js] Fix QAST::NVal with an positive of negative infinity 80955d61a [js] Implementing overriding of an op just for a given hll cd588c17d [jvm] Add note about requirement for jdk 1.8 MoarVM changes: 2017.09.1-32-g9749b0f..2017.09.1-46-g27d3d01e 27d3d01e Add hex digits to the end of non-unique Unicode names c40be90d jit: getlex_o shall give VNMull rather than null 454e9148 Add future info to Collation docs. Language/natural sort bec972ac Fix hint ecc33760 \#define sa_family_t for Windows d43ea5a8 Define flags as socket family and use getaddrinfo hints --- tools/build/NQP_REVISION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/build/NQP_REVISION b/tools/build/NQP_REVISION index 90892943756..c5c8f5e3164 100644 --- a/tools/build/NQP_REVISION +++ b/tools/build/NQP_REVISION @@ -1 +1 @@ -2017.09-18-g59612c4 +2017.09-36-g1f0a598e3 \ No newline at end of file From bd530108c47ddf6b64a31a91e8e60d470e77f270 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Wed, 27 Sep 2017 12:30:19 +0200 Subject: [PATCH 168/692] Fix CurrentThreadScheduler error handling It is used as a type object rather than an instance in quite some tests, and so very possibly in the wild too. So make sure that it doesn't explode due to trying to look up an error handler from a type object. --- src/core/CurrentThreadScheduler.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/CurrentThreadScheduler.pm b/src/core/CurrentThreadScheduler.pm index 7bcf0e4e9a7..bc1ba9a54c0 100644 --- a/src/core/CurrentThreadScheduler.pm +++ b/src/core/CurrentThreadScheduler.pm @@ -17,7 +17,7 @@ my class CurrentThreadScheduler does Scheduler { my $delay = $at ?? $at - now !! $in; sleep $delay if $delay; &catch //= - self.uncaught_handler // -> $ex { self.handle_uncaught($ex) }; + (self && self.uncaught_handler) // -> $ex { self.handle_uncaught($ex) }; for 1 .. $times { code(); From 9af5607d523ec9ba40921ad3b09206cf74f3ce37 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Wed, 27 Sep 2017 13:03:26 +0200 Subject: [PATCH 169/692] Start using $*AWAITER in `await` in 6.c But set an additional flag indicating that we should really block, so we still get the 6.c semantics, just in terms of the new factoring. This means that the parts of the new supply concurrency model that depend on the use of $*AWAITER will now work out with 6.c code that does an `await` in the mainline of a `supply` block. It also means that we'll from today be exercising much of the code that makes up 6.d non-blocking await, except the bit in ThreadPoolScheduler that actually does the non-blocking part of the job. --- src/core/ThreadPoolScheduler.pm | 4 +-- src/core/asyncops.pm | 46 ++++++++++++++++++++++++++++----- 2 files changed, 42 insertions(+), 8 deletions(-) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index 00541063919..b7835e19dcf 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -33,7 +33,7 @@ my class ThreadPoolScheduler does Scheduler { } method await(Awaitable:D $a) { - holding-locks() + holding-locks() || !nqp::isnull(nqp::getlexdyn('$*RAKUDO-AWAIT-BLOCKING')) ?? Awaiter::Blocking.await($a) !! self!do-await($a) } @@ -63,7 +63,7 @@ my class ThreadPoolScheduler does Scheduler { } method await-all(Iterable:D \i) { - holding-locks() + holding-locks() || !nqp::isnull(nqp::getlexdyn('$*RAKUDO-AWAIT-BLOCKING')) ?? Awaiter::Blocking.await-all(i) !! self!do-await-all(i) } diff --git a/src/core/asyncops.pm b/src/core/asyncops.pm index e16d9321325..0dc5ec2bd02 100644 --- a/src/core/asyncops.pm +++ b/src/core/asyncops.pm @@ -1,7 +1,17 @@ # Waits for a promise to be kept or a channel to be able to receive a value -# and, once it can, unwraps or returns the result. This should be made more -# efficient by using continuations to suspend any task running in the thread -# pool that blocks; for now, this cheat gets the basic idea in place. +# and, once it can, unwraps or returns the result. Under Perl 6.c, await will +# really block the calling thread. In 6.d, if the thread is on the thread pool +# then a continuation will be taken, and the thread is freed up. + +my role X::Await::Died { + has $.await-backtrace; + multi method gist(::?CLASS:D:) { + "An operation first awaited:\n" ~ + ((try $!await-backtrace ~ "\n") // '') ~ + "Died with the exception:\n" ~ + callsame().indent(4) + } +} proto sub await(|) { * } multi sub await() { @@ -13,10 +23,34 @@ multi sub await(Any:U $x) { multi sub await(Any:D $x) { die "Must specify a Promise, Channel, or Supply to await on (got a $x.^name())"; } +multi sub await(Promise:D $p) { + CATCH { + unless nqp::istype($_, X::Await::Died) { + ($_ but X::Await::Died(Backtrace.new(5))).rethrow + } + } + my $*RAKUDO-AWAIT-BLOCKING := True; + $*AWAITER.await($p) +} +multi sub await(Channel:D $c) { + CATCH { + unless nqp::istype($_, X::Await::Died) { + ($_ but X::Await::Died(Backtrace.new(5))).rethrow + } + } + my $*RAKUDO-AWAIT-BLOCKING := True; + $*AWAITER.await($c) +} +multi sub await(Supply:D $s) { + CATCH { + unless nqp::istype($_, X::Await::Died) { + ($_ but X::Await::Died(Backtrace.new(5))).rethrow + } + } + my $*RAKUDO-AWAIT-BLOCKING := True; + $*AWAITER.await($s) +} multi sub await(Iterable:D $i) { $i.eager.map({ await $_ }) } -multi sub await(Promise:D $p) { $p.result } -multi sub await(Channel:D $c) { $c.receive } -multi sub await(Supply:D $s) { $s.wait } multi sub await(*@awaitables) { @awaitables.eager.map({await $_}) } sub awaiterator(@promises) { From 7d830d5c18c65789afd406c89dec35f74fc26ed0 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Wed, 27 Sep 2017 13:02:10 +0000 Subject: [PATCH 170/692] Add 6.c test file list --- t/spectest.data.6.c | 1303 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 1303 insertions(+) create mode 100644 t/spectest.data.6.c diff --git a/t/spectest.data.6.c b/t/spectest.data.6.c new file mode 100644 index 00000000000..87dc69cb319 --- /dev/null +++ b/t/spectest.data.6.c @@ -0,0 +1,1303 @@ +# This is a list of all spec tests that are expected to pass. +# +# Empty lines and those beginning with a # are ignored +# +# We intend to include *all* tests from roast, even when we +# skip most of the tests or the entire test file. To verify +# we are running all tests, run: +# +# perl tools/update-passing-test-data.pl +# +# If a file appears in the output of the script, it is not run +# by default. It may need to be fudged in order to run successfully. +# Open an RT when necessary as part of the fudge process, using the +# RT in the fudge message, and then add the test file to this file, sorted. +# +# Each file may have one or more markers that deselects the test: +# long - run tests unless --quick +# stress - run tests only if --stress +# moar - run tests only for MoarVM backend +# See the "make quicktest" and "make stresstest" targets in +# build/Makefile.in for examples of use. + + +S01-perl-5-integration/array.t # perl5 +S01-perl-5-integration/basic.t # perl5 +S01-perl-5-integration/class.t # perl5 +S01-perl-5-integration/context.t # perl5 +S01-perl-5-integration/eval_lex.t # perl5 +S01-perl-5-integration/exception_handling.t # perl5 +S01-perl-5-integration/hash.t # perl5 +S01-perl-5-integration/import.t # perl5 +S01-perl-5-integration/method.t # perl5 +S01-perl-5-integration/return.t # perl5 +S01-perl-5-integration/roundtrip.t # perl5 +S01-perl-5-integration/strings.t # perl5 +S01-perl-5-integration/subs.t # perl5 +S02-lexical-conventions/begin_end_pod.t +S02-lexical-conventions/bom.t +S02-lexical-conventions/comments.t +S02-lexical-conventions/end-pod.t +S02-lexical-conventions/minimal-whitespace.t +S02-lexical-conventions/one-pass-parsing.t +S02-lexical-conventions/pod-in-multi-line-exprs.t +S02-lexical-conventions/sub-block-parsing.t +S02-lexical-conventions/unicode.t +S02-lexical-conventions/unicode-whitespace.t +S02-lexical-conventions/unspace.t +S02-lists/indexing.t +S02-lists/tree.t +S02-literals/adverbs.t +S02-literals/allomorphic.t +S02-literals/array-interpolation.t +S02-literals/autoref.t +S02-literals/char-by-name.t +S02-literals/char-by-number.t +S02-literals/fmt-interpolation.t +S02-literals/hash-interpolation.t +S02-literals/heredocs.t +S02-literals/hex_chars.t +S02-literals/listquote.t +S02-literals/listquote-whitespace.t +S02-literals/misc-interpolation.t +S02-literals/numeric.t +S02-literals/pair-boolean.t +S02-literals/pairs.t +S02-literals/pod.t +S02-literals/quoting.t +S02-literals/quoting-unicode.t +S02-literals/radix.t +S02-literals/string-interpolation.t +S02-literals/sub-calls.t +S02-literals/subscript.t +S02-literals/types.t +S02-literals/underscores.t +S02-literals/version.t +S02-magicals/78258.t +S02-magicals/args.t +S02-magicals/block.t +S02-magicals/DISTRO.t +S02-magicals/dollar_bang.t +S02-magicals/dollar-underscore.t +S02-magicals/env.t +S02-magicals/file_line.t +S02-magicals/GROUP.t +S02-magicals/KERNEL.t +S02-magicals/PERL.t +S02-magicals/pid.t +S02-magicals/progname.t +S02-magicals/sub.t +S02-magicals/subname.t +S02-magicals/USER.t +S02-magicals/VM.t +S02-names/bare-sigil.t +S02-names/caller.t +S02-names/identifier.t +S02-names/indirect.t +S02-names/is_cached.t +S02-names/is_default.t +S02-names/is_dynamic.t +S02-names/name.t +S02-names/our.t +S02-names/pseudo.t +S02-names/strict.t +S02-names/symbolic-deref.t +S02-names-vars/contextual.t +S02-names-vars/fmt.t +S02-names-vars/list_array_perl.t +S02-names-vars/names.t +S02-names-vars/perl.t +S02-names-vars/signature.t +S02-names-vars/variables-and-packages.t +S02-names-vars/varnames.t +S02-one-pass-parsing/less-than.t +S02-one-pass-parsing/misc.t +S02-packages/package-lookup.t +S02-types/anon_block.t +S02-types/array_extending.t +S02-types/array_ref.t +S02-types/array-shapes.t +S02-types/array.t +S02-types/assigning-refs.t +S02-types/autovivification.t +S02-types/bag-iterator.t +S02-types/bag.t +S02-types/baggy.t +S02-types/baghash.t +S02-types/bool.t +S02-types/built-in.t +S02-types/capture.t +S02-types/catch_type_cast_mismatch.t +S02-types/compact.t +S02-types/declare.t +S02-types/fatrat.t +S02-types/flattening.t +S02-types/hash_ref.t +S02-types/hash.t +S02-types/infinity.t +S02-types/instants-and-durations.t +S02-types/int-uint.t +S02-types/is-type.t +S02-types/isDEPRECATED.t +S02-types/keyhash.t +S02-types/lazy-lists.t +S02-types/lists.t +S02-types/mix-iterator.t +S02-types/mix.t +S02-types/mixhash.t +S02-types/mixed_multi_dimensional.t +S02-types/mu.t +S02-types/multi_dimensional_array.t +S02-types/nan.t +S02-types/native.t +S02-types/nested_arrays.t +S02-types/nested_pairs.t +S02-types/nil.t +S02-types/num.t +S02-types/pair.t +S02-types/list.t +S02-types/parsing-bool.t +S02-types/range-iterator.t +S02-types/range.t +S02-types/resolved-in-setting.t # moar +S02-types/set-iterator.t +S02-types/set.t +S02-types/sethash.t +S02-types/sigils-and-types.t +S02-types/stash.t +S02-types/subscripts_and_context.t +S02-types/subset.t +S02-types/type.t +S02-types/undefined-types.t +S02-types/unicode.t +S02-types/version.t +S02-types/version-stress.t # stress +S02-types/whatever.t +S02-types/WHICH.t +S03-binding/arrays.t +S03-binding/attributes.t +S03-binding/closure.t +S03-binding/hashes.t +S03-binding/nested.t +S03-binding/nonsense.t +S03-binding/ro.t +S03-binding/scalars.t +S03-feeds/basic.t +S03-junctions/associative.t +S03-junctions/autothreading.t +S03-junctions/boolean-context.t +S03-junctions/misc.t +S03-metaops/cross.t +S03-metaops/eager-hyper.t +S03-metaops/hyper.t +S03-metaops/not.t +S03-metaops/reduce.t +S03-metaops/reverse.t +S03-metaops/zip.t +S03-operators/adverbial-modifiers.t +S03-operators/also.t +S03-operators/andthen.t +S03-operators/orelse.t +S03-operators/arith.t +S03-operators/assign-is-not-binding.t +S03-operators/assign.t +S03-operators/autoincrement-range.t +S03-operators/autoincrement.t +S03-operators/autovivification.t +S03-operators/bag.t +S03-operators/basic-types.t +S03-operators/bit.t +S03-operators/boolean-bitwise.t +S03-operators/brainos.t +S03-operators/composition.t +S03-operators/custom.t +S03-operators/buf.t +S03-operators/chained-declarators.t +S03-operators/cmp.t +S03-operators/comparison-simple.t +S03-operators/comparison.t +S03-operators/context-forcers.t +S03-operators/context.t +S03-operators/equality.t +S03-operators/eqv.t +S03-operators/flip-flop.t +S03-operators/gcd.t +S03-operators/div.t +S03-operators/identity.t +S03-operators/increment.t +S03-operators/infixed-function.t +S03-operators/inplace.t +S03-operators/is-divisible-by.t +S03-operators/lcm.t +S03-operators/list-quote-junction.t +S03-operators/minmax.t +S03-operators/misc.t +S03-operators/mix.t +S03-operators/names.t +S03-operators/nesting.t +S03-operators/not.t +S03-operators/notandthen.t +S03-operators/numeric-shift.t +S03-operators/overflow.t +S03-operators/precedence.t +S03-operators/range-basic.t +S03-operators/range-int.t +S03-operators/range.t +S03-operators/reduce-le1arg.t +S03-operators/relational.t +S03-operators/repeat.t +S03-operators/scalar-assign.t +S03-operators/set.t +S03-operators/set_addition.t +S03-operators/set_difference.t +S03-operators/set_elem.t +S03-operators/set_intersection.t +S03-operators/set_multiply.t +S03-operators/set_precedes.t +S03-operators/set_proper_subset.t +S03-operators/set_subset.t +S03-operators/set_symmetric_difference.t +S03-operators/set_union.t +S03-operators/short-circuit.t +S03-operators/so.t +S03-operators/spaceship-and-containers.t +S03-operators/spaceship.t +S03-operators/subscript-adverbs.t +S03-operators/subscript-vs-lt.t +S03-operators/ternary.t +S03-operators/u2212-minus.t +S03-operators/value_equivalence.t +S03-sequence/arity0.t +S03-sequence/arity-2-or-more.t +S03-sequence/basic.t +S03-sequence/limit-arity-2-or-more.t +S03-sequence/misc.t +S03-sequence/nonnumeric.t +S03-smartmatch/any-any.t +S03-smartmatch/any-bool.t +S03-smartmatch/any-callable.t +S03-smartmatch/any-complex.t +S03-smartmatch/any-hash-pair.t +S03-smartmatch/any-method.t +S03-smartmatch/any-num.t +S03-smartmatch/any-pair.t +S03-smartmatch/any-str.t +S03-smartmatch/any-sub.t +S03-smartmatch/any-type.t +S03-smartmatch/array-array.t +S03-smartmatch/array-hash.t +S03-smartmatch/capture-signature.t +S03-smartmatch/disorganized.t +S03-smartmatch/hash-hash.t +S03-smartmatch/range-range.t +S03-smartmatch/regex-hash.t +S03-smartmatch/scalar-hash.t +S03-smartmatch/signature-signature.t +S04-blocks-and-statements/let.t +S04-blocks-and-statements/pointy-rw.t +S04-blocks-and-statements/pointy.t +S04-blocks-and-statements/temp.t +S04-declarations/constant.t +S04-declarations/implicit-parameter.t +S04-declarations/multiple.t +S04-declarations/my.t +S04-declarations/our.t +S04-declarations/smiley.t +S04-declarations/state.t +S04-declarations/will.t +S04-exception-handlers/catch.t +S04-exception-handlers/control.t +S04-exception-handlers/top-level.t +S04-exceptions/control_across_runloop.t +S04-exceptions/exceptions-json.t +S04-exceptions/fail.t +S04-exceptions/pending.t +S04-phasers/ascending-order.t +S04-phasers/begin.t +S04-phasers/check.t +S04-phasers/descending-order.t +S04-phasers/end.t +S04-phasers/enter-leave.t +S04-phasers/eval-in-begin.t +S04-phasers/first.t +S04-phasers/init.t +S04-phasers/in-eval.t +S04-phasers/in-loop.t +S04-phasers/keep-undo.t +S04-phasers/multiple.t +S04-phasers/next.t +S04-phasers/pre-post.t +S04-phasers/rvalue.t +S04-statement-modifiers/for.t +S04-statement-modifiers/given.t +S04-statement-modifiers/if.t +S04-statement-modifiers/unless.t +S04-statement-modifiers/until.t +S04-statement-modifiers/values_in_bool_context.t +S04-statement-modifiers/while.t +S04-statement-modifiers/with.t +S04-statement-modifiers/without.t +S04-statement-parsing/hash.t +S04-statements/do.t +S04-statements/for-scope.t +S04-statements/for.t +S04-statements/for_with_only_one_item.t +S04-statements/gather.t +S04-statements/given.t +S04-statements/if.t +S04-statements/label.t +S04-statements/last.t +S04-statements/loop.t +S04-statements/map-and-sort-in-for.t +S04-statements/next.t +S04-statements/no-implicit-block.t +S04-statements/once.t +S04-statements/quietly.t +S04-statements/redo.t +S04-statements/repeat.t +S04-statements/return.t +S04-statements/sink.t +S04-statements/terminator.t +S04-statements/try.t +S04-statements/unless.t +S04-statements/until.t +S04-statements/when.t +S04-statements/while.t +S04-statements/with.t +S05-capture/alias.t +S05-capture/array-alias.t +S05-capture/caps.t +S05-capture/dot.t +S05-capture/match-object.t +S05-capture/named.t +S05-capture/subrule.t +S05-grammar/action-stubs.t +S05-grammar/example.t +S05-grammar/inheritance.t +S05-grammar/methods.t +S05-grammar/namespace.t +S05-grammar/parse_and_parsefile.t +S05-grammar/polymorphism.t +S05-grammar/protoregex.t +S05-grammar/protos.t +S05-grammar/signatures.t +S05-grammar/ws.t +S05-interpolation/lexicals.t +S05-interpolation/regex-in-variable.t +S05-mass/charsets.t +S05-mass/named-chars.t +S05-mass/properties-block.t +S05-mass/properties-derived.t +S05-mass/properties-general.t +S05-mass/properties-script.t +S05-mass/recursive.t +S05-mass/rx.t +S05-mass/stdrules.t +S05-match/arrayhash.t +S05-match/blocks.t +S05-match/capturing-contexts.t +S05-match/make.t +S05-match/non-capturing.t +S05-match/perl.t +S05-match/positions.t +S05-metachars/closure.t +S05-metachars/line-anchors.t +S05-metachars/newline.t +S05-metachars/tilde.t +S05-metasyntax/angle-brackets.t +S05-metasyntax/assertions.t +S05-metasyntax/changed.t +S05-metasyntax/charset.t +S05-metasyntax/delimiters.t +S05-metasyntax/interpolating-closure.t +S05-metasyntax/litvar.t +S05-metasyntax/longest-alternative.t +S05-metasyntax/lookaround.t +S05-metasyntax/null.t +S05-metasyntax/proto-token-ltm.t +S05-metasyntax/regex.t +S05-metasyntax/repeat.t +S05-metasyntax/sequential-alternation.t +S05-metasyntax/single-quotes.t +S05-metasyntax/unknown.t +S05-metasyntax/unicode-property-pair.t +S05-modifier/continue.t +S05-modifier/counted-match.t +S05-modifier/counted.t +S05-modifier/global.t +S05-modifier/ignorecase.t +S05-modifier/ignorecase-and-ignoremark.t # moar +S05-modifier/ignoremark.t # moar +S05-modifier/ii.t +S05-modifier/my.t +S05-modifier/overlapping.t +S05-modifier/perl5_0.t +S05-modifier/perl5_1.t +S05-modifier/perl5_2.t +S05-modifier/perl5_3.t +S05-modifier/perl5_4.t +S05-modifier/perl5_5.t +S05-modifier/perl5_6.t +S05-modifier/perl5_7.t +S05-modifier/perl5_8.t +S05-modifier/perl5_9.t +S05-modifier/pos.t +S05-modifier/repetition-exhaustive.t +S05-modifier/repetition.t +S05-modifier/samemark.t +S05-modifier/sigspace.t +S05-substitution/67222.t +S05-substitution/match.t +S05-substitution/subst.t +S05-syntactic-categories/new-symbols.t +S05-transliteration/79778.t +S05-transliteration/trans.t +S05-transliteration/with-closure.t +S06-advanced/callframe.t +S06-advanced/callsame.t +S06-advanced/lexical-subs.t +S06-advanced/recurse.t +S06-advanced/return.t +S06-advanced/stub.t +S06-advanced/wrap.t +S06-currying/assuming-and-mmd.t +S06-currying/misc.t +S06-currying/named.t +S06-currying/positional.t +S06-currying/slurpy.t +S06-macros/errors.t +S06-macros/quasi-blocks.t +S06-macros/unquoting.t +S06-macros/opaque-ast.t +S06-multi/by-trait.t +S06-multi/lexical-multis.t +S06-multi/positional-vs-named.t +S06-multi/proto.t +S06-multi/redispatch.t +S06-multi/subsignature.t +S06-multi/syntax.t +S06-multi/type-based.t +S06-multi/unpackability.t +S06-multi/value-based.t +S06-operator-overloading/circumfix.t +S06-operator-overloading/imported-subs.t +S06-operator-overloading/infix.t +S06-operator-overloading/methods.t +S06-operator-overloading/prefix.t +S06-operator-overloading/semicolon.t +S06-operator-overloading/sub.t +S06-operator-overloading/term.t +S06-operator-overloading/workout.t +S06-other/anon-hashes-vs-blocks.t +S06-other/introspection.t +S06-other/main-eval.t +S06-other/main.t +S06-other/main-usage.t +S06-other/main-semicolon.t +S06-other/misc.t +S06-other/pairs-as-lvalues.t +S06-parameters/smiley.t +S06-routine-modifiers/lvalue-subroutines.t +S06-routine-modifiers/native-lvalue-subroutines.t +S06-routine-modifiers/proxy.t +S06-routine-modifiers/scoped-named-subs.t +S06-signature/arity.t +S06-signature/caller-param.t +S06-signature/closure-over-parameters.t +S06-signature/closure-parameters.t +S06-signature/code.t +S06-signature/defaults.t +S06-signature/definite-return.t +S06-signature/errors.t +S06-signature/introspection.t +S06-signature/mixed-placeholders.t +S06-signature/multidimensional.t +S06-signature/multi-invocant.t +S06-signature/named-parameters.t +S06-signature/named-placeholders.t +S06-signature/named-renaming.t +S06-signature/optional.t +S06-signature/outside-subroutine.t +S06-signature/passing-arrays.t +S06-signature/passing-hashes.t +S06-signature/positional-placeholders.t +S06-signature/positional.t +S06-signature/scalar-type.t +S06-signature/shape.t +S06-signature/sigilless.t +S06-signature/slurpy-and-interpolation.t +S06-signature/slurpy-params.t +S06-signature/slurpy-placeholders.t +S06-signature/sub-ref.t +S06-signature/tree-node-parameters.t +S06-signature/type-capture.t +S06-signature/types.t +S06-signature/unpack-array.t +S06-signature/unpack-object.t +S06-signature/unspecified.t +S06-traits/as.t +S06-traits/is-assoc.t +S06-traits/is-copy.t +S06-traits/is-readonly.t +S06-traits/is-rw.t +S06-traits/misc.t +S06-traits/native-is-copy.t +S06-traits/native-is-rw.t +S06-traits/precedence.t +S07-slip/slip.t +S07-iterators/range-iterator.t +S07-hyperrace/hyper.t +S07-hyperrace/race.t +S06-traits/slurpy-is-rw.t +S09-autovivification/autoincrement.t +S09-autovivification/autovivification.t +S09-hashes/objecthash.t +S09-subscript/slice.t +S09-subscript/multidim-assignment.t +S09-multidim/XX-POS-on-dimensioned.t +S09-multidim/XX-POS-on-undimensioned.t +S09-multidim/assign.t +S09-multidim/decl.t +S09-multidim/indexing.t +S09-multidim/methods.t +S09-multidim/subs.t +S09-typed-arrays/arrays.t +S09-typed-arrays/hashes.t +S09-typed-arrays/native.t +S09-typed-arrays/native-decl.t +S09-typed-arrays/native-int.t +S09-typed-arrays/native-num.t +S09-typed-arrays/native-str.t +S10-packages/basic.t +S10-packages/joined-namespaces.t +S10-packages/precompilation.t # slow +S10-packages/require-and-use.t +S10-packages/use-with-class.t +S11-compunit/compunit-dependencyspecification.t +S11-compunit/compunit-repository.t +S11-compunit/rt126904.t +S11-modules/export.t +S11-modules/importing.t +S11-modules/import-multi.t +S11-modules/import-tag.t +S11-modules/import.t +S11-modules/lexical.t +S11-modules/module.t +S11-modules/module-file.t +S11-modules/need.t +S11-modules/nested.t +S11-modules/perl6lib.t +S11-modules/require.t +S11-modules/runtime.t +S11-repository/curli-install.t +S12-attributes/class.t +S12-attributes/clone.t +S12-attributes/defaults.t +S12-attributes/delegation.t +S12-attributes/inheritance.t +S12-attributes/instance.t +S12-attributes/mutators.t +S12-attributes/native.t +S12-attributes/recursive.t +S12-attributes/smiley.t +S12-attributes/undeclared.t +S12-class/anonymous.t +S12-class/attributes.t +S12-class/attributes-required.t +S12-class/augment-supersede.t +S12-class/basic.t +S12-class/declaration-order.t +S12-class/extending-arrays.t +S12-class/inheritance-class-methods.t +S12-class/inheritance.t +S12-class/instantiate.t +S12-class/interface-consistency.t +S12-class/lexical.t +S12-class/literal.t +S12-class/magical-vars.t +S12-class/mro.t +S12-class/namespaced.t +S12-class/open.t +S12-class/parent_attributes.t +S12-class/rw.t +S12-class/self-inheritance.t +S12-class/stubs.t +S12-class/type-object.t +S12-coercion/coercion-types.t +S12-construction/autopairs.t +S12-construction/BUILD.t +S12-construction/construction.t +S12-construction/destruction.t +S12-construction/named-params-in-BUILD.t +S12-construction/new.t +S12-construction/TWEAK.t +S12-enums/anonymous.t +S12-enums/as-role.t +S12-enums/basic.t +S12-enums/misc.t +S12-enums/non-int.t +S12-enums/pseudo-functional.t +S12-enums/thorough.t +S12-introspection/attributes.t +S12-introspection/can.t +S12-introspection/definite.t +S12-introspection/meta-class.t +S12-introspection/methods.t +S12-introspection/parents.t +S12-introspection/roles.t +S12-introspection/walk.t +S12-introspection/WHAT.t +S12-meta/classhow.t +S12-meta/exporthow.t +S12-meta/grammarhow.t +S12-meta/primitives.t +S12-methods/accessors.t +S12-methods/attribute-params.t +S12-methods/calling_sets.t +S12-methods/calling_syntax.t +S12-methods/chaining.t +S12-methods/class-and-instance.t +S12-methods/delegation.t +S12-methods/default-trait.t +S12-methods/defer-call.t +S12-methods/defer-next.t +S12-methods/fallback.t +S12-methods/how.t +S12-methods/indirect_notation.t +S12-methods/instance.t +S12-methods/lastcall.t +S12-methods/lvalue.t +S12-methods/method-vs-sub.t +S12-methods/multi.t +S12-methods/parallel-dispatch.t +S12-methods/private.t +S12-methods/qualified.t +S12-methods/submethods.t +S12-methods/syntax.t +S12-methods/topic.t +S12-methods/trusts.t +S12-methods/typed-attributes.t +S12-methods/what.t +S12-subset/multi-dispatch.t +S12-subset/subtypes.t +S13-overloading/metaoperators.t +S13-overloading/operators.t +S13-overloading/typecasting-long.t +S13-type-casting/methods.t +S14-roles/anonymous.t +S14-roles/attributes.t +S14-roles/basic.t +S14-roles/bool.t +S14-roles/composition.t +S14-roles/conflicts.t +S14-roles/crony.t +S14-roles/instantiation.t +S14-roles/lexical.t +S14-roles/mixin.t +S14-roles/namespaced.t +S14-roles/parameterized-basic.t +S14-roles/parameterized-mixin.t +S14-roles/parameterized-type.t +S14-roles/parameter-subtyping.t +S14-roles/stubs.t +S14-roles/submethods.t +S14-traits/attributes.t +S14-traits/routines.t +S15-literals/identifiers.t +S15-literals/numbers.t +S15-nfg/case-change.t # moar +S15-nfg/cgj.t # moar +S15-nfg/concatenation.t # moar +S15-nfg/crlf-encoding.t # moar +S15-nfg/from-buf.t # moar +S15-nfg/from-file.t # moar +S15-nfg/grapheme-break.t # moar +S15-nfg/GraphemeBreakTest.t # moar +S15-nfg/emoji-test.t # moar +S15-nfg/long-uni.t # moar +S15-nfg/mass-chars.t # moar +S15-nfg/many-combiners.t # moar +S15-nfg/many-threads.t # moar +S15-nfg/mass-equality.t # moar +S15-nfg/mass-roundtrip-nfc.t # moar +S15-nfg/mass-roundtrip-nfd.t # moar +S15-nfg/mass-roundtrip-nfkc.t # moar +S15-nfg/mass-roundtrip-nfkd.t # moar +S15-nfg/regex.t # moar +S15-nfg/concat-stable.t # moar +S15-normalization/nfc-0.t # moar stress +S15-normalization/nfc-1.t # moar stress +S15-normalization/nfc-2.t # moar stress +S15-normalization/nfc-3.t # moar stress +S15-normalization/nfc-4.t # moar stress +S15-normalization/nfc-5.t # moar stress +S15-normalization/nfc-6.t # moar stress +S15-normalization/nfc-7.t # moar stress +S15-normalization/nfc-8.t # moar stress +S15-normalization/nfc-9.t # moar stress +S15-normalization/nfc-concat.t # moar +S15-normalization/nfc-sanity.t # moar +S15-normalization/nfd-0.t # moar stress +S15-normalization/nfd-1.t # moar stress +S15-normalization/nfd-2.t # moar stress +S15-normalization/nfd-3.t # moar stress +S15-normalization/nfd-4.t # moar stress +S15-normalization/nfd-5.t # moar stress +S15-normalization/nfd-6.t # moar stress +S15-normalization/nfd-7.t # moar stress +S15-normalization/nfd-8.t # moar stress +S15-normalization/nfd-9.t # moar stress +S15-normalization/nfd-sanity.t # moar +S15-normalization/nfkc-0.t # moar stress +S15-normalization/nfkc-1.t # moar stress +S15-normalization/nfkc-2.t # moar stress +S15-normalization/nfkc-3.t # moar stress +S15-normalization/nfkc-4.t # moar stress +S15-normalization/nfkc-5.t # moar stress +S15-normalization/nfkc-6.t # moar stress +S15-normalization/nfkc-7.t # moar stress +S15-normalization/nfkc-8.t # moar stress +S15-normalization/nfkc-9.t # moar stress +S15-normalization/nfkc-sanity.t # moar +S15-normalization/nfkd-0.t # moar stress +S15-normalization/nfkd-1.t # moar stress +S15-normalization/nfkd-2.t # moar stress +S15-normalization/nfkd-3.t # moar stress +S15-normalization/nfkd-4.t # moar stress +S15-normalization/nfkd-5.t # moar stress +S15-normalization/nfkd-6.t # moar stress +S15-normalization/nfkd-7.t # moar stress +S15-normalization/nfkd-8.t # moar stress +S15-normalization/nfkd-9.t # moar stress +S15-normalization/nfkd-sanity.t # moar +S15-string-types/NF-types.t +S15-string-types/NFK-types.t +S15-string-types/Uni.t # moar +S15-string-types/Str.t +S15-unicode-information/uniname.t +S15-unicode-information/unimatch-general.t # moar +S15-unicode-information/uniprop.t # moar +S15-unicode-information/unival.t # moar +S16-filehandles/argfiles.t +S16-filehandles/chmod.t +S16-filehandles/filestat.t +S16-filehandles/filetest.t +S16-filehandles/io_in_for_loops.t +S16-filehandles/io_in_while_loops.t +S16-filehandles/io.t +S16-filehandles/misc.t +S16-filehandles/mkdir_rmdir.t +S16-filehandles/mode.t +S16-filehandles/open.t +S16-filehandles/unlink.t +S16-io/bare-say.t +S16-io/basic-open.t +S16-io/bom.t +S16-io/comb.t +S16-io/cwd.t +S16-io/eof.t +S16-io/getc.t +S16-io/handles-between-threads.t +S16-io/home.t +S16-io/lines.t +S16-io/newline.t +S16-io/note.t +S16-io/print.t +S16-io/prompt.t +S16-io/put.t +S16-io/quoting-syntax.t +S16-io/readchars.t +S16-io/say-and-ref.t +S16-io/say.t +S16-io/split.t +S16-io/supply.t +S16-io/tmpdir.t +S16-io/words.t +S16-unfiled/rebindstdhandles.t +S17-channel/basic.t +S17-channel/stress.t # stress slow +S17-lowlevel/atomic.t # moar +S17-lowlevel/atomic-ops.t # moar +S17-lowlevel/cas.t +S17-lowlevel/cas-int.t # moar +S17-lowlevel/cas-loop.t # moar +S17-lowlevel/cas-loop-int.t # moar +S17-lowlevel/lock.t # slow +S17-lowlevel/semaphore.t +S17-lowlevel/thread.t +S17-lowlevel/thread-start-join-stress.t # stress +S17-procasync/basic.t # moar +S17-procasync/bind-handles.t # moar +S17-procasync/encoding.t # moar +S17-procasync/nonexistent.t # moar +S17-procasync/print.t # moar +S17-procasync/kill.t # moar stress slow +S17-procasync/no-runaway-file-limit.t # moar slow +S17-procasync/many-processes-no-close-stdin.t # moar slow +S17-procasync/stress.t # moar stress slow +S17-promise/allof.t # slow +S17-promise/at.t +S17-promise/anyof.t +S17-promise/basic.t +S17-promise/in.t # slow +S17-promise/lock-async.t +S17-promise/start.t # slow +S17-promise/stress.t # stress +S17-promise/then.t +S17-scheduler/at.t # slow +S17-scheduler/basic.t +S17-scheduler/every.t # slow +S17-scheduler/in.t # slow +S17-scheduler/times.t # slow +S17-supply/act.t # slow +S17-supply/basic.t +S17-supply/batch.t # slow +S17-supply/categorize.t +S17-supply/Channel.t +S17-supply/classify.t +S17-supply/delayed.t # slow +S17-supply/do.t +S17-supply/elems.t # slow +S17-supply/flat.t +S17-supply/from-list.t +S17-supply/grab.t +S17-supply/grep.t +S17-supply/head.t +S17-supply/interval.t +S17-supply/lines.t +S17-supply/list.t +S17-supply/map.t +S17-supply/max.t +S17-supply/merge.t +S17-supply/migrate.t +S17-supply/min.t +S17-supply/minmax.t +S17-promise/nonblocking-await.t +S17-supply/on-demand.t +S17-supply/Promise.t +S17-supply/produce.t +S17-supply/reduce.t +S17-supply/return-in-tap.t +S17-supply/reverse.t +S17-supply/rotor.t +S17-supply/schedule-on.t +S17-supply/skip.t +S17-supply/sort.t +S17-supply/squish.t +S17-supply/stable.t # slow +S17-supply/start.t # slow +S17-supply/supplier-preserving.t +S17-supply/syntax.t # slow +S17-supply/syntax-nonblocking-await.t +S17-supply/tail.t +S17-supply/throttle.t # slow +S17-supply/unique.t # slow +S17-supply/wait.t # slow +S17-supply/watch-path.t # slow +S17-supply/words.t +S17-supply/zip.t +S17-supply/zip-latest.t +S19-command-line/arguments.t +S19-command-line/dash-e.t +S19-command-line/help.t +S19-command-line/repl.t # moar +S19-command-line-options/02-dash-n.t +S19-command-line-options/03-dash-p.t +S19-command-line-options/04-negation.t +S19-command-line-options/05-delimited-options.t +S19-command-line-options/06-dash-rxtrace.t +S22-package-format/local.t +S24-testing/0-compile.t +S24-testing/3-output.t +S24-testing/7-bail_out.t +S24-testing/8-die_on_fail.t +S24-testing/9-is_deeply.t +S24-testing/10-is-approx.t +S24-testing/11-plan-skip-all.t # stress +S24-testing/11-plan-skip-all-subtests.t +S24-testing/12-subtest-todo.t +S24-testing/line-numbers.t +S26-documentation/01-delimited.t +S26-documentation/02-paragraph.t +S26-documentation/03-abbreviated.t +S26-documentation/04-code.t +S26-documentation/05-comment.t +S26-documentation/06-lists.t +S26-documentation/07-tables.t +S26-documentation/07a-tables-todo-skipped.t +S26-documentation/08-formattingcodes.t +S26-documentation/09-configuration.t +S26-documentation/10-doc-cli.t +S26-documentation/block-leading.t +S26-documentation/block-trailing.t +S26-documentation/module-comment.t +S26-documentation/multiline-leading.t +S26-documentation/multiline-trailing.t +S26-documentation/wacky.t +S26-documentation/why-both.t +S26-documentation/why-trailing.t +S26-documentation/why-leading.t +S28-named-variables/cwd.t +S28-named-variables/init-instant.t +S28-named-variables/slangs.t # moar +S29-any/cmp.t +S29-any/deg-trans.t +S29-any/isa.t +S29-any/minpairs-maxpairs.t +S29-context/die.t +S29-context/eval.t +S29-context/evalfile.t +S29-context/exit-in-if.t +S29-context/exit.t +S29-context/sleep.t # slow +S29-conversions/hash.t +S29-conversions/ord_and_chr.t +S29-os/system.t +S32-array/adverbs.t +S32-array/bool.t +S32-array/create.t +S32-array/delete.t +S32-array/delete-adverb.t +S32-array/delete-adverb-native.t +S32-array/elems.t +S32-array/end.t +S32-array/exists-adverb.t +S32-array/keys_values.t +S32-array/kv.t +S32-array/pairs.t +S32-array/perl.t +S32-array/pop.t +S32-array/push.t +S32-array/rotate.t +S32-array/shift.t +S32-array/splice.t +S32-array/unshift.t +S32-basics/pairup.t +S32-basics/warn.t +S32-basics/xxKEY.t +S32-basics/xxPOS.t +S32-basics/xxPOS-native.t # moar +S32-container/buf.t +S32-container/cat.t +S32-container/roundrobin.t +S32-container/stringify.t +S32-container/zip.t +S32-encoding/encoder.t +S32-encoding/registry.t +S32-exceptions/misc.t +S32-hash/adverbs.t +S32-hash/antipairs.t +S32-hash/delete.t +S32-hash/delete-adverb.t +S32-hash/exists.t +S32-hash/exists-adverb.t +S32-hash/invert.t +S32-hash/iterator.t +S32-hash/keys_values.t +S32-hash/kv.t +S32-hash/map.t +S32-hash/pairs.t +S32-hash/perl.t +S32-hash/push.t +S32-hash/slice.t +S32-io/IO-Socket-Async.t +S32-io/IO-Socket-Async-UDP.t # moar +S32-io/chdir.t +S32-io/chdir-process.t # moar +S32-io/copy.t +S32-io/dir.t +S32-io/file-tests.t +S32-io/indir.t +S32-io/io-cathandle.t +S32-io/io-handle.t +S32-io/lock.t # slow +S32-io/socket-host-port-split.t +S32-io/socket-fail-invalid-values.t +S32-io/io-special.t +S32-io/io-spec-qnx.t +S32-io/io-spec-unix.t +S32-io/io-spec-win.t +S32-io/io-spec-cygwin.t +S32-io/io-path-subclasses.t +S32-io/io-path-symlink.t +S32-io/io-path-unix.t +S32-io/io-path-win.t +S32-io/io-path-cygwin.t +S32-io/io-path.t +S32-io/io-path-extension.t +S32-io/IO-Socket-INET.t +S32-io/move.t +S32-io/native-descriptor.t # moar +S32-io/note.t +S32-io/null-char.t +S32-io/open.t +S32-io/other.t +S32-io/pipe.t +S32-io/rename.t +S32-io/seek.t +S32-io/socket-accept-and-working-threads.t +S32-io/socket-recv-vs-read.t +S32-io/slurp.t +S32-io/spurt.t +S32-io/tell.t +S32-list/batch.t +S32-list/categorize.t +S32-list/categorize-list.t +S32-list/classify.t +S32-list/classify-list.t +S32-list/create.t +S32-list/cross.t +S32-list/combinations.t +S32-list/deepmap.t +S32-list/duckmap.t +S32-list/end.t +S32-list/first.t +S32-list/first-end.t +S32-list/first-end-k.t +S32-list/first-end-kv.t +S32-list/first-end-p.t +S32-list/first-end-v.t +S32-list/first-k.t +S32-list/first-kv.t +S32-list/first-p.t +S32-list/first-v.t +S32-list/flat.t +S32-list/grep.t +S32-list/grep-k.t +S32-list/grep-kv.t +S32-list/grep-p.t +S32-list/grep-v.t +S32-list/head.t +S32-list/iterator.t +S32-list/join.t +S32-list/map_function_return_values.t +S32-list/map.t +S32-list/minmax.t +S32-list/permutations.t +S32-list/pick.t +S32-list/produce.t +S32-list/reduce.t +S32-list/repeated.t +S32-list/reverse.t +S32-list/roll.t +S32-list/rotor.t +S32-list/seq.t +S32-list/skip.t +S32-list/sort.t +S32-list/tail.t +S32-list/unique.t +S32-list/squish.t +S32-num/abs.t +S32-num/base.t +S32-num/complex.t +S32-num/cool-num.t +S32-num/exp.t +S32-num/expmod.t +S32-num/fatrat.t +S32-num/int.t +S32-num/is-prime.t +S32-num/log.t +S32-num/narrow.t +S32-num/negative-zero.t +S32-num/pi.t +S32-num/polar.t +S32-num/polymod.t +S32-num/power.t +S32-num/rand.t +S32-num/rat.t +S32-num/real-bridge.t +S32-num/roots.t +S32-num/rounders.t +S32-num/rshift_pos_amount.t +S32-num/sign.t +S32-num/sqrt.t +S32-num/stringify.t +S32-num/unpolar.t +S32-scalar/defined.t +S32-scalar/perl.t +S32-scalar/undef.t +S32-str/append.t +S32-str/bool.t +S32-str/capitalize.t +S32-str/chomp.t +S32-str/chop.t +S32-str/comb.t +S32-str/contains.t +S32-str/encode.t +S32-str/ends-with.t +S32-str/fc.t # moar +S32-str/flip.t +S32-str/indent.t +S32-str/index.t +S32-str/indices.t +S32-str/lc.t +S32-str/length.t +S32-str/lines.t +S32-str/numeric.t +S32-str/ords.t +S32-str/pack.t +S32-str/parse-base.t +S32-str/parse-names.t +S32-str/pos.t +S32-str/rindex.t +S32-str/samemark.t +S32-str/samecase.t +S32-str/split-simple.t +S32-str/split.t +S32-str/sprintf.t +S32-str/sprintf-b.t +S32-str/starts-with.t +S32-str/substr.t +S32-str/substr-eq.t +S32-str/substr-rw.t +S32-str/tc.t +S32-str/tclc.t +S32-str/trim.t +S32-str/uc.t +S32-str/unpack.t +S32-str/utf8-c8.t # moar +S32-str/words.t +S32-str/CollationTest_NON_IGNORABLE-0.t # moar +S32-str/CollationTest_NON_IGNORABLE-1.t # moar +S32-str/CollationTest_NON_IGNORABLE-2.t # moar +S32-str/CollationTest_NON_IGNORABLE-3.t # moar +S32-temporal/calendar.t +S32-temporal/Date.t +S32-temporal/DateTime-Instant-Duration.t +S32-temporal/DateTime.t # slow +S32-temporal/local.t +S32-trig/atan2.t +S32-trig/cosech.t +S32-trig/cosec.t +S32-trig/cosh.t +S32-trig/cos.t +S32-trig/cotanh.t +S32-trig/cotan.t +S32-trig/e.t +S32-trig/pi.t +S32-trig/sech.t +S32-trig/sec.t +S32-trig/simple.t +S32-trig/sinh.t +S32-trig/sin.t +S32-trig/tanh.t +S32-trig/tan.t +integration/99problems-01-to-10.t +integration/99problems-11-to-20.t +integration/99problems-21-to-30.t +integration/99problems-31-to-40.t +integration/99problems-41-to-50.t +integration/99problems-51-to-60.t +integration/99problems-61-to-70.t +integration/advent2009-day01.t +integration/advent2009-day02.t +integration/advent2009-day03.t +integration/advent2009-day04.t +integration/advent2009-day05.t +integration/advent2009-day06.t +integration/advent2009-day07.t +integration/advent2009-day08.t +integration/advent2009-day09.t +integration/advent2009-day10.t +integration/advent2009-day11.t +integration/advent2009-day12.t +integration/advent2009-day13.t +integration/advent2009-day14.t +integration/advent2009-day15.t +integration/advent2009-day16.t +integration/advent2009-day17.t +integration/advent2009-day18.t +integration/advent2009-day19.t +integration/advent2009-day20.t +integration/advent2009-day21.t +integration/advent2009-day22.t +integration/advent2009-day23.t +integration/advent2009-day24.t +integration/advent2010-day03.t +integration/advent2010-day04.t +integration/advent2010-day06.t +integration/advent2010-day07.t +integration/advent2010-day08.t +integration/advent2010-day10.t +integration/advent2010-day11.t +integration/advent2010-day12.t +integration/advent2010-day14.t +integration/advent2010-day16.t +integration/advent2010-day19.t +integration/advent2010-day21.t +integration/advent2010-day22.t +integration/advent2010-day23.t +integration/advent2011-day03.t +integration/advent2011-day04.t +integration/advent2011-day05.t +integration/advent2011-day07.t +integration/advent2011-day10.t +integration/advent2011-day11.t +integration/advent2011-day14.t +integration/advent2011-day15.t +integration/advent2011-day16.t +integration/advent2011-day20.t +integration/advent2011-day22.t +integration/advent2011-day23.t +integration/advent2011-day24.t +integration/advent2012-day02.t +integration/advent2012-day03.t +integration/advent2012-day04.t #stress +integration/advent2012-day06.t +integration/advent2012-day09.t +integration/advent2012-day10.t +integration/advent2012-day12.t +integration/advent2012-day13.t +integration/advent2012-day14.t +integration/advent2012-day15.t +integration/advent2012-day16.t +integration/advent2012-day19.t # slow +integration/advent2012-day20.t +integration/advent2012-day21.t #stress +integration/advent2012-day22.t +integration/advent2012-day23.t +integration/advent2012-day24.t +integration/advent2013-day02.t +integration/advent2013-day04.t +integration/advent2013-day06.t +integration/advent2013-day07.t +integration/advent2013-day08.t +integration/advent2013-day09.t +integration/advent2013-day10.t +integration/advent2013-day12.t +integration/advent2013-day14.t # slow +integration/advent2013-day15.t +integration/advent2013-day18.t +integration/advent2013-day19.t +integration/advent2013-day20.t +integration/advent2013-day21.t +integration/advent2013-day22.t +integration/advent2013-day23.t +integration/advent2014-day05.t #stress +integration/advent2014-day13.t +integration/advent2014-day16.t +integration/code-blocks-as-sub-args.t +integration/deep-recursion-initing-native-array.t # moar +integration/error-reporting.t # slow +integration/eval-and-threads.t # slow +integration/failure-and-callsame.t +integration/lazy-bentley-generator.t +integration/lexical-array-in-inner-block.t +integration/lexicals-and-attributes.t +integration/man-or-boy.t +integration/method-calls-and-instantiation.t +integration/no-indirect-new.t +integration/packages.t +integration/pair-in-array.t +integration/passing-pair-class-to-sub.t +integration/precompiled.t # moar slow +integration/real-strings.t +integration/role-composition-vs-attribute.t +integration/rule-in-class-Str.t +integration/say-crash.t +integration/substr-after-match-in-gather-in-for.t +integration/topic_in_double_loop.t +integration/variables-in-do.t +integration/weird-errors.t # slow +rosettacode/greatest_element_of_a_list.t +rosettacode/sierpinski_triangle.t From 6cb810d23e6eda21f7eca55fd549a2b627d9091d Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Wed, 27 Sep 2017 13:08:28 +0000 Subject: [PATCH 171/692] Prune 6.d.proposals test files from 6.c test file list --- t/spectest.data.6.c | 131 -------------------------------------------- 1 file changed, 131 deletions(-) diff --git a/t/spectest.data.6.c b/t/spectest.data.6.c index 87dc69cb319..2e29ef4ced7 100644 --- a/t/spectest.data.6.c +++ b/t/spectest.data.6.c @@ -24,8 +24,6 @@ S01-perl-5-integration/array.t # perl5 S01-perl-5-integration/basic.t # perl5 S01-perl-5-integration/class.t # perl5 -S01-perl-5-integration/context.t # perl5 -S01-perl-5-integration/eval_lex.t # perl5 S01-perl-5-integration/exception_handling.t # perl5 S01-perl-5-integration/hash.t # perl5 S01-perl-5-integration/import.t # perl5 @@ -81,14 +79,12 @@ S02-magicals/dollar_bang.t S02-magicals/dollar-underscore.t S02-magicals/env.t S02-magicals/file_line.t -S02-magicals/GROUP.t S02-magicals/KERNEL.t S02-magicals/PERL.t S02-magicals/pid.t S02-magicals/progname.t S02-magicals/sub.t S02-magicals/subname.t -S02-magicals/USER.t S02-magicals/VM.t S02-names/bare-sigil.t S02-names/caller.t @@ -111,7 +107,6 @@ S02-names-vars/signature.t S02-names-vars/variables-and-packages.t S02-names-vars/varnames.t S02-one-pass-parsing/less-than.t -S02-one-pass-parsing/misc.t S02-packages/package-lookup.t S02-types/anon_block.t S02-types/array_extending.t @@ -120,9 +115,7 @@ S02-types/array-shapes.t S02-types/array.t S02-types/assigning-refs.t S02-types/autovivification.t -S02-types/bag-iterator.t S02-types/bag.t -S02-types/baggy.t S02-types/baghash.t S02-types/bool.t S02-types/built-in.t @@ -142,11 +135,9 @@ S02-types/isDEPRECATED.t S02-types/keyhash.t S02-types/lazy-lists.t S02-types/lists.t -S02-types/mix-iterator.t S02-types/mix.t S02-types/mixhash.t S02-types/mixed_multi_dimensional.t -S02-types/mu.t S02-types/multi_dimensional_array.t S02-types/nan.t S02-types/native.t @@ -157,10 +148,8 @@ S02-types/num.t S02-types/pair.t S02-types/list.t S02-types/parsing-bool.t -S02-types/range-iterator.t S02-types/range.t S02-types/resolved-in-setting.t # moar -S02-types/set-iterator.t S02-types/set.t S02-types/sethash.t S02-types/sigils-and-types.t @@ -171,7 +160,6 @@ S02-types/type.t S02-types/undefined-types.t S02-types/unicode.t S02-types/version.t -S02-types/version-stress.t # stress S02-types/whatever.t S02-types/WHICH.t S03-binding/arrays.t @@ -179,7 +167,6 @@ S03-binding/attributes.t S03-binding/closure.t S03-binding/hashes.t S03-binding/nested.t -S03-binding/nonsense.t S03-binding/ro.t S03-binding/scalars.t S03-feeds/basic.t @@ -236,7 +223,6 @@ S03-operators/mix.t S03-operators/names.t S03-operators/nesting.t S03-operators/not.t -S03-operators/notandthen.t S03-operators/numeric-shift.t S03-operators/overflow.t S03-operators/precedence.t @@ -248,16 +234,6 @@ S03-operators/relational.t S03-operators/repeat.t S03-operators/scalar-assign.t S03-operators/set.t -S03-operators/set_addition.t -S03-operators/set_difference.t -S03-operators/set_elem.t -S03-operators/set_intersection.t -S03-operators/set_multiply.t -S03-operators/set_precedes.t -S03-operators/set_proper_subset.t -S03-operators/set_subset.t -S03-operators/set_symmetric_difference.t -S03-operators/set_union.t S03-operators/short-circuit.t S03-operators/so.t S03-operators/spaceship-and-containers.t @@ -265,7 +241,6 @@ S03-operators/spaceship.t S03-operators/subscript-adverbs.t S03-operators/subscript-vs-lt.t S03-operators/ternary.t -S03-operators/u2212-minus.t S03-operators/value_equivalence.t S03-sequence/arity0.t S03-sequence/arity-2-or-more.t @@ -309,7 +284,6 @@ S04-exception-handlers/catch.t S04-exception-handlers/control.t S04-exception-handlers/top-level.t S04-exceptions/control_across_runloop.t -S04-exceptions/exceptions-json.t S04-exceptions/fail.t S04-exceptions/pending.t S04-phasers/ascending-order.t @@ -444,12 +418,10 @@ S05-modifier/perl5_9.t S05-modifier/pos.t S05-modifier/repetition-exhaustive.t S05-modifier/repetition.t -S05-modifier/samemark.t S05-modifier/sigspace.t S05-substitution/67222.t S05-substitution/match.t S05-substitution/subst.t -S05-syntactic-categories/new-symbols.t S05-transliteration/79778.t S05-transliteration/trans.t S05-transliteration/with-closure.t @@ -479,11 +451,8 @@ S06-multi/syntax.t S06-multi/type-based.t S06-multi/unpackability.t S06-multi/value-based.t -S06-operator-overloading/circumfix.t S06-operator-overloading/imported-subs.t -S06-operator-overloading/infix.t S06-operator-overloading/methods.t -S06-operator-overloading/prefix.t S06-operator-overloading/semicolon.t S06-operator-overloading/sub.t S06-operator-overloading/term.t @@ -545,7 +514,6 @@ S06-traits/native-is-copy.t S06-traits/native-is-rw.t S06-traits/precedence.t S07-slip/slip.t -S07-iterators/range-iterator.t S07-hyperrace/hyper.t S07-hyperrace/race.t S06-traits/slurpy-is-rw.t @@ -567,11 +535,9 @@ S09-typed-arrays/native.t S09-typed-arrays/native-decl.t S09-typed-arrays/native-int.t S09-typed-arrays/native-num.t -S09-typed-arrays/native-str.t S10-packages/basic.t S10-packages/joined-namespaces.t S10-packages/precompilation.t # slow -S10-packages/require-and-use.t S10-packages/use-with-class.t S11-compunit/compunit-dependencyspecification.t S11-compunit/compunit-repository.t @@ -582,13 +548,9 @@ S11-modules/import-multi.t S11-modules/import-tag.t S11-modules/import.t S11-modules/lexical.t -S11-modules/module.t -S11-modules/module-file.t S11-modules/need.t S11-modules/nested.t -S11-modules/perl6lib.t S11-modules/require.t -S11-modules/runtime.t S11-repository/curli-install.t S12-attributes/class.t S12-attributes/clone.t @@ -627,10 +589,8 @@ S12-coercion/coercion-types.t S12-construction/autopairs.t S12-construction/BUILD.t S12-construction/construction.t -S12-construction/destruction.t S12-construction/named-params-in-BUILD.t S12-construction/new.t -S12-construction/TWEAK.t S12-enums/anonymous.t S12-enums/as-role.t S12-enums/basic.t @@ -647,7 +607,6 @@ S12-introspection/parents.t S12-introspection/roles.t S12-introspection/walk.t S12-introspection/WHAT.t -S12-meta/classhow.t S12-meta/exporthow.t S12-meta/grammarhow.t S12-meta/primitives.t @@ -712,8 +671,6 @@ S15-nfg/crlf-encoding.t # moar S15-nfg/from-buf.t # moar S15-nfg/from-file.t # moar S15-nfg/grapheme-break.t # moar -S15-nfg/GraphemeBreakTest.t # moar -S15-nfg/emoji-test.t # moar S15-nfg/long-uni.t # moar S15-nfg/mass-chars.t # moar S15-nfg/many-combiners.t # moar @@ -724,7 +681,6 @@ S15-nfg/mass-roundtrip-nfd.t # moar S15-nfg/mass-roundtrip-nfkc.t # moar S15-nfg/mass-roundtrip-nfkd.t # moar S15-nfg/regex.t # moar -S15-nfg/concat-stable.t # moar S15-normalization/nfc-0.t # moar stress S15-normalization/nfc-1.t # moar stress S15-normalization/nfc-2.t # moar stress @@ -735,7 +691,6 @@ S15-normalization/nfc-6.t # moar stress S15-normalization/nfc-7.t # moar stress S15-normalization/nfc-8.t # moar stress S15-normalization/nfc-9.t # moar stress -S15-normalization/nfc-concat.t # moar S15-normalization/nfc-sanity.t # moar S15-normalization/nfd-0.t # moar stress S15-normalization/nfd-1.t # moar stress @@ -770,8 +725,6 @@ S15-normalization/nfkd-7.t # moar stress S15-normalization/nfkd-8.t # moar stress S15-normalization/nfkd-9.t # moar stress S15-normalization/nfkd-sanity.t # moar -S15-string-types/NF-types.t -S15-string-types/NFK-types.t S15-string-types/Uni.t # moar S15-string-types/Str.t S15-unicode-information/uniname.t @@ -785,9 +738,7 @@ S16-filehandles/filetest.t S16-filehandles/io_in_for_loops.t S16-filehandles/io_in_while_loops.t S16-filehandles/io.t -S16-filehandles/misc.t S16-filehandles/mkdir_rmdir.t -S16-filehandles/mode.t S16-filehandles/open.t S16-filehandles/unlink.t S16-io/bare-say.t @@ -795,18 +746,11 @@ S16-io/basic-open.t S16-io/bom.t S16-io/comb.t S16-io/cwd.t -S16-io/eof.t S16-io/getc.t -S16-io/handles-between-threads.t -S16-io/home.t S16-io/lines.t S16-io/newline.t S16-io/note.t S16-io/print.t -S16-io/prompt.t -S16-io/put.t -S16-io/quoting-syntax.t -S16-io/readchars.t S16-io/say-and-ref.t S16-io/say.t S16-io/split.t @@ -815,32 +759,19 @@ S16-io/tmpdir.t S16-io/words.t S16-unfiled/rebindstdhandles.t S17-channel/basic.t -S17-channel/stress.t # stress slow -S17-lowlevel/atomic.t # moar -S17-lowlevel/atomic-ops.t # moar -S17-lowlevel/cas.t -S17-lowlevel/cas-int.t # moar -S17-lowlevel/cas-loop.t # moar -S17-lowlevel/cas-loop-int.t # moar S17-lowlevel/lock.t # slow -S17-lowlevel/semaphore.t S17-lowlevel/thread.t S17-lowlevel/thread-start-join-stress.t # stress S17-procasync/basic.t # moar -S17-procasync/bind-handles.t # moar -S17-procasync/encoding.t # moar -S17-procasync/nonexistent.t # moar S17-procasync/print.t # moar S17-procasync/kill.t # moar stress slow S17-procasync/no-runaway-file-limit.t # moar slow S17-procasync/many-processes-no-close-stdin.t # moar slow -S17-procasync/stress.t # moar stress slow S17-promise/allof.t # slow S17-promise/at.t S17-promise/anyof.t S17-promise/basic.t S17-promise/in.t # slow -S17-promise/lock-async.t S17-promise/start.t # slow S17-promise/stress.t # stress S17-promise/then.t @@ -872,23 +803,18 @@ S17-supply/merge.t S17-supply/migrate.t S17-supply/min.t S17-supply/minmax.t -S17-promise/nonblocking-await.t S17-supply/on-demand.t S17-supply/Promise.t S17-supply/produce.t S17-supply/reduce.t -S17-supply/return-in-tap.t S17-supply/reverse.t S17-supply/rotor.t S17-supply/schedule-on.t -S17-supply/skip.t S17-supply/sort.t S17-supply/squish.t S17-supply/stable.t # slow S17-supply/start.t # slow -S17-supply/supplier-preserving.t S17-supply/syntax.t # slow -S17-supply/syntax-nonblocking-await.t S17-supply/tail.t S17-supply/throttle.t # slow S17-supply/unique.t # slow @@ -903,19 +829,9 @@ S19-command-line/help.t S19-command-line/repl.t # moar S19-command-line-options/02-dash-n.t S19-command-line-options/03-dash-p.t -S19-command-line-options/04-negation.t -S19-command-line-options/05-delimited-options.t -S19-command-line-options/06-dash-rxtrace.t S22-package-format/local.t S24-testing/0-compile.t S24-testing/3-output.t -S24-testing/7-bail_out.t -S24-testing/8-die_on_fail.t -S24-testing/9-is_deeply.t -S24-testing/10-is-approx.t -S24-testing/11-plan-skip-all.t # stress -S24-testing/11-plan-skip-all-subtests.t -S24-testing/12-subtest-todo.t S24-testing/line-numbers.t S26-documentation/01-delimited.t S26-documentation/02-paragraph.t @@ -924,7 +840,6 @@ S26-documentation/04-code.t S26-documentation/05-comment.t S26-documentation/06-lists.t S26-documentation/07-tables.t -S26-documentation/07a-tables-todo-skipped.t S26-documentation/08-formattingcodes.t S26-documentation/09-configuration.t S26-documentation/10-doc-cli.t @@ -938,12 +853,9 @@ S26-documentation/why-both.t S26-documentation/why-trailing.t S26-documentation/why-leading.t S28-named-variables/cwd.t -S28-named-variables/init-instant.t S28-named-variables/slangs.t # moar S29-any/cmp.t -S29-any/deg-trans.t S29-any/isa.t -S29-any/minpairs-maxpairs.t S29-context/die.t S29-context/eval.t S29-context/evalfile.t @@ -972,18 +884,14 @@ S32-array/rotate.t S32-array/shift.t S32-array/splice.t S32-array/unshift.t -S32-basics/pairup.t S32-basics/warn.t S32-basics/xxKEY.t S32-basics/xxPOS.t S32-basics/xxPOS-native.t # moar -S32-container/buf.t S32-container/cat.t S32-container/roundrobin.t S32-container/stringify.t S32-container/zip.t -S32-encoding/encoder.t -S32-encoding/registry.t S32-exceptions/misc.t S32-hash/adverbs.t S32-hash/antipairs.t @@ -992,10 +900,8 @@ S32-hash/delete-adverb.t S32-hash/exists.t S32-hash/exists-adverb.t S32-hash/invert.t -S32-hash/iterator.t S32-hash/keys_values.t S32-hash/kv.t -S32-hash/map.t S32-hash/pairs.t S32-hash/perl.t S32-hash/push.t @@ -1003,72 +909,46 @@ S32-hash/slice.t S32-io/IO-Socket-Async.t S32-io/IO-Socket-Async-UDP.t # moar S32-io/chdir.t -S32-io/chdir-process.t # moar S32-io/copy.t S32-io/dir.t S32-io/file-tests.t -S32-io/indir.t -S32-io/io-cathandle.t S32-io/io-handle.t -S32-io/lock.t # slow -S32-io/socket-host-port-split.t -S32-io/socket-fail-invalid-values.t -S32-io/io-special.t -S32-io/io-spec-qnx.t S32-io/io-spec-unix.t S32-io/io-spec-win.t S32-io/io-spec-cygwin.t -S32-io/io-path-subclasses.t -S32-io/io-path-symlink.t S32-io/io-path-unix.t S32-io/io-path-win.t S32-io/io-path-cygwin.t S32-io/io-path.t -S32-io/io-path-extension.t S32-io/IO-Socket-INET.t S32-io/move.t S32-io/native-descriptor.t # moar S32-io/note.t -S32-io/null-char.t -S32-io/open.t S32-io/other.t S32-io/pipe.t S32-io/rename.t -S32-io/seek.t -S32-io/socket-accept-and-working-threads.t S32-io/socket-recv-vs-read.t S32-io/slurp.t S32-io/spurt.t -S32-io/tell.t -S32-list/batch.t S32-list/categorize.t -S32-list/categorize-list.t S32-list/classify.t -S32-list/classify-list.t S32-list/create.t -S32-list/cross.t S32-list/combinations.t -S32-list/deepmap.t -S32-list/duckmap.t S32-list/end.t S32-list/first.t S32-list/first-end.t S32-list/first-end-k.t -S32-list/first-end-kv.t S32-list/first-end-p.t S32-list/first-end-v.t S32-list/first-k.t -S32-list/first-kv.t S32-list/first-p.t S32-list/first-v.t -S32-list/flat.t S32-list/grep.t S32-list/grep-k.t S32-list/grep-kv.t S32-list/grep-p.t S32-list/grep-v.t S32-list/head.t -S32-list/iterator.t S32-list/join.t S32-list/map_function_return_values.t S32-list/map.t @@ -1082,7 +962,6 @@ S32-list/reverse.t S32-list/roll.t S32-list/rotor.t S32-list/seq.t -S32-list/skip.t S32-list/sort.t S32-list/tail.t S32-list/unique.t @@ -1098,7 +977,6 @@ S32-num/int.t S32-num/is-prime.t S32-num/log.t S32-num/narrow.t -S32-num/negative-zero.t S32-num/pi.t S32-num/polar.t S32-num/polymod.t @@ -1136,8 +1014,6 @@ S32-str/lines.t S32-str/numeric.t S32-str/ords.t S32-str/pack.t -S32-str/parse-base.t -S32-str/parse-names.t S32-str/pos.t S32-str/rindex.t S32-str/samemark.t @@ -1157,10 +1033,6 @@ S32-str/uc.t S32-str/unpack.t S32-str/utf8-c8.t # moar S32-str/words.t -S32-str/CollationTest_NON_IGNORABLE-0.t # moar -S32-str/CollationTest_NON_IGNORABLE-1.t # moar -S32-str/CollationTest_NON_IGNORABLE-2.t # moar -S32-str/CollationTest_NON_IGNORABLE-3.t # moar S32-temporal/calendar.t S32-temporal/Date.t S32-temporal/DateTime-Instant-Duration.t @@ -1277,10 +1149,7 @@ integration/advent2014-day05.t #stress integration/advent2014-day13.t integration/advent2014-day16.t integration/code-blocks-as-sub-args.t -integration/deep-recursion-initing-native-array.t # moar integration/error-reporting.t # slow -integration/eval-and-threads.t # slow -integration/failure-and-callsame.t integration/lazy-bentley-generator.t integration/lexical-array-in-inner-block.t integration/lexicals-and-attributes.t From 31cbdada73600c611b2c68196f8f705f380ae456 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Wed, 27 Sep 2017 13:22:54 +0000 Subject: [PATCH 172/692] Teach Harness5 to handle different roast versions --- t/harness5 | 34 ++++++++++++++++++++++++++++++++++ 1 file changed, 34 insertions(+) diff --git a/t/harness5 b/t/harness5 index 78603d71504..4adbd13dc47 100644 --- a/t/harness5 +++ b/t/harness5 @@ -15,6 +15,8 @@ use Pod::Usage; use Test::Harness; $Test::Harness::switches = ''; +use constant FULL_ROAST_TEST_LIST_FILE => 't/spectest.data'; +use constant ROAST_VERSION_FILE => 't/spec/VERSION'; my $win = $^O eq 'MSWin32'; my $slash = $win ? '\\' : '/'; @@ -42,6 +44,8 @@ $ENV{'PERL6LIB'} = "lib"; my @slow; if ($list_file) { + $list_file = convert_to_versioned_file($list_file); + my $perl5 = not system $ENV{HARNESS_PERL} . ' -e "exit !try { require Inline::Perl5; 1 }"'; print "Inline::Perl5 not installed: not running Perl 5 integration tests\n" if !$perl5; @@ -183,6 +187,36 @@ sub fudge { return split ' ', `$cmd`; } +sub warn_in_box { + warn +('#' x 76) . "\n\n" . shift . "\n\n" . ('#' x 76) . "\n"; +} + +sub convert_to_versioned_file { + my $file = shift; + return $file unless $file eq FULL_ROAST_TEST_LIST_FILE; + + open my $fh, '<', ROAST_VERSION_FILE or do { + warn_in_box "Failed to open roast VERSION file in " + . ROAST_VERSION_FILE . ": $!\n" + . "Defaulting to test files from $file"; + return $file; + }; + (my $ver = (grep !/^\s*#/, <$fh>)[0]) =~ s/^\s+|\s+$//g; + + # Make a new test file name using the version of the roast. The master + # branch would have version something like `6.d-proposals`; in such + # a case, we'll use the default test file list + my $new_file = $ver =~ /propos/ ? $file : "$file.$ver"; + if (-r $new_file) { + print "Testing Roast version $ver using test file list from $new_file\n"; + return $new_file; + } + + warn_in_box "Test list file `$new_file` for Roast version $ver does not exist\n" + . "or isn't readable. Defaulting to $file"; + return $file; +} + =head1 NAME t/harness - run the harness tests for Rakudo. From 16f64182f0843358004f4dd8ac64d5fdd241cbd7 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Wed, 27 Sep 2017 13:47:16 +0000 Subject: [PATCH 173/692] Teach Harness6 to handle different roast versions --- t/harness6 | 34 +++++++++++++++++++++++++++++++--- 1 file changed, 31 insertions(+), 3 deletions(-) diff --git a/t/harness6 b/t/harness6 index 85a0492b7a3..00001b16586 100644 --- a/t/harness6 +++ b/t/harness6 @@ -20,10 +20,13 @@ else { } require ::('TAP'); +constant FULL_ROAST_TEST_LIST_FILE = 't/spectest.data'; +constant ROAST_VERSION_FILE = 't/spec/VERSION'; + my $vm = $*VM.name; -multi sub MAIN( - Str :$tests-from-file = Str, +sub MAIN( + Str :$tests-from-file is copy = Str, Bool :$fudge = False, Int :$verbosity = (%*ENV // 0).Int, Int :$jobs = (%*ENV // 1).Int, @@ -37,7 +40,8 @@ multi sub MAIN( ) { die "TEST_JOBS > 1 is currently broken" if $jobs and $jobs > 1; my @slow; - with ($tests-from-file) { + with $tests-from-file { + $tests-from-file .= &convert-to-versioned-file; my $inline-perl5-is-installed = run( $perlpath, '-e', 'exit 1 if (try require Inline::Perl5) === Nil' ).exitcode == 0; @@ -138,6 +142,30 @@ multi sub MAIN( } } +sub note-in-box { note "{'#' x 76}\n\n$^text\n\n{'#' x 76}\n" } +sub convert-to-versioned-file ($file) { + return $file unless $file eq FULL_ROAST_TEST_LIST_FILE; + + ROAST_VERSION_FILE.IO.open + andthen my $ver = .lines.grep({!/\s* '#'/}).head.trim + orelse note-in-box "Failed to open roast VERSION file in " + ~ "{ROAST_VERSION_FILE}: $_\nDefaulting to test files from $file" + and return $file; + + # Make a new test file name using the version of the roast. The master + # branch would have version something like `6.d-proposals`; in such + # a case, we'll use the default test file list + my $new-file = $file ~ (".$ver" unless $ver.contains: 'propos'); + if $new-file.IO.r { + print "Testing Roast version $ver using test file list from $new-file\n"; + return $new-file; + } + + note-in-box "Test list file `$new-file` for Roast version $ver does not exist\n" + ~ "or isn't readable. Defaulting to $file"; + return $file; +} + sub USAGE { say "\n" ~ (require ::('Pod::To::Text')).render($=pod[0]) ~ "\n" } =begin pod From 1623f6fe2f0e48f7f80e3355dd9a1a2ee72e6086 Mon Sep 17 00:00:00 2001 From: Stefan Seifert Date: Fri, 25 Aug 2017 17:20:44 +0200 Subject: [PATCH 174/692] Test more integerial return types in NC --- t/04-nativecall/01-argless.c | 10 ++++++++++ t/04-nativecall/01-argless.t | 10 +++++++--- 2 files changed, 17 insertions(+), 3 deletions(-) diff --git a/t/04-nativecall/01-argless.c b/t/04-nativecall/01-argless.c index 6835efc599e..1b1edfcf78b 100644 --- a/t/04-nativecall/01-argless.c +++ b/t/04-nativecall/01-argless.c @@ -17,6 +17,16 @@ DLLEXPORT int Argless() return 2; } +DLLEXPORT char ArglessChar() +{ + return 2; +} + +DLLEXPORT long long ArglessLongLong() +{ + return 2; +} + DLLEXPORT int long_and_complicated_name() { return 3; diff --git a/t/04-nativecall/01-argless.t b/t/04-nativecall/01-argless.t index e1ef148e31b..8478043f0da 100644 --- a/t/04-nativecall/01-argless.t +++ b/t/04-nativecall/01-argless.t @@ -5,19 +5,23 @@ use CompileTestLib; use NativeCall; use Test; -plan 5; +plan 10; compile_test_lib('01-argless'); sub Nothing() is native('./01-argless') { * } sub Argless() is native('./01-argless') returns int32 { * } +sub ArglessChar() is native('./01-argless') returns int8 { * } +sub ArglessLongLong() is native('./01-argless') returns int64 { * } sub short() is native('./01-argless') returns int32 is symbol('long_and_complicated_name') { * } -Nothing(); +Nothing() for ^2; pass 'survived the call'; -is Argless(), 2, 'called argless function'; +is Argless(), 2, 'called argless function' for ^2; +is ArglessChar(), 2, 'called argless function' for ^2; +is ArglessLongLong(), 2, 'called argless function' for ^2; is short(), 3, 'called long_and_complicated_name'; From 7efef1194c469d837d74fa044c8a62e30abb17e0 Mon Sep 17 00:00:00 2001 From: Stefan Seifert Date: Sat, 26 Aug 2017 11:12:39 +0200 Subject: [PATCH 175/692] Test Pointer return values in argless function --- t/04-nativecall/01-argless.c | 6 ++++++ t/04-nativecall/01-argless.t | 4 +++- 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/t/04-nativecall/01-argless.c b/t/04-nativecall/01-argless.c index 1b1edfcf78b..e737bb750f0 100644 --- a/t/04-nativecall/01-argless.c +++ b/t/04-nativecall/01-argless.c @@ -27,6 +27,12 @@ DLLEXPORT long long ArglessLongLong() return 2; } +int my_int = 2; +DLLEXPORT int* ArglessPointer() +{ + return &my_int; +} + DLLEXPORT int long_and_complicated_name() { return 3; diff --git a/t/04-nativecall/01-argless.t b/t/04-nativecall/01-argless.t index 8478043f0da..c0f865fde66 100644 --- a/t/04-nativecall/01-argless.t +++ b/t/04-nativecall/01-argless.t @@ -5,7 +5,7 @@ use CompileTestLib; use NativeCall; use Test; -plan 10; +plan 12; compile_test_lib('01-argless'); @@ -13,6 +13,7 @@ sub Nothing() is native('./01-argless') { * } sub Argless() is native('./01-argless') returns int32 { * } sub ArglessChar() is native('./01-argless') returns int8 { * } sub ArglessLongLong() is native('./01-argless') returns int64 { * } +sub ArglessPointer() is native('./01-argless') returns Pointer[int32] { * } sub short() is native('./01-argless') returns int32 is symbol('long_and_complicated_name') { * } Nothing() for ^2; @@ -22,6 +23,7 @@ pass 'survived the call'; is Argless(), 2, 'called argless function' for ^2; is ArglessChar(), 2, 'called argless function' for ^2; is ArglessLongLong(), 2, 'called argless function' for ^2; +is ArglessPointer().deref, 2, 'called argless function' for ^2; is short(), 3, 'called long_and_complicated_name'; From 1cb266b8da959d624872b6b7e22e8785349a8a7f Mon Sep 17 00:00:00 2001 From: Stefan Seifert Date: Sat, 26 Aug 2017 15:26:23 +0200 Subject: [PATCH 176/692] Test argless native functions returning strings --- t/04-nativecall/01-argless.c | 6 ++++++ t/04-nativecall/01-argless.t | 12 +++++++----- 2 files changed, 13 insertions(+), 5 deletions(-) diff --git a/t/04-nativecall/01-argless.c b/t/04-nativecall/01-argless.c index e737bb750f0..3a44a96995d 100644 --- a/t/04-nativecall/01-argless.c +++ b/t/04-nativecall/01-argless.c @@ -33,6 +33,12 @@ DLLEXPORT int* ArglessPointer() return &my_int; } +char *my_str = "Just a string"; +DLLEXPORT int* ArglessUTF8String() +{ + return my_str; +} + DLLEXPORT int long_and_complicated_name() { return 3; diff --git a/t/04-nativecall/01-argless.t b/t/04-nativecall/01-argless.t index c0f865fde66..90b4713c9a8 100644 --- a/t/04-nativecall/01-argless.t +++ b/t/04-nativecall/01-argless.t @@ -5,7 +5,7 @@ use CompileTestLib; use NativeCall; use Test; -plan 12; +plan 14; compile_test_lib('01-argless'); @@ -14,16 +14,18 @@ sub Argless() is native('./01-argless') returns int32 { * } sub ArglessChar() is native('./01-argless') returns int8 { * } sub ArglessLongLong() is native('./01-argless') returns int64 { * } sub ArglessPointer() is native('./01-argless') returns Pointer[int32] { * } +sub ArglessUTF8String() is native('./01-argless') returns Str { * } sub short() is native('./01-argless') returns int32 is symbol('long_and_complicated_name') { * } Nothing() for ^2; pass 'survived the call'; -is Argless(), 2, 'called argless function' for ^2; -is ArglessChar(), 2, 'called argless function' for ^2; -is ArglessLongLong(), 2, 'called argless function' for ^2; -is ArglessPointer().deref, 2, 'called argless function' for ^2; +is Argless(), 2, 'called argless function returning int32' for ^2; +is ArglessChar(), 2, 'called argless function returning char' for ^2; +is ArglessLongLong(), 2, 'called argless function returning long long' for ^2; +is ArglessPointer().deref, 2, 'called argless function returning pointer' for ^2; +is ArglessUTF8String(), 'Just a string', 'called argless function returning string' for ^2; is short(), 3, 'called long_and_complicated_name'; From a06ebaf215460769e109a3b2d2bdbe7e8f828565 Mon Sep 17 00:00:00 2001 From: Stefan Seifert Date: Wed, 23 Aug 2017 15:53:42 +0200 Subject: [PATCH 177/692] Use the new nativeinvoke for calling JITed NC code directly --- lib/NativeCall.pm6 | 191 ++++++++++++++++++++++++++++----------- tools/build/NQP_REVISION | 2 +- 2 files changed, 141 insertions(+), 52 deletions(-) diff --git a/lib/NativeCall.pm6 b/lib/NativeCall.pm6 index 2eece730b0d..368aeade455 100644 --- a/lib/NativeCall.pm6 +++ b/lib/NativeCall.pm6 @@ -317,7 +317,7 @@ my role Native[Routine $r, $libname where Str|Callable|List|IO::Path|Distributio } my Mu $arg_info := param_list_for($r.signature, $r); my $conv = self.?native_call_convention || ''; - nqp::buildnativecall(self, + my $jitted = nqp::buildnativecall(self, nqp::unbox_s($guessed_libname), # library name nqp::unbox_s(gen_native_symbol($r, :$!cpp-name-mangler)), # symbol to call nqp::unbox_s($conv), # calling convention @@ -325,7 +325,7 @@ my role Native[Routine $r, $libname where Str|Callable|List|IO::Path|Distributio return_hash_for($r.signature, $r, :$!entry-point)); $!rettype := nqp::decont(map_return_type($r.returns)); $!arity = $r.signature.arity; - $!setup = 1; + $!setup = $jitted ?? 2 !! 1; $!any-optionals = self!any-optionals; } @@ -338,6 +338,140 @@ my role Native[Routine $r, $libname where Str|Callable|List|IO::Path|Distributio return False } + method !decont-for-type($type) { + $type ~~ Str ?? 'decont_s' + !! $type ~~ Int ?? 'decont_i' + !! $type ~~ Num ?? 'decont_n' + !! 'decont'; + } + + method !create-jit-compiled-function-body(Routine $r) { + my $block := QAST::Block.new(:arity($!arity)); + my $locals = 0; + my @deconts; + my @params; + for $r.signature.params { + next if nqp::istype($r, Method) && $_.name // '' eq '%_'; + my $name = $_.name || '__anonymous_param__' ~ $++; + my $lowered_param_name = '__lowered_param__' ~ $locals; + my $lowered_name = '__lowered__' ~ $locals++; + $block.push: QAST::Var.new( + :name($lowered_name), + :scope, + :decl, + :returns( + $_.type ~~ Str ?? nqp::bootstr() + !! $_.type ~~ Int ?? nqp::bootint() + !! $_.type ~~ Num ?? nqp::bootnum() + !! $_.type + ), + ); + @params.push: QAST::Var.new(:scope, :name($lowered_name)); + @deconts.push: QAST::Var.new( + :name($lowered_param_name), + :scope, + :decl, + :slurpy($_.slurpy ?? 1 !! 0), + ); + @deconts.push: QAST::Op.new( + :op, + QAST::Op.new( + :op, + QAST::Var.new(:scope, :name($lowered_param_name)), + ), + QAST::Op.new( + :op, + QAST::Var.new(:scope, :name($lowered_name)), + QAST::Op.new( + :op(self!decont-for-type($_.type)), + QAST::Var.new(:scope, :name($lowered_param_name)), + ), + ), + QAST::Op.new( + :op, + QAST::Var.new(:scope, :name($lowered_name)), + $_.type ~~ Str ?? QAST::SVal.new() + !! $_.type ~~ Int ?? QAST::IVal.new(:value(0)) + !! $_.type ~~ Num ?? QAST::NVal.new(:value(0)) + !! QAST::IVal.new(:value(0)) + ), + ); + } + $block.push: nqp::decont($_) for @deconts; # do not interrupt the locals definitions + my $invoke_op := QAST::Op.new( + :op, + QAST::WVal.new(:value(self)), + QAST::WVal.new(:value($!rettype)), + ); + $invoke_op.push: nqp::decont($_) for @params; + $block.push: $invoke_op; + $block + } + + method !create-function-body(Routine $r) { + my $block := QAST::Block.new(:arity($!arity)); + my $arglist := QAST::Op.new(:op); + my $locals = 0; + for $r.signature.params { + next if nqp::istype($r, Method) && $_.name // '' eq '%_'; + my $name = $_.name || '__anonymous_param__' ~ $++; + my $decont = self!decont-for-type($_.type); + if $_.rw and nqp::objprimspec($_.type) > 0 { + $block.push: QAST::Var.new( + :name($name), + :scope, + :decl, + :returns($_.type), + ); + my $lowered_name = '__lowered_param__' ~ $locals++; + $block.push: QAST::Var.new( + :name($lowered_name), + :scope, + :decl, + QAST::Op.new( + :op, + QAST::Var.new(:scope, :name($name)), + QAST::Var.new(:scope, :name($lowered_name)), + ), + ); + $arglist.push: QAST::Var.new(:scope, :name($name)); + } + else { + my $lowered_name = '__lowered__' ~ $locals++; + $block.push: QAST::Var.new( + :name($lowered_name), + :scope, + :decl, + :slurpy($_.slurpy ?? 1 !! 0), + ); + $block.push: QAST::Op.new( + :op, + QAST::Var.new(:scope, :name($lowered_name)), + QAST::Op.new( + :op, + QAST::Op.new( + :op, + QAST::Var.new(:scope, :name($lowered_name)), + ), + QAST::Op.new( + :op(self!decont-for-type($_.type)), + QAST::Var.new(:scope, :name($lowered_name)), + ), + QAST::Var.new(:scope, :name($lowered_name)), + ), + ); + $arglist.push: QAST::Var.new(:scope, :name($lowered_name)); + } + } + $block.push: QAST::Op.new( + :op, + QAST::WVal.new(:value($!rettype)), + QAST::WVal.new(:value(self)), + $arglist, + ); + $block + } + my $perl6comp := nqp::getcomp("perl6"); my @stages = $perl6comp.stages; Nil until @stages.shift eq 'optimize'; @@ -348,55 +482,10 @@ my role Native[Routine $r, $libname where Str|Callable|List|IO::Path|Distributio nqp::setobjsc(self, $sc); my int $idx = nqp::scobjcount($sc); nqp::scsetobj($sc, $idx, self); - my $block := QAST::Block.new(:arity($!arity)); - my $arglist := QAST::Op.new(:op); - my $locals = 0; - for $r.signature.params { - my $name = $_.name || '__anonymous_param__' ~ $++; - if $_.rw and nqp::objprimspec($_.type) > 0 { - $block.push: QAST::Var.new( - :name($name), - :scope, - :decl, - :returns($_.type), - ); - my $lowered_name = '__lowered_param__' ~ $locals++; - $block.push: QAST::Var.new( - :name($lowered_name), - :scope, - :decl, - QAST::Op.new( - :op, - QAST::Var.new(:scope, :name($name)), - QAST::Var.new(:scope, :name($lowered_name)), - ), - ); - $arglist.push: QAST::Var.new(:scope, :name($name)); - } - else { - $block.push: QAST::Var.new( - :name($name), - :scope, - :decl, - :slurpy($_.slurpy ?? 1 !! 0), - ); - $arglist.push: nqp::objprimspec($_.type) == 0 - ?? QAST::Op.new( - :op('decont'), - QAST::Var.new(:scope, :name($name)), - ) - !! QAST::Var.new(:scope :name($name)); - } - } - my $stmts := QAST::Stmts.new( - QAST::Op.new( - :op, - QAST::WVal.new(:value($!rettype)), - QAST::WVal.new(:value(self)), - $arglist, - ), - ); - $block.push: $stmts; + + my $block := $!setup == 2 + ?? self!create-jit-compiled-function-body($r) + !! self!create-function-body($r); my $result := $block; $result := $perl6comp.^can($_) diff --git a/tools/build/NQP_REVISION b/tools/build/NQP_REVISION index c5c8f5e3164..0bd4babcb8f 100644 --- a/tools/build/NQP_REVISION +++ b/tools/build/NQP_REVISION @@ -1 +1 @@ -2017.09-36-g1f0a598e3 \ No newline at end of file +2017.09-37-g71fc322e5 From d00b5e3aa9bd54b39cd7af3ba3312eca4c920da1 Mon Sep 17 00:00:00 2001 From: Stefan Seifert Date: Sat, 2 Sep 2017 18:35:21 +0200 Subject: [PATCH 178/692] Give generated native call function bodies a name nqp::setcodename only sets the name of the runtime code object. The static frame takes its name from the block itself. timotimo++ for giving the deciding hint! --- lib/NativeCall.pm6 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/NativeCall.pm6 b/lib/NativeCall.pm6 index 368aeade455..091fa5a25b5 100644 --- a/lib/NativeCall.pm6 +++ b/lib/NativeCall.pm6 @@ -346,7 +346,7 @@ my role Native[Routine $r, $libname where Str|Callable|List|IO::Path|Distributio } method !create-jit-compiled-function-body(Routine $r) { - my $block := QAST::Block.new(:arity($!arity)); + my $block := QAST::Block.new(:name($r.name), :arity($!arity)); my $locals = 0; my @deconts; my @params; @@ -409,7 +409,7 @@ my role Native[Routine $r, $libname where Str|Callable|List|IO::Path|Distributio } method !create-function-body(Routine $r) { - my $block := QAST::Block.new(:arity($!arity)); + my $block := QAST::Block.new(:name($r.name), :arity($!arity)); my $arglist := QAST::Op.new(:op); my $locals = 0; for $r.signature.params { From 269fe7dbbd7b4c8382d3fb1083ba9b9b5109eb55 Mon Sep 17 00:00:00 2001 From: Stefan Seifert Date: Sun, 3 Sep 2017 16:49:53 +0200 Subject: [PATCH 179/692] Remove unnecessary creation of an extra serialization context Adding the sub to a newly created SC when it's already added to one will actively prevent spesh from optimizing as it won't be able to find the WVal for self. Furthermore this would also prevent us from JIT compiling the sub's body. However, adding to an SC is vital when dealing with function pointers returned from native code as those subs will not be added to an SC by the compiler. --- lib/NativeCall.pm6 | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/lib/NativeCall.pm6 b/lib/NativeCall.pm6 index 091fa5a25b5..57752ddc3a4 100644 --- a/lib/NativeCall.pm6 +++ b/lib/NativeCall.pm6 @@ -478,10 +478,12 @@ my role Native[Routine $r, $libname where Str|Callable|List|IO::Path|Distributio method !create-optimized-call() { $setup-lock.protect: { - my $sc := nqp::createsc('NativeCallSub' ~ nqp::objectid(self)); - nqp::setobjsc(self, $sc); - my int $idx = nqp::scobjcount($sc); - nqp::scsetobj($sc, $idx, self); + unless nqp::defined(nqp::getobjsc(self)) { + my $sc := nqp::createsc('NativeCallSub' ~ nqp::objectid(self)); + nqp::setobjsc(self, $sc); + my int $idx = nqp::scobjcount($sc); + nqp::scsetobj($sc, $idx, self); + } my $block := $!setup == 2 ?? self!create-jit-compiled-function-body($r) From 50d2013de5db1a8ed3ee6ca6755816886fefaf3f Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Wed, 27 Sep 2017 14:07:04 +0000 Subject: [PATCH 180/692] Report reason for failure when can't read roast version --- t/harness6 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/t/harness6 b/t/harness6 index 00001b16586..2e7bf407b1d 100644 --- a/t/harness6 +++ b/t/harness6 @@ -146,10 +146,11 @@ sub note-in-box { note "{'#' x 76}\n\n$^text\n\n{'#' x 76}\n" } sub convert-to-versioned-file ($file) { return $file unless $file eq FULL_ROAST_TEST_LIST_FILE; - ROAST_VERSION_FILE.IO.open - andthen my $ver = .lines.grep({!/\s* '#'/}).head.trim + my $ver = .lines.grep({!/\s* '#'/}).head.trim + with ROAST_VERSION_FILE.IO.open orelse note-in-box "Failed to open roast VERSION file in " - ~ "{ROAST_VERSION_FILE}: $_\nDefaulting to test files from $file" + ~ "{ROAST_VERSION_FILE}: " ~ .exception.message + ~ "\nDefaulting to test files from $file" and return $file; # Make a new test file name using the version of the roast. The master From f62950dcc87d684fbd9d2b5d7a9b5d8d0e7e5562 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Wed, 27 Sep 2017 14:26:27 +0000 Subject: [PATCH 181/692] Remove dead test files from 6.d.proposals test file list All of these files are just empty dummies[^1] that existed only to ensure their 6.c-errata counterparts run. Now, they live in their separate t/spectest.data.6.c list [1] https://github.com/perl6/roast/commit/aa29b31f90 --- t/spectest.data | 5 ----- 1 file changed, 5 deletions(-) diff --git a/t/spectest.data b/t/spectest.data index 87dc69cb319..881972a3110 100644 --- a/t/spectest.data +++ b/t/spectest.data @@ -204,7 +204,6 @@ S03-operators/assign.t S03-operators/autoincrement-range.t S03-operators/autoincrement.t S03-operators/autovivification.t -S03-operators/bag.t S03-operators/basic-types.t S03-operators/bit.t S03-operators/boolean-bitwise.t @@ -232,7 +231,6 @@ S03-operators/lcm.t S03-operators/list-quote-junction.t S03-operators/minmax.t S03-operators/misc.t -S03-operators/mix.t S03-operators/names.t S03-operators/nesting.t S03-operators/not.t @@ -247,7 +245,6 @@ S03-operators/reduce-le1arg.t S03-operators/relational.t S03-operators/repeat.t S03-operators/scalar-assign.t -S03-operators/set.t S03-operators/set_addition.t S03-operators/set_difference.t S03-operators/set_elem.t @@ -318,7 +315,6 @@ S04-phasers/check.t S04-phasers/descending-order.t S04-phasers/end.t S04-phasers/enter-leave.t -S04-phasers/eval-in-begin.t S04-phasers/first.t S04-phasers/init.t S04-phasers/in-eval.t @@ -715,7 +711,6 @@ S15-nfg/grapheme-break.t # moar S15-nfg/GraphemeBreakTest.t # moar S15-nfg/emoji-test.t # moar S15-nfg/long-uni.t # moar -S15-nfg/mass-chars.t # moar S15-nfg/many-combiners.t # moar S15-nfg/many-threads.t # moar S15-nfg/mass-equality.t # moar From 85ae1c92a7cad5236c3fac9a12ed126fa72b5d5d Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Wed, 27 Sep 2017 14:33:28 +0000 Subject: [PATCH 182/692] Check for proposal roast versions case insensitively --- t/harness5 | 2 +- t/harness6 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/t/harness5 b/t/harness5 index 4adbd13dc47..7a4d6e86bde 100644 --- a/t/harness5 +++ b/t/harness5 @@ -206,7 +206,7 @@ sub convert_to_versioned_file { # Make a new test file name using the version of the roast. The master # branch would have version something like `6.d-proposals`; in such # a case, we'll use the default test file list - my $new_file = $ver =~ /propos/ ? $file : "$file.$ver"; + my $new_file = $ver =~ /propos/i ? $file : "$file.$ver"; if (-r $new_file) { print "Testing Roast version $ver using test file list from $new_file\n"; return $new_file; diff --git a/t/harness6 b/t/harness6 index 2e7bf407b1d..c7c42b9bc36 100644 --- a/t/harness6 +++ b/t/harness6 @@ -156,7 +156,7 @@ sub convert-to-versioned-file ($file) { # Make a new test file name using the version of the roast. The master # branch would have version something like `6.d-proposals`; in such # a case, we'll use the default test file list - my $new-file = $file ~ (".$ver" unless $ver.contains: 'propos'); + my $new-file = $file ~ (".$ver" unless $ver.lc.contains: 'propos'); if $new-file.IO.r { print "Testing Roast version $ver using test file list from $new-file\n"; return $new-file; From dd8a610214957a7194f73d30fffcf182f4f6b0eb Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Wed, 27 Sep 2017 14:38:12 +0000 Subject: [PATCH 183/692] Document how spectest.data file versioning works --- docs/roast-spectest.data-versioning.md | 14 ++++++++++++++ 1 file changed, 14 insertions(+) create mode 100644 docs/roast-spectest.data-versioning.md diff --git a/docs/roast-spectest.data-versioning.md b/docs/roast-spectest.data-versioning.md new file mode 100644 index 00000000000..963446f5b6c --- /dev/null +++ b/docs/roast-spectest.data-versioning.md @@ -0,0 +1,14 @@ +The files `t/spectest.data*` specify the list of files to use to test a +specific roast version. The version to test is obtained from the VERSION +file in roast checkout (`t/spec/VERSION`). + +The default file is `t/spectest.data` and it's used is roast version could not +be obtained or if the version matches string `propo` (e.g. `6.d.proposal`). +Otherwise, the version is used as a suffix, separated with a dot: + + VERSION file contains "6.c" => tests read from t/spectest.data.6.c + +The master roast branch would typically contain a proposal version (`6.d.proposal`). +Once that language version is released and a new branch with it is published, the +VERSION file will be changed (`6.d`) and a new spectest.data file will be created +(`t/spectest.data.6.d`). From 36122f158fb7f206fc5abc8ea71d375367d3accf Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Wed, 27 Sep 2017 10:47:36 -0400 Subject: [PATCH 184/692] =?UTF-8?q?Document=20spectest.data=20is=20also=20?= =?UTF-8?q?used=20when=E2=80=A6?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit …file for specific version file isn't readable --- docs/roast-spectest.data-versioning.md | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/docs/roast-spectest.data-versioning.md b/docs/roast-spectest.data-versioning.md index 963446f5b6c..3d8cccd27d9 100644 --- a/docs/roast-spectest.data-versioning.md +++ b/docs/roast-spectest.data-versioning.md @@ -2,8 +2,9 @@ The files `t/spectest.data*` specify the list of files to use to test a specific roast version. The version to test is obtained from the VERSION file in roast checkout (`t/spec/VERSION`). -The default file is `t/spectest.data` and it's used is roast version could not -be obtained or if the version matches string `propo` (e.g. `6.d.proposal`). +The default file is `t/spectest.data` and it's used if roast version could not +be obtained, if the `spectest.data` file for the requested version doesn't +exist or isn't readable, or if the version matches string `propo` (e.g. `6.d.proposal`). Otherwise, the version is used as a suffix, separated with a dot: VERSION file contains "6.c" => tests read from t/spectest.data.6.c From 2a512f0c23462bec1bcef5fb94501ea7edad2236 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Wed, 27 Sep 2017 14:48:50 +0000 Subject: [PATCH 185/692] Skip empty lines when reading roast VERSION file --- t/harness5 | 2 +- t/harness6 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/t/harness5 b/t/harness5 index 7a4d6e86bde..c61dbfec9ef 100644 --- a/t/harness5 +++ b/t/harness5 @@ -201,7 +201,7 @@ sub convert_to_versioned_file { . "Defaulting to test files from $file"; return $file; }; - (my $ver = (grep !/^\s*#/, <$fh>)[0]) =~ s/^\s+|\s+$//g; + (my $ver = (grep !/^\s*#/ && /\S/, <$fh>)[0]) =~ s/^\s+|\s+$//g; # Make a new test file name using the version of the roast. The master # branch would have version something like `6.d-proposals`; in such diff --git a/t/harness6 b/t/harness6 index c7c42b9bc36..000eb659b99 100644 --- a/t/harness6 +++ b/t/harness6 @@ -146,7 +146,7 @@ sub note-in-box { note "{'#' x 76}\n\n$^text\n\n{'#' x 76}\n" } sub convert-to-versioned-file ($file) { return $file unless $file eq FULL_ROAST_TEST_LIST_FILE; - my $ver = .lines.grep({!/\s* '#'/}).head.trim + my $ver = .lines.grep({!/\s* '#'/ and .trim.chars}).head.trim with ROAST_VERSION_FILE.IO.open orelse note-in-box "Failed to open roast VERSION file in " ~ "{ROAST_VERSION_FILE}: " ~ .exception.message From f1334512483f3f82d5c3f0a8b5f0b4a4df147ee3 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Wed, 27 Sep 2017 15:28:06 +0000 Subject: [PATCH 186/692] Remove Perlism --- t/harness6 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/t/harness6 b/t/harness6 index 000eb659b99..c4f927b39d2 100644 --- a/t/harness6 +++ b/t/harness6 @@ -158,7 +158,7 @@ sub convert-to-versioned-file ($file) { # a case, we'll use the default test file list my $new-file = $file ~ (".$ver" unless $ver.lc.contains: 'propos'); if $new-file.IO.r { - print "Testing Roast version $ver using test file list from $new-file\n"; + say "Testing Roast version $ver using test file list from $new-file"; return $new-file; } From 56193b591691af4ae2bcb9c24e93164fdac4a262 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Wed, 27 Sep 2017 15:42:59 +0000 Subject: [PATCH 187/692] Remove jobs blocker 'cause it fixed now: https://irclog.perlgeek.de/perl6-dev/2017-09-27#i_15224958 --- t/harness6 | 1 - 1 file changed, 1 deletion(-) diff --git a/t/harness6 b/t/harness6 index c4f927b39d2..ebc6fc0d6e6 100644 --- a/t/harness6 +++ b/t/harness6 @@ -38,7 +38,6 @@ sub MAIN( Str :$perl5path = 'perl', *@files, ) { - die "TEST_JOBS > 1 is currently broken" if $jobs and $jobs > 1; my @slow; with $tests-from-file { $tests-from-file .= &convert-to-versioned-file; From 80f883bc7b18c7c009197781e0b3092cd05558ed Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Wed, 27 Sep 2017 18:55:01 +0200 Subject: [PATCH 188/692] Do not resume after emit by closed `supply` block --- src/core/Supply.pm | 58 +++++++++++++++++++++++++--------------------- 1 file changed, 31 insertions(+), 27 deletions(-) diff --git a/src/core/Supply.pm b/src/core/Supply.pm index 0f5baf74ae1..3e71e027ada 100644 --- a/src/core/Supply.pm +++ b/src/core/Supply.pm @@ -1833,6 +1833,7 @@ augment class Rakudo::Internals { $!lock.protect: { @active = %!active-taps.values; %!active-taps = (); + $!active = 0; } @active } @@ -1919,33 +1920,36 @@ augment class Rakudo::Internals { method !run-supply-code(&code, \value, $state, &add-whenever) { my @run-after; my $queued := $state.run-async-lock.protect-or-queue-on-recursion: { - return unless $state.active > 0; - my &*ADD-WHENEVER = &add-whenever; - my $emitter = { - my \ex := nqp::exception(); - my $emit-handler := $state.emit; - $emit-handler(nqp::getpayload(ex)) if $emit-handler.DEFINITE; - nqp::resume(ex) - } - my $done = { - $state.get-and-zero-active(); - self!teardown($state); - my $done-handler := $state.done; - $done-handler() if $done-handler.DEFINITE; - } - my $catch = { - my \ex = EXCEPTION(nqp::exception()); - $state.get-and-zero-active(); - self!teardown($state); - my $quit-handler = $state.quit; - $quit-handler(ex) if $quit-handler; - } - nqp::handle(code(value), - 'EMIT', $emitter(), - 'DONE', $done(), - 'CATCH', $catch(), - 'NEXT', 0); - @run-after = $state.awaiter.take-all; + if $state.active > 0 { + my &*ADD-WHENEVER = &add-whenever; + my $emitter = { + if $state.active { + my \ex := nqp::exception(); + my $emit-handler := $state.emit; + $emit-handler(nqp::getpayload(ex)) if $emit-handler.DEFINITE; + nqp::resume(ex) + } + } + my $done = { + $state.get-and-zero-active(); + self!teardown($state); + my $done-handler := $state.done; + $done-handler() if $done-handler.DEFINITE; + } + my $catch = { + my \ex = EXCEPTION(nqp::exception()); + $state.get-and-zero-active(); + self!teardown($state); + my $quit-handler = $state.quit; + $quit-handler(ex) if $quit-handler; + } + nqp::handle(code(value), + 'EMIT', $emitter(), + 'DONE', $done(), + 'CATCH', $catch(), + 'NEXT', 0); + @run-after = $state.awaiter.take-all; + } } if $queued.defined { $queued.then({ self!run-add-whenever-awaits(@run-after) }); From 9837687d93c907ec232b1c7635776aa0c7faa6bc Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Wed, 27 Sep 2017 19:17:53 +0200 Subject: [PATCH 189/692] Stage 1 of auto-generated BUILDALL methods - generates all necessary methods, but with _UNDER_CONSTRUCTION postfix - this allows care-free building of the setting - added a Mu.new_UNDER_CONSTRUCTION, which calls autogenerated BUILDALL - this also allows for easy benchmarking of old/new object build methodology - preliminary benchmarks indicate 1.5x faster object creation - breaks several introspection spectests that do not expect the extra method So what's stopping removing the _UNDER_CONSTRUCTION postfix? Well, core and core.d setting compilation complete, but something in the installation still fails. Investigating this further. But I wouldn't want to keep this sizable work from all of your inspecting eyes for much longer :-) *phew* --- src/Perl6/Metamodel/ClassHOW.nqp | 39 +- .../Metamodel/MROBasedMethodDispatch.nqp | 4 + src/Perl6/World.nqp | 490 ++++++++++++++++++ src/core/Mu.pm | 11 + src/core/Rakudo/Internals.pm | 3 + 5 files changed, 539 insertions(+), 8 deletions(-) diff --git a/src/Perl6/Metamodel/ClassHOW.nqp b/src/Perl6/Metamodel/ClassHOW.nqp index 551b121406c..f6e2dea34ba 100644 --- a/src/Perl6/Metamodel/ClassHOW.nqp +++ b/src/Perl6/Metamodel/ClassHOW.nqp @@ -143,19 +143,42 @@ class Perl6::Metamodel::ClassHOW }); } - # Publish type and method caches. - self.publish_type_cache($obj); - self.publish_method_cache($obj); - self.publish_boolification_spec($obj); + # This isn't an augment. + unless $was_composed { - # Create BUILDPLAN. - self.create_BUILDPLAN($obj); + # Create BUILDPLAN. + my $BUILDALLPLAN := self.create_BUILDPLAN($obj); - # Compose the representation, provided this isn't an augment. - unless $was_composed { + # Create BUILDALL method if we can (if we can't, the one from + # Mu will be used, which will iterate over the BUILDALLPLAN at + # runtime). + if nqp::isconcrete($compiler_services) { + my $builder := nqp::findmethod( + $compiler_services,'generate_buildplan_executor'); + my $method := $builder($compiler_services,$obj,$BUILDALLPLAN); + if $method =:= NQPMu { + nqp::say('Could not generate a BUILDALL for ' ~ $obj.HOW.name($obj)); + } + else { + $method.set_name('BUILDALL_UNDER_CONSTRUCTION'); + my $result := try { + self.add_method($obj,'BUILDALL_UNDER_CONSTRUCTION',$method) + } + unless $result { + nqp::say($obj.HOW.name($obj) ~ ' failed to add a BUILDALL'); + } + } + } + + # Compose the representation self.compose_repr($obj); } + # Publish type and method caches. + self.publish_type_cache($obj); + self.publish_method_cache($obj); + self.publish_boolification_spec($obj); + # Compose the meta-methods. self.compose_meta_methods($obj); diff --git a/src/Perl6/Metamodel/MROBasedMethodDispatch.nqp b/src/Perl6/Metamodel/MROBasedMethodDispatch.nqp index 44254945782..48d35825c03 100644 --- a/src/Perl6/Metamodel/MROBasedMethodDispatch.nqp +++ b/src/Perl6/Metamodel/MROBasedMethodDispatch.nqp @@ -2,6 +2,10 @@ role Perl6::Metamodel::MROBasedMethodDispatch { # While we normally end up locating methods through the method cache, # this is here as a fallback. method find_method($obj, $name, :$no_fallback, *%adverbs) { + +# uncomment line below for verbose information about uncached method lookups +#nqp::say( "looking for " ~ $name ~ " in " ~ $obj.HOW.name($obj) ); +# if nqp::can($obj.HOW, 'submethod_table') { my %submethods := $obj.HOW.submethod_table($obj); if nqp::existskey(%submethods, $name) { diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index 65772a8b672..93653c07c60 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -2960,12 +2960,17 @@ class Perl6::World is HLL::World { } my class CompilerServices { + + # Instantiated World object has $!w; # We share one Signature object among accessors for a given package. has $!acc_sig_cache; has $!acc_sig_cache_type; + # The generic BUILDALL method for empty BUILDPLANs + has $!empty_buildplan_method; + method generate_accessor(str $meth_name, $package_type, str $attr_name, $type, int $rw) { my $native := nqp::objprimspec($type) != 0; my $acc := QAST::Var.new( @@ -3011,7 +3016,492 @@ class Perl6::World is HLL::World { $code.set_rw() if $rw; return $code; } + + # Mapping of primspec to attribute postfix + my @psp := ('','_i','_n','_s'); + + # Mapping of primspec to native numeric default value op + my @psd := (nqp::null, + QAST::IVal.new( :value(0) ), + QAST::NVal.new( :value(0e0) ) + ); + + # signature configuration hash for ":(%init)" + my %sig_init := + nqp::hash('parameters', [nqp::hash('variable_name','%init')]); + + # Generate a method for building a new object that takes a hash + # with attribute => value pairs to be assigned to the object's + # attributes. Basically a flattened version of Mu.BUILDALL, which + # iterates over the BUILDALLPLAN at runtime with fewer inlining + # and JITting opportunities. + method generate_buildplan_executor($in_object, $in_build_plan) { + + # deconted / low level hash access + my $object := nqp::decont($in_object); + my $build_plan := nqp::getattr( + nqp::decont($in_build_plan), + $!w.find_symbol(['List']), + '$!reified' + ); + + # Do we need to wrap an exception handler + my int $needs_wrapping; + + # There's a BUILDPLAN to work with + if nqp::elems($build_plan) -> $count { + + # The basic statements for object initialization, to be + # filled in later + my $stmts := QAST::Stmts.new(); + + my $declarations := QAST::Stmts.new( + QAST::Var.new(:decl, :scope, :name), + QAST::Var.new(:decl, :scope, :name('%init')), + QAST::Var.new(:decl, :scope, :name) + ); + + # The block of the method + my $block := QAST::Block.new( + :name, :blocktype, + $declarations + ); + + # Register the block in its SC + $!w.cur_lexpad()[0].push($block); + +# :(Foo:D: %init) + my $sig := $!w.create_signature_and_params( + NQPMu, %sig_init, $block, 'Any', :method, + invocant_type => $!w.create_definite_type( + $!w.find_symbol(['Metamodel','DefiniteHOW']), + $object, + 1 + ) + ); + +# my $init := nqp::getattr(%init,Map,'$!storage') + $stmts.push(QAST::Op.new( + :op('bind'), + (my $init := QAST::Var.new(:scope, :name)), + QAST::Op.new( + :op('getattr'), + QAST::Var.new( :scope, :name('%init') ), + QAST::WVal.new( :value($!w.find_symbol(['Map'])) ), + QAST::SVal.new( :value('$!storage') ) + ) + )); + + my int $i := -1; + while nqp::islt_i($i := nqp::add_i($i, 1), $count) { + + # We have some intricate action to do + if nqp::islist(my $task := nqp::atpos($build_plan,$i)) { + + # Register the class in the SC if needed + $!w.add_object_if_no_sc( nqp::atpos($task,1) ); + + # Generate the WVal for setting the class object + my $classwval := + QAST::WVal.new( :value(nqp::atpos($task,1) ) ); + + if nqp::atpos($task,0) -> $code { + + # 1,2,3 = initialize native from %init + if $code < 4 { + +# nqp::existskey($init,'a') + my $existskeyop := QAST::Op.new( + :op('existskey'), + $init, + QAST::SVal.new( :value(nqp::atpos($task,3)) ) + ); + +# nqp::bindattr_x(self,Foo,'$!a',nqp::decont(%init.AT-KEY('a'))) + my $bindattrop := QAST::Op.new( + :op( 'bindattr' ~ @psp[$code] ), + QAST::Var.new( :name, :scope ), + $classwval, + QAST::SVal.new( :value(nqp::atpos($task,2)) ), + QAST::Op.new( :op, + QAST::Op.new( :op, + QAST::Var.new( + :scope, :name('%init')), + QAST::SVal.new( :value ), + QAST::SVal.new( + :value(nqp::atpos($task,3)) ) + ) + ) + ); + +# nqp::if( +# nqp::existskey($init,'a'), +# nqp::bindattr_x(self,Foo,'$!a',nqp::decont(%init.AT-KEY('a'))) +# ), + $stmts.push( + QAST::Op.new(:op,$existskeyop,$bindattrop) + ); + } + + # 4 = set opaque with default if not set yet + elsif $code == 4 { +# nqp::getattr(self,Foo,'$!a') + my $getattrop := QAST::Op.new( :op, + QAST::Var.new( :name, :scope ), + $classwval, + QAST::SVal.new( :value(nqp::atpos($task,2)) ) + ); + +# nqp::unless( +# nqp::attrinited(self,Foo,'$!a'), +# (nqp::getattr(self,Foo,'$!a') = +# $initializer(self,nqp::getattr(self,Foo,'$!a'))) +# ), + $stmts.push( + QAST::Op.new( :op, + QAST::Op.new( :op, + QAST::Var.new(:name, :scope), + $classwval, + QAST::SVal.new( + :value(nqp::atpos($task,2)) + ) + ), + QAST::Op.new( :op, + $getattrop, + QAST::Op.new( :op, + QAST::WVal.new( + :value(nqp::atpos($task,3)) + ), + QAST::Var.new( + :name('self'), + :scope('local') + ), + $getattrop + ) + ) + ) + ); + + $!w.add_object_if_no_sc(nqp::atpos($task,3)); + } + + # 5,6 = set native numeric with default if not set + elsif $code < 7 { +# nqp::getattr_x(self,Foo,'$!a') + my $getattrop := QAST::Op.new( + :op('getattr' ~ @psp[$code - 4]), + QAST::Var.new( :name, :scope ), + $classwval, + QAST::SVal.new( :value(nqp::atpos($task,2)) ) + ); +# nqp::if( +# nqp::iseq_x( +# nqp::getattr_x(self,Foo,'$!a'), +# (native default value) +# ), +# nqp::bindattr_x(self,Foo,'$!a', +# $initializer(self,nqp::getattr_x(self,Foo,'$!a'))) +# ), + $stmts.push( + QAST::Op.new( :op, + QAST::Op.new( + :op('iseq' ~ @psp[$code - 4]), + $getattrop, + @psd[$code - 4], + ), + QAST::Op.new( + :op('bindattr' ~ @psp[$code - 4]), + QAST::Var.new(:name, :scope), + $classwval, + QAST::SVal.new( + :value(nqp::atpos($task,2)) ), + QAST::Op.new( :op, + QAST::WVal.new( + :value(nqp::atpos($task,3)) + ), + QAST::Var.new( + :name('self'), + :scope('local') + ), + $getattrop + ) + ) + ) + ); + + $!w.add_object_if_no_sc(nqp::atpos($task,3)); + } + + # 7 = set native string with default if not set + elsif $code == 7 { +# nqp::getattr_s(self,Foo,'$!a') + my $getattrop := QAST::Op.new( :op, + QAST::Var.new( :name, :scope ), + $classwval, + QAST::SVal.new( :value(nqp::atpos($task,2)) ) + ); + +# nqp::if( +# nqp::isnull_s(nqp::getattr_s(self,Foo,'$!a')), +# nqp::bindattr_s(self,Foo,'$!a', +# $initializer(self,nqp::getattr_s(self,Foo,'$!a'))) +# ), + $stmts.push( + QAST::Op.new( :op, + QAST::Op.new( :op, $getattrop), + QAST::Op.new( :op, + QAST::Var.new(:name, :scope), + $classwval, + QAST::SVal.new( + :value(nqp::atpos($task,2)) ), + QAST::Op.new( :op, + QAST::WVal.new( + :value(nqp::atpos($task,3)) + ), + QAST::Var.new( + :name('self'), + :scope('local') + ), + $getattrop + ) + ) + ) + ); + + $!w.add_object_if_no_sc(nqp::atpos($task,3)); + } + + # 8 = bail if opaque not yet initialized + elsif $code == 8 { +# nqp::getattr(self,Foo,'$!a') + my $getattrop := QAST::Op.new( :op, + QAST::Var.new( :name, :scope ), + $classwval, + QAST::SVal.new( :value(nqp::atpos($task,2)) ) + ); + +# nqp::unless( +# nqp::attrinited(self,Foo,'$!a'), +# X::Attribute::Required.new(name => '$!a', why => (value)) +# ), + $stmts.push( + QAST::Op.new( :op, + QAST::Op.new( :op, + QAST::Var.new(:name, :scope), + $classwval, + QAST::SVal.new( + :value(nqp::atpos($task,2)) + ) + ), + QAST::Op.new( :op, + QAST::Op.new( :op, + QAST::WVal.new( :value( + $!w.find_symbol( + ['X','Attribute','Required'] + ) + )), + QAST::SVal.new( :value ), + QAST::SVal.new( :named('name'), + :value(nqp::atpos($task,2)) + ), + QAST::WVal.new( :named('why'), + :value(nqp::atpos($task,3)) + ) + ), + QAST::SVal.new( :value ), + ) + ) + ); + } + + # 9 = run attribute container initializer + elsif $code == 9 { + +# nqp::bindattr(self,Foo,'$!a',$initializer()) + $stmts.push( + QAST::Op.new( :op, + QAST::Var.new(:name, :scope), + $classwval, + QAST::SVal.new( + :value(nqp::atpos($task,2)) ), + QAST::Op.new( :op, + QAST::WVal.new( + :value(nqp::atpos($task,3)) + ) + ) + ) + ); + + $!w.add_object_if_no_sc(nqp::atpos($task,3)); + } + + else { + nqp::die("Invalid BUILDALL plan"); + } + } + + # 0 = initialize opaque from %init + else { + +# nqp::existskey($init,'a') + my $existskeyop := QAST::Op.new( :op('existskey'), + $init, + QAST::SVal.new( :value(nqp::atpos($task,3)) ) + ); + +# nqp::getattr(self,Foo,'$!a') + my $getattrop := QAST::Op.new( :op, + QAST::Var.new( :name, :scope ), + $classwval, + QAST::SVal.new( :value( nqp::atpos($task,2) ) ) + ); + +#$execution.push(QAST::Op.new( :op('say'), QAST::SVal.new( :value("Initializing for 0: " ~ nqp::atpos($task,2) ~ ' - ' ~ nqp::atpos($task,3)) ))); + +# nqp::if( +# nqp::existskey($init,'a'), +# nqp::getattr(self,Foo,'$!a') = %init.AT-KEY('a') +# ), + $stmts.push( + QAST::Op.new( :op, + $existskeyop, + QAST::Op.new( :op, + $getattrop, + QAST::Op.new( :op, + QAST::Var.new(:scope,:name('%init')), + QAST::SVal.new(:value), + QAST::SVal.new(:value(nqp::atpos($task,3))) + ) + ) + ) + ); + } + } + + # BUILD/TWEAK + else { + + # BUILD or TWEAK without BUILD (first seen) + unless $needs_wrapping { + +# (my $return), + $declarations.push( + QAST::Var.new( + :decl, :scope, :name) + ); + $needs_wrapping := 1 + }; + +# nqp::if( +# nqp::istype( +# ($return := nqp::if( +# nqp::elems($init), +# $task(self,|%init), +# $task(self) +# )), +# Failure +# ), +# return $return +# ), + $stmts.push( + QAST::Op.new( :op, + QAST::Op.new( :op, + QAST::Op.new( :op, + QAST::Var.new(:scope, :name), + QAST::Op.new( :op, + QAST::Op.new( :op, $init ), + QAST::Op.new( :op, + QAST::WVal.new( :value($task) ), + QAST::Var.new( + :name('self'), + :scope('local') + ), + QAST::Var.new( + :scope, + :name, # use nqp::hash directly + :flat(1), + :named(1) + ), + ), + QAST::Op.new( :op, + QAST::WVal.new( :value($task) ), + QAST::Var.new(:name('self'),:scope('local')) + ) + ) + ), + QAST::WVal.new( + :value($!w.find_symbol(['Failure'])) + ), + ), + QAST::Op.new( :op, + QAST::WVal.new( + :value($!w.find_symbol(['&return'])) + ), + QAST::Var.new(:scope, :name) + ) + ) + ); + + $!w.add_object_if_no_sc($task); + } + } + + # Finally, add the return value + $stmts.push(QAST::Var.new(:name('self'), :scope('local'))); + + # Need to wrap an exception handler around + if $needs_wrapping { + $stmts := QAST::Op.new( :op, + $stmts, + 'RETURN', + QAST::Op.new( :op ) + ); + } + + # Add the statements to the block + $block.push($stmts); + + # Create the code object and return it + $!w.create_code_object($block, 'Submethod', $sig) + } + + # Empty buildplan, and we already have an empty buildplan method + elsif $!empty_buildplan_method { + $!empty_buildplan_method + } + + # Empty buildplan, still need to make an empty method + else { + +# submethod :: (Any:D:) { self } + my $block := QAST::Block.new( + :name, :blocktype, + QAST::Stmts.new( + QAST::Var.new(:decl, :scope, :name), + QAST::Var.new(:decl, :scope, :name('%init')), + ), + QAST::Var.new(:name('self'), :scope('local')) + ); + + # Register the block in its SC + $!w.cur_lexpad()[0].push($block); + + my $sig := $!w.create_signature_and_params( + NQPMu, %sig_init, $block, 'Any', :method, + invocant_type => $!w.create_definite_type( + $!w.find_symbol(['Metamodel','DefiniteHOW']), + $!w.find_symbol(['Any']), + 1 + ) + ); + + # Create the code object, save and return it + $!empty_buildplan_method := + $!w.create_code_object($block,'Submethod',$sig) + } + } } + method get_compiler_services() { unless nqp::isconcrete($!compiler_services) { try { diff --git a/src/core/Mu.pm b/src/core/Mu.pm index b82400ec093..9432834b10f 100644 --- a/src/core/Mu.pm +++ b/src/core/Mu.pm @@ -108,6 +108,17 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" nqp::p6bool(nqp::isconcrete(self)) } + method new_UNDER_CONSTRUCTION(*%init) { + nqp::if( + nqp::eqaddr( + (my $bless := nqp::findmethod(self,'bless')), + nqp::findmethod(Mu,'bless') + ), + nqp::create(self).BUILDALL_UNDER_CONSTRUCTION(%init), + nqp::invokewithcapture($bless,nqp::usecapture) + ) + } + proto method new(|) { * } multi method new(*%attrinit) { nqp::if( diff --git a/src/core/Rakudo/Internals.pm b/src/core/Rakudo/Internals.pm index 0324469d45d..4939277691c 100644 --- a/src/core/Rakudo/Internals.pm +++ b/src/core/Rakudo/Internals.pm @@ -1256,6 +1256,9 @@ my class Rakudo::Internals { method generate_accessor(str $name, Mu \package_type, str $attr_name, Mu \type, int $rw) { $!compiler.generate_accessor($name, package_type, $attr_name, type, $rw); } + method generate_buildplan_executor(Mu \obj, Mu \buildplan) { + $!compiler.generate_buildplan_executor(obj, buildplan) + } } method HANDLE-NQP-SPRINTF-ERRORS(Mu \exception) { From bb0ebabc39ec0ffe8db04d6ef1b1dbff115ac1fe Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Wed, 27 Sep 2017 19:38:14 +0200 Subject: [PATCH 190/692] Minimally invasive streamline Proc::Async.new --- src/core/Proc/Async.pm | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/src/core/Proc/Async.pm b/src/core/Proc/Async.pm index 22518c66829..77be2298301 100644 --- a/src/core/Proc/Async.pm +++ b/src/core/Proc/Async.pm @@ -118,11 +118,7 @@ my class Proc::Async { has $!encoder; has @!close-after-exit; - proto method new(|) { * } - multi method new(*@args where .so) { - my $path = @args.shift; - self.bless(:$path, :@args, |%_) - } + method new($path, *@args) { self.bless(:$path, :@args, |%_) } submethod TWEAK(--> Nil) { $!encoder := Encoding::Registry.find($!enc).encoder(:$!translate-nl); From a225e040f1d26055987becf1bc76af8d33f7a78d Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Wed, 27 Sep 2017 17:50:31 +0000 Subject: [PATCH 191/692] Make &DEPRECATED treat $vfrom inclusively The error message says "since blah blah", so it implies the specified version is included. Also, making the version included in the commit message makes it easier to specify restrictions, especially when testing against the language version. --- src/core/Deprecations.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/Deprecations.pm b/src/core/Deprecations.pm index 78af8929e29..8909a30b78a 100644 --- a/src/core/Deprecations.pm +++ b/src/core/Deprecations.pm @@ -59,7 +59,7 @@ sub DEPRECATED($alternative,$from?,$removed?,:$up = 1,:$what,:$file,:$line) { my Version $vremoved; if $from { $vfrom = Version.new($from); - return unless $version cmp $vfrom === More; + return if $version before $vfrom; # not deprecated yet } $vremoved = Version.new($removed) if $removed; From 36bc8e2d95b2b88df7be51dc84570d2793dcca6b Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Wed, 27 Sep 2017 17:51:41 +0000 Subject: [PATCH 192/692] Implement language version testing in &DEPRECATED If :lang-vers Bool param is given, assume the given $vfrom/$vto versions are language versions as opposed to compiler versions. --- src/core/Deprecations.pm | 10 +++++++--- t/02-rakudo/11-deprecated.t | 23 +++++++++++++++++++++++ 2 files changed, 30 insertions(+), 3 deletions(-) create mode 100644 t/02-rakudo/11-deprecated.t diff --git a/src/core/Deprecations.pm b/src/core/Deprecations.pm index 8909a30b78a..552251a1c72 100644 --- a/src/core/Deprecations.pm +++ b/src/core/Deprecations.pm @@ -51,10 +51,14 @@ class Deprecation { } } -sub DEPRECATED($alternative,$from?,$removed?,:$up = 1,:$what,:$file,:$line) { +sub DEPRECATED($alternative,$from?,$removed?,:$up = 1,:$what,:$file,:$line,Bool :$lang-vers) { + state $ver = $*PERL.compiler.version; + my $version = $lang-vers ?? $*PERL.version !! $ver; + # if $lang-vers was given, treat the provided versions as language + # versions, rather than compiler versions. Note that we can't + # `state` the `$*PERL.version` (I think) because different CompUnits + # might be using different versions. - # not deprecated yet - state $version = $*PERL.compiler.version; my Version $vfrom; my Version $vremoved; if $from { diff --git a/t/02-rakudo/11-deprecated.t b/t/02-rakudo/11-deprecated.t new file mode 100644 index 00000000000..104a141cba2 --- /dev/null +++ b/t/02-rakudo/11-deprecated.t @@ -0,0 +1,23 @@ +use lib ; +use Test; +use Test::Util; + +plan 2; + +sub test-deprecation (Str:D $lang, Bool :$is-visible, |c) { + my $args = c.perl; + is_run ' + use \qq[$lang]; + %*ENV:delete; + DEPRECATED "meow", |(\qq[$args]); + ', { :out(''), :err($is-visible ?? /meow/ !! ''), :0status }, + ($is-visible ?? 'shows' !! 'no') ~ " deprecation message with $args"; +} +sub is-deprecated (|c) { test-deprecation |c, :is-visible } +sub isn't-deprecated (|c) { test-deprecation |c } + +isn't-deprecated 'v6.c', v6.d, v6.e, :lang-vers; + +# XXX TODO: remove `.PREVIEW` part when 6.d comes out: +is-deprecated 'v6.d.PREVIEW', v6.d, v6.e, :lang-vers; + From 167f0f83c9bf0334cc870ac6902b04a5f31eec8e Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Wed, 27 Sep 2017 20:31:13 +0200 Subject: [PATCH 193/692] Revert "Minimally invasive streamline Proc::Async.new" This reverts commit bb0ebabc39ec0ffe8db04d6ef1b1dbff115ac1fe. --- src/core/Proc/Async.pm | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/core/Proc/Async.pm b/src/core/Proc/Async.pm index 77be2298301..22518c66829 100644 --- a/src/core/Proc/Async.pm +++ b/src/core/Proc/Async.pm @@ -118,7 +118,11 @@ my class Proc::Async { has $!encoder; has @!close-after-exit; - method new($path, *@args) { self.bless(:$path, :@args, |%_) } + proto method new(|) { * } + multi method new(*@args where .so) { + my $path = @args.shift; + self.bless(:$path, :@args, |%_) + } submethod TWEAK(--> Nil) { $!encoder := Encoding::Registry.find($!enc).encoder(:$!translate-nl); From 4c337e8ef9fa8a117761f5a74dc444a188471b71 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Wed, 27 Sep 2017 19:17:31 +0000 Subject: [PATCH 194/692] =?UTF-8?q?Deprecate=20dummy=20arg=20on=20.Rat/.Fa?= =?UTF-8?q?tRat=E2=80=A6?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit For Rat, FatRat, and Int types --- src/core/Int.pm | 14 ++++++--- src/core/Rat.pm | 32 ++++++++++++++++++--- t/02-rakudo/v6.d-tests/01-deprecations.t | 36 ++++++++++++++++++++++++ 3 files changed, 74 insertions(+), 8 deletions(-) create mode 100644 t/02-rakudo/v6.d-tests/01-deprecations.t diff --git a/src/core/Int.pm b/src/core/Int.pm index e08a093146f..efa76374732 100644 --- a/src/core/Int.pm +++ b/src/core/Int.pm @@ -48,11 +48,17 @@ my class Int does Real { # declared in BOOTSTRAP nqp::p6box_n(nqp::tonum_I(self)); } - method Rat(Int:D: $?) { - Rat.new(self, 1); + proto method Rat(|) {*} + multi method Rat(Int:D:) { Rat.new(self, 1) } + multi method Rat(Int:D: $) { + DEPRECATED :lang-vers, '.Rat coercer without an argument', '6.d', '6.e'; + self.Rat } - method FatRat(Int:D: $?) { - FatRat.new(self, 1); + proto method FatRat(|) {*} + multi method FatRat(Int:D:) { FatRat.new(self, 1) } + multi method FatRat(Int:D: $) { + DEPRECATED :lang-vers, '.FatRat coercer without an argument', '6.d', '6.e'; + self.FatRat } method abs(Int:D:) { diff --git a/src/core/Rat.pm b/src/core/Rat.pm index f96ff0c1c44..47eb60f975b 100644 --- a/src/core/Rat.pm +++ b/src/core/Rat.pm @@ -1,7 +1,19 @@ # XXX: should be Rational[Int, UInt64] my class Rat is Cool does Rational[Int, Int] { - method Rat (Rat:D: Real $?) { self } - method FatRat(Rat:D: Real $?) { FatRat.new($!numerator, $!denominator); } + proto method Rat(|) {*} + multi method Rat(Rat:D: ) { self } + multi method Rat(Rat:D: Real) { + DEPRECATED :lang-vers, '.Rat coercer without an argument', '6.d', '6.e'; + self + } + + proto method FatRat(|) {*} + multi method FatRat(Rat:D:) { FatRat.new($!numerator, $!denominator); } + multi method FatRat(Rat:D: Real) { + DEPRECATED :lang-vers, '.FatRat coercer without an argument', '6.d', '6.e'; + self.FatRat + } + multi method perl(Rat:D:) { if $!denominator == 1 { $!numerator ~ '.0' @@ -24,12 +36,24 @@ my class Rat is Cool does Rational[Int, Int] { } my class FatRat is Cool does Rational[Int, Int] { - method FatRat(FatRat:D: Real $?) { self } - method Rat (FatRat:D: Real $?) { + proto method FatRat(|) {*} + multi method FatRat(FatRat:D:) { self } + multi method FatRat(FatRat:D: Real) { + DEPRECATED :lang-vers, '.FatRat coercer without an argument', '6.d', '6.e'; + self + } + + proto method Rat(|) {*} + multi method Rat(FatRat:D:) { $!denominator < $UINT64_UPPER ?? Rat.new($!numerator, $!denominator) !! Failure.new("Cannot convert from FatRat to Rat because denominator is too big") } + multi method Rat (FatRat:D: Real) { + DEPRECATED :lang-vers, '.Rat coercer without an argument', '6.d', '6.e'; + self.Rat + } + multi method perl(FatRat:D:) { "FatRat.new($!numerator, $!denominator)"; } diff --git a/t/02-rakudo/v6.d-tests/01-deprecations.t b/t/02-rakudo/v6.d-tests/01-deprecations.t new file mode 100644 index 00000000000..28117a8ace8 --- /dev/null +++ b/t/02-rakudo/v6.d-tests/01-deprecations.t @@ -0,0 +1,36 @@ +use lib ; +use Test; +use Test::Util; + +plan 8; + +# XXX TODO: swap v6.d.PREVIEW to v6.d, once the latter is available +constant $v6d = 'v6.d.PREVIEW'; + +################### HELPER ROUTINES ################################### + +sub test-deprecation ( + Str:D $lang, Str:D $code, Str:D $desc = "with `$code`", + Bool :$is-visible +) { + is_run ' + use \qq[$lang]; + %*ENV:delete; + \qq[$code] + ', { :out(''), :err($is-visible ?? /deprecated/ !! ''), :0status }, + ($is-visible ?? 'shows' !! 'no ') + ~ " deprecation message $desc [using $lang]"; +} +sub is-deprecated (|c) { test-deprecation |c, :is-visible } +sub isn't-deprecated (|c) { test-deprecation |c } +sub is-newly-deprecated (|c) { + is-deprecated $v6d, |c; + isn't-deprecated 'v6.c', |c; +} + +###################################################################### + +is-newly-deprecated 「$ = 4.2.Rat: 42」; +is-newly-deprecated 「$ = 4.2.FatRat: 42」; +is-newly-deprecated 「$ = FatRat.new(4,2).Rat: 42」; +is-newly-deprecated 「$ = FatRat.new(4,2).FatRat: 42」; From 63cf246fd4caa43c52a212054a98e9b450c54127 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Wed, 27 Sep 2017 23:57:42 +0200 Subject: [PATCH 195/692] Stage 2 of auto-generated BUILDALL methods - the _UNDER_CONSTRUCTION postfix is removed - they've become multi's - it *should* be possible to remove the Mu.BUILDALL candidate but it breaks the core setting build - and somehow the Mu.BUILDALL shadows all auto-generated BUILDALLs - so no speed improvement yet :-( --- src/Perl6/Metamodel/ClassHOW.nqp | 7 +++- src/Perl6/World.nqp | 63 +++++++++++++++++++++----------- src/core/Mu.pm | 15 +------- 3 files changed, 49 insertions(+), 36 deletions(-) diff --git a/src/Perl6/Metamodel/ClassHOW.nqp b/src/Perl6/Metamodel/ClassHOW.nqp index f6e2dea34ba..4f6ca03dd46 100644 --- a/src/Perl6/Metamodel/ClassHOW.nqp +++ b/src/Perl6/Metamodel/ClassHOW.nqp @@ -160,9 +160,9 @@ class Perl6::Metamodel::ClassHOW nqp::say('Could not generate a BUILDALL for ' ~ $obj.HOW.name($obj)); } else { - $method.set_name('BUILDALL_UNDER_CONSTRUCTION'); + $method.set_name('BUILDALL'); my $result := try { - self.add_method($obj,'BUILDALL_UNDER_CONSTRUCTION',$method) + self.add_multi_method($obj,'BUILDALL',$method) } unless $result { nqp::say($obj.HOW.name($obj) ~ ' failed to add a BUILDALL'); @@ -170,6 +170,9 @@ class Perl6::Metamodel::ClassHOW } } + # Incorporate any new multi candidates (needs MRO built). + self.incorporate_multi_candidates($obj); + # Compose the representation self.compose_repr($obj); } diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index 93653c07c60..438e27fcdb7 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -3027,8 +3027,9 @@ class Perl6::World is HLL::World { ); # signature configuration hash for ":(%init)" - my %sig_init := - nqp::hash('parameters', [nqp::hash('variable_name','%init')]); + my %sig_init := nqp::hash('parameters', [ + nqp::hash('variable_name','%init','is_multi_invocant',1) + ]); # Generate a method for building a new object that takes a hash # with attribute => value pairs to be assigned to the object's @@ -3063,20 +3064,24 @@ class Perl6::World is HLL::World { # The block of the method my $block := QAST::Block.new( - :name, :blocktype, + :name, :blocktype, $declarations ); # Register the block in its SC $!w.cur_lexpad()[0].push($block); -# :(Foo:D: %init) - my $sig := $!w.create_signature_and_params( - NQPMu, %sig_init, $block, 'Any', :method, - invocant_type => $!w.create_definite_type( - $!w.find_symbol(['Metamodel','DefiniteHOW']), - $object, - 1 + my $invocant_type := $!w.create_definite_type( + $!w.find_symbol(['Metamodel','DefiniteHOW']), + $object, + 1 + ); + + $stmts.push( + QAST::Op.new( :op, + QAST::SVal.new( :value( + $object.HOW.name($object) ~ '.BUILDALL called' + )) ) ); @@ -3152,6 +3157,12 @@ class Perl6::World is HLL::World { QAST::SVal.new( :value(nqp::atpos($task,2)) ) ); + # set assign operation to be used + my $sigil := + nqp::substr(nqp::atpos($task,2),0,1); + my $op := $sigil eq '$' || $sigil eq '&' + ?? 'assign' + !! 'p6store'; # nqp::unless( # nqp::attrinited(self,Foo,'$!a'), # (nqp::getattr(self,Foo,'$!a') = @@ -3166,7 +3177,7 @@ class Perl6::World is HLL::World { :value(nqp::atpos($task,2)) ) ), - QAST::Op.new( :op, + QAST::Op.new( :$op, $getattrop, QAST::Op.new( :op, QAST::WVal.new( @@ -3356,8 +3367,12 @@ class Perl6::World is HLL::World { QAST::SVal.new( :value( nqp::atpos($task,2) ) ) ); -#$execution.push(QAST::Op.new( :op('say'), QAST::SVal.new( :value("Initializing for 0: " ~ nqp::atpos($task,2) ~ ' - ' ~ nqp::atpos($task,3)) ))); - + # set assign operation to be used + my $sigil := + nqp::substr(nqp::atpos($task,2),0,1); + my $op := $sigil eq '$' || $sigil eq '&' + ?? 'assign' + !! 'p6store'; # nqp::if( # nqp::existskey($init,'a'), # nqp::getattr(self,Foo,'$!a') = %init.AT-KEY('a') @@ -3365,7 +3380,7 @@ class Perl6::World is HLL::World { $stmts.push( QAST::Op.new( :op, $existskeyop, - QAST::Op.new( :op, + QAST::Op.new( :$op, $getattrop, QAST::Op.new( :op, QAST::Var.new(:scope,:name('%init')), @@ -3461,6 +3476,11 @@ class Perl6::World is HLL::World { # Add the statements to the block $block.push($stmts); +# :(Foo:D: %init) + my $sig := $!w.create_signature_and_params( + NQPMu, %sig_init, $block, 'Any', :method, :$invocant_type + ); + # Create the code object and return it $!w.create_code_object($block, 'Submethod', $sig) } @@ -3475,7 +3495,7 @@ class Perl6::World is HLL::World { # submethod :: (Any:D:) { self } my $block := QAST::Block.new( - :name, :blocktype, + :name, :blocktype, QAST::Stmts.new( QAST::Var.new(:decl, :scope, :name), QAST::Var.new(:decl, :scope, :name('%init')), @@ -3486,13 +3506,14 @@ class Perl6::World is HLL::World { # Register the block in its SC $!w.cur_lexpad()[0].push($block); + my $invocant_type := $!w.create_definite_type( + $!w.find_symbol(['Metamodel','DefiniteHOW']), + $!w.find_symbol(['Any']), + 1 + ); + my $sig := $!w.create_signature_and_params( - NQPMu, %sig_init, $block, 'Any', :method, - invocant_type => $!w.create_definite_type( - $!w.find_symbol(['Metamodel','DefiniteHOW']), - $!w.find_symbol(['Any']), - 1 - ) + NQPMu, %sig_init, $block, 'Any', :method, :$invocant_type ); # Create the code object, save and return it diff --git a/src/core/Mu.pm b/src/core/Mu.pm index 9432834b10f..0d8b362146c 100644 --- a/src/core/Mu.pm +++ b/src/core/Mu.pm @@ -108,17 +108,6 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" nqp::p6bool(nqp::isconcrete(self)) } - method new_UNDER_CONSTRUCTION(*%init) { - nqp::if( - nqp::eqaddr( - (my $bless := nqp::findmethod(self,'bless')), - nqp::findmethod(Mu,'bless') - ), - nqp::create(self).BUILDALL_UNDER_CONSTRUCTION(%init), - nqp::invokewithcapture($bless,nqp::usecapture) - ) - } - proto method new(|) { * } multi method new(*%attrinit) { nqp::if( @@ -149,11 +138,11 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" # This candidate provided for those modules that rely on the old # BUILDALL interface, such as Inline::Perl5 - multi method BUILDALL(@positional,%attrinit) { + multi method BUILDALL(Mu:D: @positional,%attrinit) { self.BUILDALL(%attrinit) } - multi method BUILDALL(%attrinit) { + multi method BUILDALL(Mu:D: %attrinit) { my $init := nqp::getattr(%attrinit,Map,'$!storage'); # Get the build plan. Note that we do this "low level" to # avoid the NQP type getting mapped to a Rakudo one, which From 6d2adb20f2529e36e32b50936281ef3f11f078b0 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Wed, 27 Sep 2017 19:34:27 -0400 Subject: [PATCH 196/692] [6.d] Deprecate IO::Path.chdir --- src/core/IO/Path.pm | 41 ++---------------------- src/core/io_operators.pm | 32 ++++++++++++++++-- t/02-rakudo/v6.d-tests/01-deprecations.t | 3 +- 3 files changed, 35 insertions(+), 41 deletions(-) diff --git a/src/core/IO/Path.pm b/src/core/IO/Path.pm index c1baace2df2..8148dcae940 100644 --- a/src/core/IO/Path.pm +++ b/src/core/IO/Path.pm @@ -411,44 +411,9 @@ my class IO::Path is Cool does IO { multi method chdir( IO::Path:D: Str() $path is copy, :$d = True, :$r, :$w, :$x, ) { - unless $!SPEC.is-absolute($path) { - my ($volume,$dirs) = $!SPEC.splitpath(self.absolute, :nofile); - my @dirs = $!SPEC.splitdir($dirs); - @dirs.shift; # the first is always empty for absolute dirs - for $!SPEC.splitdir($path) -> $dir { - if $dir eq '..' { - @dirs.pop if @dirs; - } - elsif $dir ne '.' { - @dirs.push: $dir; - } - } - @dirs.push('') if !@dirs; # need at least the rootdir - $path = join($!SPEC.dir-sep, $volume, @dirs); - } - my $dir = IO::Path!new-from-absolute-path($path,:$!SPEC,:CWD(self)); - - nqp::stmts( - nqp::unless( - nqp::unless(nqp::isfalse($d), $dir.d), - fail X::IO::Chdir.new: :$path, :os-error( - nqp::if($dir.e, 'is not a directory', 'does not exist') - ) - ), - nqp::unless( - nqp::unless(nqp::isfalse($r), $dir.r), - fail X::IO::Chdir.new: :$path, :os-error("did not pass :r test") - ), - nqp::unless( - nqp::unless(nqp::isfalse($w), $dir.w), - fail X::IO::Chdir.new: :$path, :os-error("did not pass :w test") - ), - nqp::unless( - nqp::unless(nqp::isfalse($x), $dir.x), - fail X::IO::Chdir.new: :$path, :os-error("did not pass :x test") - ), - $dir - ) + DEPRECATED 'subroutine chdir()', '6.d', '6.e', :lang-vers; + temp $*CWD = self; + chdir $path } method rename(IO::Path:D: IO() $to, :$createonly --> True) { diff --git a/src/core/io_operators.pm b/src/core/io_operators.pm index e1669f75d9d..3817816c007 100644 --- a/src/core/io_operators.pm +++ b/src/core/io_operators.pm @@ -130,8 +130,36 @@ multi sub spurt(IO() $path, |c) { $path.spurt(|c) } PROCESS::<&chdir> := &chdir; } -sub chdir(|c) { - nqp::if(nqp::istype(($_ := $*CWD.chdir(|c)), Failure), $_, $*CWD = $_) +sub chdir(Str() $path is copy, :$d = True, :$r, :$w, :$x) { + my $CWD := $*CWD; + my $SPEC := $CWD.SPEC; + my $new-path := $path; + + unless $SPEC.is-absolute($path) { + my ($volume,$dirs) = $SPEC.splitpath: $CWD.absolute, :nofile; + my @dirs = $SPEC.splitdir: $dirs; + @dirs.shift; # the first is always empty for absolute dirs + for $SPEC.splitdir($path) -> $dir { + if $dir eq '..' { @dirs.pop if @dirs } + elsif $dir ne '.' { @dirs.push: $dir } + } + @dirs.push: '' if !@dirs; # need at least the rootdir + $path := join $SPEC.dir-sep, $volume, @dirs; + } + + my $dir := IO::Path.new: $path, :$SPEC, :$CWD; + + fail X::IO::Chdir.new: :$path, :os-error( + $dir.e ?? 'is not a directory' !! 'does not exist' + ) if $d and nqp::isfalse($dir.d); + fail X::IO::Chdir.new: :$path, :os-error("did not pass :r test") + if $r and nqp::isfalse($dir.r); + fail X::IO::Chdir.new: :$path, :os-error("did not pass :w test") + if $w and nqp::isfalse($dir.w); + fail X::IO::Chdir.new: :$path, :os-error("did not pass :x test") + if $x and nqp::isfalse($dir.x); + + $*CWD = $dir } proto sub indir(|) {*} diff --git a/t/02-rakudo/v6.d-tests/01-deprecations.t b/t/02-rakudo/v6.d-tests/01-deprecations.t index 28117a8ace8..01fa3d1974c 100644 --- a/t/02-rakudo/v6.d-tests/01-deprecations.t +++ b/t/02-rakudo/v6.d-tests/01-deprecations.t @@ -2,7 +2,7 @@ use lib ; use Test; use Test::Util; -plan 8; +plan 10; # XXX TODO: swap v6.d.PREVIEW to v6.d, once the latter is available constant $v6d = 'v6.d.PREVIEW'; @@ -34,3 +34,4 @@ is-newly-deprecated 「$ = 4.2.Rat: 42」; is-newly-deprecated 「$ = 4.2.FatRat: 42」; is-newly-deprecated 「$ = FatRat.new(4,2).Rat: 42」; is-newly-deprecated 「$ = FatRat.new(4,2).FatRat: 42」; +is-newly-deprecated 「".".IO.chdir: "."」; From 3341384bfe1341200a75ddc7ec869812cd58aeed Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Wed, 27 Sep 2017 20:58:20 -0400 Subject: [PATCH 197/692] [6.d] Deprecate IO::Handle.slurp-rest --- src/core/IO/Handle.pm | 10 ++++------ t/02-rakudo/v6.d-tests/01-deprecations.t | 9 ++++++++- 2 files changed, 12 insertions(+), 7 deletions(-) diff --git a/src/core/IO/Handle.pm b/src/core/IO/Handle.pm index debb60e8351..40bffae7958 100644 --- a/src/core/IO/Handle.pm +++ b/src/core/IO/Handle.pm @@ -674,9 +674,8 @@ my class IO::Handle { proto method slurp-rest(|) { * } multi method slurp-rest(IO::Handle:D: :$bin! where *.so, :$close --> Buf:D) { - # NOTE: THIS METHOD WILL BE DEPRECATED IN 6.d in favour of .slurp() - # Testing of it in roast master has been removed and only kept in 6.c - # If you're changing this code for whatever reason, test with 6.c-errata + DEPRECATED '.slurp', '6.d', '6.e', :lang-vers; + LEAVE self.close if $close; my $res := buf8.new; loop { @@ -687,9 +686,8 @@ my class IO::Handle { } } multi method slurp-rest(IO::Handle:D: :$enc, :$bin, :$close --> Str:D) { - # NOTE: THIS METHOD WILL BE DEPRECATED IN 6.d in favour of .slurp() - # Testing of it in roast master has been removed and only kept in 6.c - # If you're changing this code for whatever reason, test with 6.c-errata + DEPRECATED '.slurp', '6.d', '6.e', :lang-vers; + $!decoder or die X::IO::BinaryMode.new(:trying); LEAVE self.close if $close; self.encoding($enc) if $enc.defined; diff --git a/t/02-rakudo/v6.d-tests/01-deprecations.t b/t/02-rakudo/v6.d-tests/01-deprecations.t index 01fa3d1974c..b6075394b09 100644 --- a/t/02-rakudo/v6.d-tests/01-deprecations.t +++ b/t/02-rakudo/v6.d-tests/01-deprecations.t @@ -2,7 +2,7 @@ use lib ; use Test; use Test::Util; -plan 10; +plan 11; # XXX TODO: swap v6.d.PREVIEW to v6.d, once the latter is available constant $v6d = 'v6.d.PREVIEW'; @@ -35,3 +35,10 @@ is-newly-deprecated 「$ = 4.2.FatRat: 42」; is-newly-deprecated 「$ = FatRat.new(4,2).Rat: 42」; is-newly-deprecated 「$ = FatRat.new(4,2).FatRat: 42」; is-newly-deprecated 「".".IO.chdir: "."」; + +subtest 'IO::Handle.slurp-rest' => { + plan 4; + my $file := make-temp-file(:content).absolute.perl; + is-newly-deprecated "$file.IO.open.slurp-rest"; + is-newly-deprecated "$file.IO.open.slurp-rest: :bin"; +} From 39a4b75b59bf0c23522b163e5230837411d0c79b Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Wed, 27 Sep 2017 21:10:17 -0400 Subject: [PATCH 198/692] Restructure test routines So they're used as 1 routine = 1 added to plan. Easier to count. --- t/02-rakudo/v6.d-tests/01-deprecations.t | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/t/02-rakudo/v6.d-tests/01-deprecations.t b/t/02-rakudo/v6.d-tests/01-deprecations.t index b6075394b09..dfdb8315ac5 100644 --- a/t/02-rakudo/v6.d-tests/01-deprecations.t +++ b/t/02-rakudo/v6.d-tests/01-deprecations.t @@ -2,30 +2,30 @@ use lib ; use Test; use Test::Util; -plan 11; +plan 6; # XXX TODO: swap v6.d.PREVIEW to v6.d, once the latter is available constant $v6d = 'v6.d.PREVIEW'; ################### HELPER ROUTINES ################################### -sub test-deprecation ( - Str:D $lang, Str:D $code, Str:D $desc = "with `$code`", - Bool :$is-visible -) { +sub test-deprecation (Str:D $lang, Str:D $code, Bool :$is-visible) { is_run ' use \qq[$lang]; %*ENV:delete; \qq[$code] ', { :out(''), :err($is-visible ?? /deprecated/ !! ''), :0status }, ($is-visible ?? 'shows' !! 'no ') - ~ " deprecation message $desc [using $lang]"; + ~ " deprecation message using $lang"; } sub is-deprecated (|c) { test-deprecation |c, :is-visible } sub isn't-deprecated (|c) { test-deprecation |c } -sub is-newly-deprecated (|c) { - is-deprecated $v6d, |c; - isn't-deprecated 'v6.c', |c; +sub is-newly-deprecated (Str:D $code, Str:D $desc = "with `$code`") { + subtest $desc => { + plan 2; + test-deprecation $v6d, $code, :is-visible; + test-deprecation 'v6.c', $code; + } } ###################################################################### @@ -37,8 +37,8 @@ is-newly-deprecated 「$ = FatRat.new(4,2).FatRat: 42」; is-newly-deprecated 「".".IO.chdir: "."」; subtest 'IO::Handle.slurp-rest' => { - plan 4; + plan 2; my $file := make-temp-file(:content).absolute.perl; - is-newly-deprecated "$file.IO.open.slurp-rest"; - is-newly-deprecated "$file.IO.open.slurp-rest: :bin"; + is-newly-deprecated "$file.IO.open.slurp-rest", '.slurp-rest'; + is-newly-deprecated "$file.IO.open.slurp-rest: :bin", '.slurp-rest: :bin'; } From 5ad2fffed9ac01272d4aeeecb056bc10720d9a4e Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Thu, 28 Sep 2017 10:44:25 +0200 Subject: [PATCH 199/692] Stage 3 of auto-generated BUILDALL - Mu.BUILDALL has become an only again, taking a useless array as first param - Mu.new/bless have been adapted to this - auto-generated BUILDALL now also an only, taking the array also - however is not installed yet, as that breaks building the setting This should make test-t faster again and spectest clean. --- src/Perl6/Metamodel/ClassHOW.nqp | 15 ++++++++------- src/Perl6/World.nqp | 11 ++++++++++- src/core/Mu.pm | 14 +++----------- 3 files changed, 21 insertions(+), 19 deletions(-) diff --git a/src/Perl6/Metamodel/ClassHOW.nqp b/src/Perl6/Metamodel/ClassHOW.nqp index 4f6ca03dd46..bbb351053f6 100644 --- a/src/Perl6/Metamodel/ClassHOW.nqp +++ b/src/Perl6/Metamodel/ClassHOW.nqp @@ -152,7 +152,8 @@ class Perl6::Metamodel::ClassHOW # Create BUILDALL method if we can (if we can't, the one from # Mu will be used, which will iterate over the BUILDALLPLAN at # runtime). - if nqp::isconcrete($compiler_services) { + if nqp::isconcrete($compiler_services) + && $obj.HOW.name($obj) ne 'Mu' { my $builder := nqp::findmethod( $compiler_services,'generate_buildplan_executor'); my $method := $builder($compiler_services,$obj,$BUILDALLPLAN); @@ -161,12 +162,12 @@ class Perl6::Metamodel::ClassHOW } else { $method.set_name('BUILDALL'); - my $result := try { - self.add_multi_method($obj,'BUILDALL',$method) - } - unless $result { - nqp::say($obj.HOW.name($obj) ~ ' failed to add a BUILDALL'); - } +# my $result := try { +# self.add_method($obj,'BUILDALL',$method) +# } +# unless $result { +# nqp::say($obj.HOW.name($obj) ~ ' failed to add a BUILDALL'); +# } } } diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index 438e27fcdb7..a6afbb73950 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -3028,7 +3028,7 @@ class Perl6::World is HLL::World { # signature configuration hash for ":(%init)" my %sig_init := nqp::hash('parameters', [ - nqp::hash('variable_name','%init','is_multi_invocant',1) + nqp::hash('variable_name','%init') ]); # Generate a method for building a new object that takes a hash @@ -3058,6 +3058,7 @@ class Perl6::World is HLL::World { my $declarations := QAST::Stmts.new( QAST::Var.new(:decl, :scope, :name), + QAST::Var.new(:decl, :scope, :name('@auto')), QAST::Var.new(:decl, :scope, :name('%init')), QAST::Var.new(:decl, :scope, :name) ); @@ -3082,6 +3083,14 @@ class Perl6::World is HLL::World { QAST::SVal.new( :value( $object.HOW.name($object) ~ '.BUILDALL called' )) + ), + ); + $stmts.push( + QAST::Op.new( :op, + QAST::Op.new( :op, + QAST::Var.new( :scope, :name('%init') ), + QAST::SVal.new( :value ) + ) ) ); diff --git a/src/core/Mu.pm b/src/core/Mu.pm index 0d8b362146c..fe36179e9e0 100644 --- a/src/core/Mu.pm +++ b/src/core/Mu.pm @@ -115,7 +115,7 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" (my $bless := nqp::findmethod(self,'bless')), nqp::findmethod(Mu,'bless') ), - nqp::create(self).BUILDALL(%attrinit), + nqp::create(self).BUILDALL(Empty, %attrinit), nqp::invokewithcapture($bless,nqp::usecapture) ) } @@ -131,18 +131,10 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" } method bless(*%attrinit) { - nqp::create(self).BUILDALL(%attrinit); + nqp::create(self).BUILDALL(Empty, %attrinit); } - proto method BUILDALL(|) { * } - - # This candidate provided for those modules that rely on the old - # BUILDALL interface, such as Inline::Perl5 - multi method BUILDALL(Mu:D: @positional,%attrinit) { - self.BUILDALL(%attrinit) - } - - multi method BUILDALL(Mu:D: %attrinit) { + method BUILDALL(Mu:D: @autovivs, %attrinit) { my $init := nqp::getattr(%attrinit,Map,'$!storage'); # Get the build plan. Note that we do this "low level" to # avoid the NQP type getting mapped to a Rakudo one, which From 43c348a8e7006978057fad2e360a700d263fcbd8 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Thu, 28 Sep 2017 05:41:48 -0400 Subject: [PATCH 200/692] =?UTF-8?q?Undo=20unintended=20aliasing=20of=20?= =?UTF-8?q?=E2=89=A4,=20=E2=89=A5,=20=E2=89=A0=20ops?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit With userland-defined Texas versions. --- src/Perl6/Optimizer.nqp | 19 ++++++++++++++++--- 1 file changed, 16 insertions(+), 3 deletions(-) diff --git a/src/Perl6/Optimizer.nqp b/src/Perl6/Optimizer.nqp index 371ad380945..594e51e4fb8 100644 --- a/src/Perl6/Optimizer.nqp +++ b/src/Perl6/Optimizer.nqp @@ -1377,11 +1377,24 @@ class Perl6::Optimizer { } method convert_mexico_op_to_texas($op) { + sub should-texify ($from, $to) { + try { + $!symbols.find_lexical($to); + $!symbols.is_from_core($to) && 1; + } ?? 1 !! 0; + } + if $!symbols.is_from_core: $op.name { my $name := $op.name; - if ($name eq '&infix:<≤>') { $op.name: '&infix:«<=»' } - elsif ($name eq '&infix:<≥>') { $op.name: '&infix:«>=»' } - elsif ($name eq '&infix:<≠>') { $op.name: '&infix:' } + if ($name eq '&infix:<≤>' + && should-texify('&infix:<≤>', '&infix:«<=»')) { + $op.name: '&infix:«<=»' } + elsif ($name eq '&infix:<≥>' + && should-texify('&infix:<≥>', '&infix:«>=»')) { + $op.name: '&infix:«>=»' } + elsif ($name eq '&infix:<≠>' + && should-texify('&infix:<≠>', '&infix:')) { + $op.name: '&infix:' } } } From 31a03a41f0e3a609a9248a92c19a41c7d69a85f7 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Thu, 28 Sep 2017 12:46:45 +0200 Subject: [PATCH 201/692] Fix chicken/egg problem with Lock::Async::Holder Trying to call .new at compile time on a class that refers to an outer class that has not been composed yet, explodes at least during setting compilation (without much useful feedback). Since the .new was without parameters, a simple nqp::create is enough. This allows setting compilation to complete with auto-generated BUILDALL installed. But "make install" still fails :-( --- src/core/Lock/Async.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/Lock/Async.pm b/src/core/Lock/Async.pm index 5d01524dfb8..681a9cb949a 100644 --- a/src/core/Lock/Async.pm +++ b/src/core/Lock/Async.pm @@ -49,7 +49,7 @@ my class Lock::Async { # Base states for Holder my constant NO_HOLDER = Holder; - my constant SINGLE_HOLDER = Holder.new; + my constant SINGLE_HOLDER = nqp::create(Holder); # The current holder record, with waiters queue, of the lock. has Holder $!holder = Holder; From b7f8daf0014a2e394f7ae4c400830c245501800a Mon Sep 17 00:00:00 2001 From: gerd Date: Thu, 28 Sep 2017 15:03:46 +0200 Subject: [PATCH 202/692] add documentation to use the script --- tools/install-dist.pl | 33 +++++++++++++++++++++++++++++++++ 1 file changed, 33 insertions(+) diff --git a/tools/install-dist.pl b/tools/install-dist.pl index 1c9123d1de6..fa39d9293c7 100644 --- a/tools/install-dist.pl +++ b/tools/install-dist.pl @@ -1,4 +1,37 @@ #!/usr/bin/env perl6 + + +=begin pod + +This script is for installing Perl6 modules. B does the same module registration like the 'zef' tool. + +B makes it easy to install a module system wide. + +=head1 OPTIONS + +By default the destination is the site of the Perl 6 library. + + # Install to a custom location + --to= # /home/username/my_perl6_mod_dir + +If you specify a destination that does not exists then it will be created. The --to option can only be used together with the --for option. + + --for=[ vendor | site ] + + --from= # default is the current directory + + +The command in the install session for packaging a Perl 6 module could be done in the form: + + install-dist.pl --to= --for=vendor + +It is recommended to set the environment variable 'RAKUDO_RERESOLVE_DEPENDENCIES' by using the script: + + RAKUDO_RERESOLVE_DEPENDENCIES=0 install-dist.pl --to= --for=site + +=end pod + + use v6.c; use CompUnit::Repository::Staging; From 1d9553f01f5c5a0e04491e24f8efacd175b78c50 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Thu, 28 Sep 2017 13:52:28 +0000 Subject: [PATCH 203/692] Make &inifx: with Version:Ds 7.2x faster Now that we use DEPRECATED sub in more places due to 6.d changes, this op becomes more used, so we needed a perf boost. Makes `v6.c cmp v6.d` 8.8x faster --- src/core/Version.pm | 68 ++++++++++++++++++++++++--------------------- 1 file changed, 37 insertions(+), 31 deletions(-) diff --git a/src/core/Version.pm b/src/core/Version.pm index 160fc21f487..0895311385c 100644 --- a/src/core/Version.pm +++ b/src/core/Version.pm @@ -134,37 +134,43 @@ multi sub infix:(Version:D \a, Version:D \b) { } multi sub infix:(Version:D \a, Version:D \b) { - proto vnumcmp(|) { * } - multi vnumcmp(Str, Int) { Order::Less } - multi vnumcmp(Int, Str) { Order::More } - multi vnumcmp($av, $bv) { $av cmp $bv } - - # we're us - if a =:= b { - Same - } - - # need to check - else { - my \ia := nqp::iterator(nqp::getattr(nqp::decont(a),Version,'$!parts')); - my \ib := nqp::iterator(nqp::getattr(nqp::decont(b),Version,'$!parts')); - - # check from left - while ia { - if vnumcmp(nqp::shift(ia), ib ?? nqp::shift(ib) !! 0) -> $cmp { - return $cmp; - } - } - - # check from right - while ib { - if vnumcmp(0, nqp::shift(ib)) -> $cmp { - return $cmp; - } - } - - a.plus cmp b.plus - } + nqp::if( + nqp::eqaddr(nqp::decont(a),nqp::decont(b)), # we're us + Same, + nqp::stmts( + (my \ia := nqp::iterator(nqp::getattr(nqp::decont(a),Version,'$!parts'))), + (my \ib := nqp::iterator(nqp::getattr(nqp::decont(b),Version,'$!parts'))), + (my ($ret, $a-part, $b-part)), + nqp::while( + ia, # check from left + nqp::stmts( + ($a-part := nqp::shift(ia)), + ($b-part := ib ?? nqp::shift(ib) !! 0), + nqp::if( + ($ret := nqp::if( + nqp::istype($a-part,Str) && nqp::istype($b-part,Int), + Less, + nqp::if( + nqp::istype($a-part,Int) && nqp::istype($b-part,Str), + More, + ($a-part cmp $b-part)))), + return $ret))), + nqp::while( + ib, # check from right + nqp::stmts( + ($a-part := 0), + ($b-part := nqp::shift(ib)), + nqp::if( + ($ret := nqp::if( + nqp::istype($a-part,Str) && nqp::istype($b-part,Int), + Less, + nqp::if( + nqp::istype($a-part,Int) && nqp::istype($b-part,Str), + More, + ($a-part cmp $b-part)))), + return $ret))), + ( nqp::getattr_i(nqp::decont(a),Version,'$!plus') + cmp nqp::getattr_i(nqp::decont(b),Version,'$!plus')))) } multi sub infix:«<=>»(Version:D \a, Version:D \b) { a cmp b } From eb9c3d4dd7791ad1b483adb857d1062993455dec Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Thu, 28 Sep 2017 16:19:26 +0200 Subject: [PATCH 204/692] Add $/ to CompilerServices --- src/Perl6/World.nqp | 19 ++++++++++++++----- src/core/Rakudo/Internals.pm | 7 +++++-- 2 files changed, 19 insertions(+), 7 deletions(-) diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index a6afbb73950..66ce3727c9c 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -2950,7 +2950,7 @@ class Perl6::World is HLL::World { # Composes the package, and stores an event for this action. method pkg_compose($/, $obj) { - my $compiler_services := self.get_compiler_services(); + my $compiler_services := self.get_compiler_services($/); if nqp::isconcrete($compiler_services) { self.ex-handle($/, { $obj.HOW.compose($obj, :$compiler_services) }) } @@ -2971,7 +2971,7 @@ class Perl6::World is HLL::World { # The generic BUILDALL method for empty BUILDPLANs has $!empty_buildplan_method; - method generate_accessor(str $meth_name, $package_type, str $attr_name, $type, int $rw) { + method generate_accessor($/, str $meth_name, $package_type, str $attr_name, $type, int $rw) { my $native := nqp::objprimspec($type) != 0; my $acc := QAST::Var.new( :scope($native && $rw ?? 'attributeref' !! 'attribute'), @@ -3036,7 +3036,7 @@ class Perl6::World is HLL::World { # attributes. Basically a flattened version of Mu.BUILDALL, which # iterates over the BUILDALLPLAN at runtime with fewer inlining # and JITting opportunities. - method generate_buildplan_executor($in_object, $in_build_plan) { + method generate_buildplan_executor($/, $in_object, $in_build_plan) { # deconted / low level hash access my $object := nqp::decont($in_object); @@ -3532,13 +3532,22 @@ class Perl6::World is HLL::World { } } - method get_compiler_services() { - unless nqp::isconcrete($!compiler_services) { + method get_compiler_services($/) { + if nqp::isconcrete($!compiler_services) { + nqp::bindattr( + $!compiler_services, + $!compiler_services.WHAT, + '$!current-match', + $/ + ); + } + else { try { my $wtype := self.find_symbol(['Rakudo', 'Internals', 'CompilerServices']); my $wrapped := CompilerServices.new(w => self); my $wrapper := nqp::create($wtype); nqp::bindattr($wrapper, $wtype, '$!compiler', $wrapped); + nqp::bindattr($wrapper, $wtype, '$!current-match', $/); $!compiler_services := $wrapper; } } diff --git a/src/core/Rakudo/Internals.pm b/src/core/Rakudo/Internals.pm index 4939277691c..dac0c86e844 100644 --- a/src/core/Rakudo/Internals.pm +++ b/src/core/Rakudo/Internals.pm @@ -1252,12 +1252,15 @@ my class Rakudo::Internals { our class CompilerServices { has Mu $!compiler; + has Mu $!current-match; method generate_accessor(str $name, Mu \package_type, str $attr_name, Mu \type, int $rw) { - $!compiler.generate_accessor($name, package_type, $attr_name, type, $rw); + $!compiler.generate_accessor( + $!current-match, $name, package_type, $attr_name, type, $rw); } method generate_buildplan_executor(Mu \obj, Mu \buildplan) { - $!compiler.generate_buildplan_executor(obj, buildplan) + $!compiler.generate_buildplan_executor( + $!current-match, obj, buildplan) } } From 145e3156ca4377845db9677f7877223b82d10ae9 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Thu, 28 Sep 2017 14:26:21 +0000 Subject: [PATCH 205/692] Make &DEPRECATED 27% faster when vfrom is too large - This is the case for 6.d deprecations used in 6.c language - The speedup measure does not include Version cmp boost[^1] [1] https://github.com/rakudo/rakudo/commit/1d9553f01f --- src/core/Deprecations.pm | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/src/core/Deprecations.pm b/src/core/Deprecations.pm index 552251a1c72..c724a16ba54 100644 --- a/src/core/Deprecations.pm +++ b/src/core/Deprecations.pm @@ -53,18 +53,16 @@ class Deprecation { sub DEPRECATED($alternative,$from?,$removed?,:$up = 1,:$what,:$file,:$line,Bool :$lang-vers) { state $ver = $*PERL.compiler.version; - my $version = $lang-vers ?? $*PERL.version !! $ver; + my $version = $lang-vers ?? nqp::getcomp('perl6').language_version !! $ver; # if $lang-vers was given, treat the provided versions as language # versions, rather than compiler versions. Note that we can't - # `state` the `$*PERL.version` (I think) because different CompUnits + # `state` the lang version (I think) because different CompUnits # might be using different versions. my Version $vfrom; my Version $vremoved; - if $from { - $vfrom = Version.new($from); - return if $version before $vfrom; # not deprecated yet - } + $from && nqp::iseq_i($version cmp ($vfrom = Version.new: $from), -1) + && return; # not deprecated yet; $vremoved = Version.new($removed) if $removed; my $bt = Backtrace.new; From 346dfeff3e2f4b7e546a05043ccbc19fdb1aa8a9 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Thu, 28 Sep 2017 16:44:25 +0200 Subject: [PATCH 206/692] Make auto-generated accessors know what they are Turns out :node($/) does need to be added to the first QAST:Stmts. This became clear after git stashing all of the other stuff I was working on. --- src/Perl6/World.nqp | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index 66ce3727c9c..80b9740c2a1 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -2988,6 +2988,7 @@ class Perl6::World is HLL::World { my $block := QAST::Block.new( :name($meth_name), :blocktype('declaration_static'), QAST::Stmts.new( + :node($/), QAST::Var.new( :decl('param'), :scope('local'), :name('self') ), From a89add0bf8bd9e8b164b48f24908f4603d4c0b87 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Thu, 28 Sep 2017 15:15:59 +0000 Subject: [PATCH 207/692] Remove term "mexico ops" from source It's not a good name for Unicode alternatives to Texas ops for reasons. Fixes RT#132179: https://rt.perl.org/Ticket/Display.html?id=132179 --- src/Perl6/Optimizer.nqp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Perl6/Optimizer.nqp b/src/Perl6/Optimizer.nqp index 594e51e4fb8..0954dfc2c19 100644 --- a/src/Perl6/Optimizer.nqp +++ b/src/Perl6/Optimizer.nqp @@ -1376,7 +1376,7 @@ class Perl6::Optimizer { } } - method convert_mexico_op_to_texas($op) { + method convert_unicode_op_to_texas($op) { sub should-texify ($from, $to) { try { $!symbols.find_lexical($to); @@ -1404,7 +1404,7 @@ class Perl6::Optimizer { my int $found := 0; note("method optimize_call $!void_context\n" ~ $op.dump) if $!debug; - self.convert_mexico_op_to_texas($op); + self.convert_unicode_op_to_texas($op); try { $obj := $!symbols.find_lexical($op.name); From 70ca505ad0df472c5d37146fb4646cd0c57a2f03 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Thu, 28 Sep 2017 17:58:42 +0200 Subject: [PATCH 208/692] Stage 5 of auto-generated BUILDALL - fallback to Mu.BUILDALL if the BUILDPLAN is empty although the methods were shared, there was no point as Mu.BUILDALL needs to exist anyway to handle object creation before Rakudo::Internals is parsed during setting compilation. - do not try to make/install a BUILDPLAN if there is one already - add :note($/) for better error reporting - seems to still have an issue when being precompiled therefore the BUILDALL is installed as BUILDALL_UNDER_CONSTRUCTION as to not interfere with anything out there just yet. --- src/Perl6/Metamodel/ClassHOW.nqp | 33 +- src/Perl6/World.nqp | 716 +++++++++++++++---------------- 2 files changed, 358 insertions(+), 391 deletions(-) diff --git a/src/Perl6/Metamodel/ClassHOW.nqp b/src/Perl6/Metamodel/ClassHOW.nqp index bbb351053f6..f186e31c86e 100644 --- a/src/Perl6/Metamodel/ClassHOW.nqp +++ b/src/Perl6/Metamodel/ClassHOW.nqp @@ -152,28 +152,27 @@ class Perl6::Metamodel::ClassHOW # Create BUILDALL method if we can (if we can't, the one from # Mu will be used, which will iterate over the BUILDALLPLAN at # runtime). - if nqp::isconcrete($compiler_services) - && $obj.HOW.name($obj) ne 'Mu' { - my $builder := nqp::findmethod( - $compiler_services,'generate_buildplan_executor'); - my $method := $builder($compiler_services,$obj,$BUILDALLPLAN); - if $method =:= NQPMu { - nqp::say('Could not generate a BUILDALL for ' ~ $obj.HOW.name($obj)); + if nqp::isconcrete($compiler_services) { + if nqp::existskey($obj.HOW.method_table($obj),'BUILDPLAN') { + nqp::say($obj.HOW.name($obj) ~ ' already has a BUILDALL'); } else { - $method.set_name('BUILDALL'); -# my $result := try { -# self.add_method($obj,'BUILDALL',$method) -# } -# unless $result { -# nqp::say($obj.HOW.name($obj) ~ ' failed to add a BUILDALL'); -# } + my $builder := nqp::findmethod( + $compiler_services,'generate_buildplan_executor'); + my $method := + $builder($compiler_services,$obj,$BUILDALLPLAN); + unless $method =:= NQPMu { + $method.set_name('BUILDALL_UNDER_CONSTRUCTION'); + my $result := try { + self.add_method($obj,'BUILDALL_UNDER_CONSTRUCTION',$method); + } + unless $result { + nqp::say($obj.HOW.name($obj) ~ ' failed to add a BUILDALL'); + } + } } } - # Incorporate any new multi candidates (needs MRO built). - self.incorporate_multi_candidates($obj); - # Compose the representation self.compose_repr($obj); } diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index 80b9740c2a1..5ff076aad70 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -2968,9 +2968,6 @@ class Perl6::World is HLL::World { has $!acc_sig_cache; has $!acc_sig_cache_type; - # The generic BUILDALL method for empty BUILDPLANs - has $!empty_buildplan_method; - method generate_accessor($/, str $meth_name, $package_type, str $attr_name, $type, int $rw) { my $native := nqp::objprimspec($type) != 0; my $acc := QAST::Var.new( @@ -3039,182 +3036,193 @@ class Perl6::World is HLL::World { # and JITting opportunities. method generate_buildplan_executor($/, $in_object, $in_build_plan) { - # deconted / low level hash access - my $object := nqp::decont($in_object); + # low level hash access my $build_plan := nqp::getattr( nqp::decont($in_build_plan), $!w.find_symbol(['List']), '$!reified' ); + # No buildplan? we're done! + my int $count := nqp::elems($build_plan); + unless $count { + + # Indicate that we're not going to auto-generate a BUILDALL + # for this class, but let it be handled by Mu.BUILDALL. + return NQPMu; + } + + # The bare object + my $object := nqp::decont($in_object); + # Do we need to wrap an exception handler my int $needs_wrapping; - # There's a BUILDPLAN to work with - if nqp::elems($build_plan) -> $count { + # The basic statements for object initialization, to be + # filled in later + my $stmts := QAST::Stmts.new(:node($/)); - # The basic statements for object initialization, to be - # filled in later - my $stmts := QAST::Stmts.new(); - - my $declarations := QAST::Stmts.new( - QAST::Var.new(:decl, :scope, :name), - QAST::Var.new(:decl, :scope, :name('@auto')), - QAST::Var.new(:decl, :scope, :name('%init')), - QAST::Var.new(:decl, :scope, :name) - ); + my $declarations := QAST::Stmts.new( + QAST::Var.new(:decl, :scope, :name), + QAST::Var.new(:decl, :scope, :name('@auto')), + QAST::Var.new(:decl, :scope, :name('%init')), + QAST::Var.new(:decl, :scope, :name) + ); - # The block of the method - my $block := QAST::Block.new( - :name, :blocktype, - $declarations - ); + # The block of the method + my $block := QAST::Block.new( + :name, :blocktype, + $declarations + ); - # Register the block in its SC - $!w.cur_lexpad()[0].push($block); + # Register the block in its SC + $!w.cur_lexpad()[0].push($block); - my $invocant_type := $!w.create_definite_type( - $!w.find_symbol(['Metamodel','DefiniteHOW']), - $object, - 1 - ); + # Create the invocant type we need + my $invocant_type := $object; + $!w.create_definite_type( + $!w.find_symbol(['Metamodel','DefiniteHOW']), + $object, + 1 + ); - $stmts.push( - QAST::Op.new( :op, - QAST::SVal.new( :value( - $object.HOW.name($object) ~ '.BUILDALL called' - )) - ), - ); - $stmts.push( - QAST::Op.new( :op, - QAST::Op.new( :op, - QAST::Var.new( :scope, :name('%init') ), - QAST::SVal.new( :value ) - ) - ) - ); + # Debugging + $stmts.push( + QAST::Op.new( :op, + QAST::SVal.new( :value( + $object.HOW.name($object) ~ '.BUILDALL called' + )) + ), + ); + $stmts.push( + QAST::Op.new( :op, + QAST::Op.new( :op, + QAST::Var.new( :scope, :name('%init') ), + QAST::SVal.new( :value ) + ) + ) + ); # my $init := nqp::getattr(%init,Map,'$!storage') - $stmts.push(QAST::Op.new( - :op('bind'), - (my $init := QAST::Var.new(:scope, :name)), - QAST::Op.new( - :op('getattr'), - QAST::Var.new( :scope, :name('%init') ), - QAST::WVal.new( :value($!w.find_symbol(['Map'])) ), - QAST::SVal.new( :value('$!storage') ) - ) - )); + $stmts.push(QAST::Op.new( + :op('bind'), + (my $init := QAST::Var.new(:scope, :name)), + QAST::Op.new( + :op('getattr'), + QAST::Var.new( :scope, :name('%init') ), + QAST::WVal.new( :value($!w.find_symbol(['Map'])) ), + QAST::SVal.new( :value('$!storage') ) + ) + )); - my int $i := -1; - while nqp::islt_i($i := nqp::add_i($i, 1), $count) { + # Do all of the actions in the BUILDPLAN + my int $i := -1; + while nqp::islt_i($i := nqp::add_i($i, 1), $count) { - # We have some intricate action to do - if nqp::islist(my $task := nqp::atpos($build_plan,$i)) { + # We have some intricate action to do + if nqp::islist(my $task := nqp::atpos($build_plan,$i)) { - # Register the class in the SC if needed - $!w.add_object_if_no_sc( nqp::atpos($task,1) ); + # Register the class in the SC if needed + $!w.add_object_if_no_sc( nqp::atpos($task,1) ); - # Generate the WVal for setting the class object - my $classwval := - QAST::WVal.new( :value(nqp::atpos($task,1) ) ); + # Generate the WVal for setting the class object + my $classwval := + QAST::WVal.new( :value(nqp::atpos($task,1) ) ); - if nqp::atpos($task,0) -> $code { + if nqp::atpos($task,0) -> $code { - # 1,2,3 = initialize native from %init - if $code < 4 { + # 1,2,3 = initialize native from %init + if $code < 4 { # nqp::existskey($init,'a') - my $existskeyop := QAST::Op.new( - :op('existskey'), - $init, - QAST::SVal.new( :value(nqp::atpos($task,3)) ) - ); + my $existskeyop := QAST::Op.new( + :op('existskey'), + $init, + QAST::SVal.new( :value(nqp::atpos($task,3)) ) + ); # nqp::bindattr_x(self,Foo,'$!a',nqp::decont(%init.AT-KEY('a'))) - my $bindattrop := QAST::Op.new( - :op( 'bindattr' ~ @psp[$code] ), - QAST::Var.new( :name, :scope ), - $classwval, - QAST::SVal.new( :value(nqp::atpos($task,2)) ), - QAST::Op.new( :op, - QAST::Op.new( :op, - QAST::Var.new( - :scope, :name('%init')), - QAST::SVal.new( :value ), - QAST::SVal.new( - :value(nqp::atpos($task,3)) ) - ) - ) - ); + my $bindattrop := QAST::Op.new( + :op( 'bindattr' ~ @psp[$code] ), + QAST::Var.new( :name, :scope ), + $classwval, + QAST::SVal.new( :value(nqp::atpos($task,2)) ), + QAST::Op.new( :op, + QAST::Op.new( :op, + QAST::Var.new(:scope, :name('%init')), + QAST::SVal.new( :value ), + QAST::SVal.new( + :value(nqp::atpos($task,3)) ) + ) + ) + ); # nqp::if( # nqp::existskey($init,'a'), # nqp::bindattr_x(self,Foo,'$!a',nqp::decont(%init.AT-KEY('a'))) # ), - $stmts.push( - QAST::Op.new(:op,$existskeyop,$bindattrop) - ); - } + $stmts.push( + QAST::Op.new(:op,$existskeyop,$bindattrop) + ); + } - # 4 = set opaque with default if not set yet - elsif $code == 4 { + # 4 = set opaque with default if not set yet + elsif $code == 4 { # nqp::getattr(self,Foo,'$!a') - my $getattrop := QAST::Op.new( :op, - QAST::Var.new( :name, :scope ), - $classwval, - QAST::SVal.new( :value(nqp::atpos($task,2)) ) - ); - - # set assign operation to be used - my $sigil := - nqp::substr(nqp::atpos($task,2),0,1); - my $op := $sigil eq '$' || $sigil eq '&' - ?? 'assign' - !! 'p6store'; + my $getattrop := QAST::Op.new( :op, + QAST::Var.new( :name, :scope ), + $classwval, + QAST::SVal.new( :value(nqp::atpos($task,2)) ) + ); + + # set assign operation to be used + my $sigil := + nqp::substr(nqp::atpos($task,2),0,1); + my $op := $sigil eq '$' || $sigil eq '&' + ?? 'assign' + !! 'p6store'; # nqp::unless( # nqp::attrinited(self,Foo,'$!a'), # (nqp::getattr(self,Foo,'$!a') = # $initializer(self,nqp::getattr(self,Foo,'$!a'))) # ), - $stmts.push( - QAST::Op.new( :op, - QAST::Op.new( :op, - QAST::Var.new(:name, :scope), - $classwval, - QAST::SVal.new( - :value(nqp::atpos($task,2)) - ) + $stmts.push( + QAST::Op.new( :op, + QAST::Op.new( :op, + QAST::Var.new(:name, :scope), + $classwval, + QAST::SVal.new( + :value(nqp::atpos($task,2)) + ) + ), + QAST::Op.new( :$op, + $getattrop, + QAST::Op.new( :op, + QAST::WVal.new( + :value(nqp::atpos($task,3)) ), - QAST::Op.new( :$op, - $getattrop, - QAST::Op.new( :op, - QAST::WVal.new( - :value(nqp::atpos($task,3)) - ), - QAST::Var.new( - :name('self'), - :scope('local') - ), - $getattrop - ) - ) + QAST::Var.new( + :name('self'), + :scope('local') + ), + $getattrop ) - ); + ) + ) + ); - $!w.add_object_if_no_sc(nqp::atpos($task,3)); - } + $!w.add_object_if_no_sc(nqp::atpos($task,3)); + } - # 5,6 = set native numeric with default if not set - elsif $code < 7 { + # 5,6 = set native numeric with default if not set + elsif $code < 7 { # nqp::getattr_x(self,Foo,'$!a') - my $getattrop := QAST::Op.new( - :op('getattr' ~ @psp[$code - 4]), - QAST::Var.new( :name, :scope ), - $classwval, - QAST::SVal.new( :value(nqp::atpos($task,2)) ) - ); + my $getattrop := QAST::Op.new( + :op('getattr' ~ @psp[$code - 4]), + QAST::Var.new( :name, :scope ), + $classwval, + QAST::SVal.new( :value(nqp::atpos($task,2)) ) + ); # nqp::if( # nqp::iseq_x( # nqp::getattr_x(self,Foo,'$!a'), @@ -3223,199 +3231,189 @@ class Perl6::World is HLL::World { # nqp::bindattr_x(self,Foo,'$!a', # $initializer(self,nqp::getattr_x(self,Foo,'$!a'))) # ), - $stmts.push( - QAST::Op.new( :op, - QAST::Op.new( - :op('iseq' ~ @psp[$code - 4]), - $getattrop, - @psd[$code - 4], + $stmts.push( + QAST::Op.new( :op, + QAST::Op.new( + :op('iseq' ~ @psp[$code - 4]), + $getattrop, + @psd[$code - 4], + ), + QAST::Op.new( + :op('bindattr' ~ @psp[$code - 4]), + QAST::Var.new(:name, :scope), + $classwval, + QAST::SVal.new(:value(nqp::atpos($task,2))), + QAST::Op.new( :op, + QAST::WVal.new(:value(nqp::atpos($task,3)) ), - QAST::Op.new( - :op('bindattr' ~ @psp[$code - 4]), - QAST::Var.new(:name, :scope), - $classwval, - QAST::SVal.new( - :value(nqp::atpos($task,2)) ), - QAST::Op.new( :op, - QAST::WVal.new( - :value(nqp::atpos($task,3)) - ), - QAST::Var.new( - :name('self'), - :scope('local') - ), - $getattrop - ) - ) + QAST::Var.new( + :name('self'), + :scope('local') + ), + $getattrop ) - ); + ) + ) + ); - $!w.add_object_if_no_sc(nqp::atpos($task,3)); - } + $!w.add_object_if_no_sc(nqp::atpos($task,3)); + } - # 7 = set native string with default if not set - elsif $code == 7 { + # 7 = set native string with default if not set + elsif $code == 7 { # nqp::getattr_s(self,Foo,'$!a') - my $getattrop := QAST::Op.new( :op, - QAST::Var.new( :name, :scope ), - $classwval, - QAST::SVal.new( :value(nqp::atpos($task,2)) ) - ); + my $getattrop := QAST::Op.new( :op, + QAST::Var.new( :name, :scope ), + $classwval, + QAST::SVal.new( :value(nqp::atpos($task,2)) ) + ); # nqp::if( # nqp::isnull_s(nqp::getattr_s(self,Foo,'$!a')), # nqp::bindattr_s(self,Foo,'$!a', # $initializer(self,nqp::getattr_s(self,Foo,'$!a'))) # ), - $stmts.push( - QAST::Op.new( :op, - QAST::Op.new( :op, $getattrop), - QAST::Op.new( :op, - QAST::Var.new(:name, :scope), - $classwval, - QAST::SVal.new( - :value(nqp::atpos($task,2)) ), - QAST::Op.new( :op, - QAST::WVal.new( - :value(nqp::atpos($task,3)) - ), - QAST::Var.new( - :name('self'), - :scope('local') - ), - $getattrop - ) - ) + $stmts.push( + QAST::Op.new( :op, + QAST::Op.new( :op, $getattrop), + QAST::Op.new( :op, + QAST::Var.new(:name, :scope), + $classwval, + QAST::SVal.new(:value(nqp::atpos($task,2))), + QAST::Op.new( :op, + QAST::WVal.new(:value(nqp::atpos($task,3))), + QAST::Var.new( + :name('self'), + :scope('local') + ), + $getattrop ) - ); + ) + ) + ); - $!w.add_object_if_no_sc(nqp::atpos($task,3)); - } + $!w.add_object_if_no_sc(nqp::atpos($task,3)); + } - # 8 = bail if opaque not yet initialized - elsif $code == 8 { + # 8 = bail if opaque not yet initialized + elsif $code == 8 { # nqp::getattr(self,Foo,'$!a') - my $getattrop := QAST::Op.new( :op, - QAST::Var.new( :name, :scope ), - $classwval, - QAST::SVal.new( :value(nqp::atpos($task,2)) ) - ); + my $getattrop := QAST::Op.new( :op, + QAST::Var.new( :name, :scope ), + $classwval, + QAST::SVal.new( :value(nqp::atpos($task,2)) ) + ); # nqp::unless( # nqp::attrinited(self,Foo,'$!a'), # X::Attribute::Required.new(name => '$!a', why => (value)) # ), - $stmts.push( - QAST::Op.new( :op, - QAST::Op.new( :op, - QAST::Var.new(:name, :scope), - $classwval, - QAST::SVal.new( - :value(nqp::atpos($task,2)) + $stmts.push( + QAST::Op.new( :op, + QAST::Op.new( :op, + QAST::Var.new(:name, :scope), + $classwval, + QAST::SVal.new(:value(nqp::atpos($task,2))) + ), + QAST::Op.new( :op, + QAST::Op.new( :op, + QAST::WVal.new( :value( + $!w.find_symbol( + ['X','Attribute','Required'] ) + )), + QAST::SVal.new( :value ), + QAST::SVal.new( :named('name'), + :value(nqp::atpos($task,2)) ), - QAST::Op.new( :op, - QAST::Op.new( :op, - QAST::WVal.new( :value( - $!w.find_symbol( - ['X','Attribute','Required'] - ) - )), - QAST::SVal.new( :value ), - QAST::SVal.new( :named('name'), - :value(nqp::atpos($task,2)) - ), - QAST::WVal.new( :named('why'), - :value(nqp::atpos($task,3)) - ) - ), - QAST::SVal.new( :value ), + QAST::WVal.new( :named('why'), + :value(nqp::atpos($task,3)) ) - ) - ); - } + ), + QAST::SVal.new( :value ), + ) + ) + ); + } - # 9 = run attribute container initializer - elsif $code == 9 { + # 9 = run attribute container initializer + elsif $code == 9 { # nqp::bindattr(self,Foo,'$!a',$initializer()) - $stmts.push( - QAST::Op.new( :op, - QAST::Var.new(:name, :scope), - $classwval, - QAST::SVal.new( - :value(nqp::atpos($task,2)) ), - QAST::Op.new( :op, - QAST::WVal.new( - :value(nqp::atpos($task,3)) - ) - ) - ) - ); - - $!w.add_object_if_no_sc(nqp::atpos($task,3)); - } + $stmts.push( + QAST::Op.new( :op, + QAST::Var.new(:name, :scope), + $classwval, + QAST::SVal.new(:value(nqp::atpos($task,2))), + QAST::Op.new( :op, + QAST::WVal.new(:value(nqp::atpos($task,3))) + ) + ) + ); - else { - nqp::die("Invalid BUILDALL plan"); - } + $!w.add_object_if_no_sc(nqp::atpos($task,3)); } - # 0 = initialize opaque from %init else { + nqp::die("Invalid BUILDALL plan"); + } + } + + # 0 = initialize opaque from %init + else { # nqp::existskey($init,'a') - my $existskeyop := QAST::Op.new( :op('existskey'), - $init, - QAST::SVal.new( :value(nqp::atpos($task,3)) ) - ); + my $existskeyop := QAST::Op.new( :op('existskey'), + $init, + QAST::SVal.new( :value(nqp::atpos($task,3)) ) + ); # nqp::getattr(self,Foo,'$!a') - my $getattrop := QAST::Op.new( :op, - QAST::Var.new( :name, :scope ), - $classwval, - QAST::SVal.new( :value( nqp::atpos($task,2) ) ) - ); + my $getattrop := QAST::Op.new( :op, + QAST::Var.new( :name, :scope ), + $classwval, + QAST::SVal.new( :value( nqp::atpos($task,2) ) ) + ); - # set assign operation to be used - my $sigil := - nqp::substr(nqp::atpos($task,2),0,1); - my $op := $sigil eq '$' || $sigil eq '&' - ?? 'assign' - !! 'p6store'; + # set assign operation to be used + my $sigil := + nqp::substr(nqp::atpos($task,2),0,1); + my $op := $sigil eq '$' || $sigil eq '&' + ?? 'assign' + !! 'p6store'; # nqp::if( # nqp::existskey($init,'a'), # nqp::getattr(self,Foo,'$!a') = %init.AT-KEY('a') # ), - $stmts.push( - QAST::Op.new( :op, - $existskeyop, - QAST::Op.new( :$op, - $getattrop, - QAST::Op.new( :op, - QAST::Var.new(:scope,:name('%init')), - QAST::SVal.new(:value), - QAST::SVal.new(:value(nqp::atpos($task,3))) - ) - ) + $stmts.push( + QAST::Op.new( :op, + $existskeyop, + QAST::Op.new( :$op, + $getattrop, + QAST::Op.new( :op, + QAST::Var.new(:scope,:name('%init')), + QAST::SVal.new(:value), + QAST::SVal.new(:value(nqp::atpos($task,3))) ) - ); - } + ) + ) + ); } + } - # BUILD/TWEAK - else { + # BUILD/TWEAK + else { - # BUILD or TWEAK without BUILD (first seen) - unless $needs_wrapping { + # BUILD or TWEAK without BUILD (first seen) + unless $needs_wrapping { # (my $return), - $declarations.push( - QAST::Var.new( - :decl, :scope, :name) - ); - $needs_wrapping := 1 - }; + $declarations.push( + QAST::Var.new( + :decl, :scope, :name) + ); + $needs_wrapping := 1 + }; # nqp::if( # nqp::istype( @@ -3428,108 +3426,78 @@ class Perl6::World is HLL::World { # ), # return $return # ), - $stmts.push( - QAST::Op.new( :op, - QAST::Op.new( :op, - QAST::Op.new( :op, - QAST::Var.new(:scope, :name), - QAST::Op.new( :op, - QAST::Op.new( :op, $init ), - QAST::Op.new( :op, - QAST::WVal.new( :value($task) ), - QAST::Var.new( - :name('self'), - :scope('local') - ), - QAST::Var.new( - :scope, - :name, # use nqp::hash directly - :flat(1), - :named(1) - ), - ), - QAST::Op.new( :op, - QAST::WVal.new( :value($task) ), - QAST::Var.new(:name('self'),:scope('local')) - ) - ) - ), - QAST::WVal.new( - :value($!w.find_symbol(['Failure'])) + $stmts.push( + QAST::Op.new( :op, + QAST::Op.new( :op, + QAST::Op.new( :op, + QAST::Var.new(:scope, :name), + QAST::Op.new( :op, + QAST::Op.new( :op, $init ), + QAST::Op.new( :op, + QAST::WVal.new( :value($task) ), + QAST::Var.new( + :name('self'), + :scope('local') + ), + QAST::Var.new( + :scope, + :name, # use nqp::hash directly + :flat(1), + :named(1) + ), ), - ), - QAST::Op.new( :op, - QAST::WVal.new( - :value($!w.find_symbol(['&return'])) - ), - QAST::Var.new(:scope, :name) + QAST::Op.new( :op, + QAST::WVal.new( :value($task) ), + QAST::Var.new(:name('self'),:scope('local')) + ) ) - ) - ); - - $!w.add_object_if_no_sc($task); - } - } - - # Finally, add the return value - $stmts.push(QAST::Var.new(:name('self'), :scope('local'))); - - # Need to wrap an exception handler around - if $needs_wrapping { - $stmts := QAST::Op.new( :op, - $stmts, - 'RETURN', - QAST::Op.new( :op ) + ), + QAST::WVal.new( + :value($!w.find_symbol(['Failure'])) + ), + ), + QAST::Op.new( :op, + QAST::WVal.new( + :value($!w.find_symbol(['&return'])) + ), + QAST::Var.new(:scope, :name) + ) + ) ); - } - - # Add the statements to the block - $block.push($stmts); - -# :(Foo:D: %init) - my $sig := $!w.create_signature_and_params( - NQPMu, %sig_init, $block, 'Any', :method, :$invocant_type - ); - # Create the code object and return it - $!w.create_code_object($block, 'Submethod', $sig) + $!w.add_object_if_no_sc($task); + } } - # Empty buildplan, and we already have an empty buildplan method - elsif $!empty_buildplan_method { - $!empty_buildplan_method - } + # Debugging + $stmts.push( + QAST::Op.new( :op, + QAST::SVal.new( :value('....done') ) + ) + ); - # Empty buildplan, still need to make an empty method - else { + # Finally, add the return value + $stmts.push(QAST::Var.new(:name('self'), :scope('local'))); -# submethod :: (Any:D:) { self } - my $block := QAST::Block.new( - :name, :blocktype, - QAST::Stmts.new( - QAST::Var.new(:decl, :scope, :name), - QAST::Var.new(:decl, :scope, :name('%init')), - ), - QAST::Var.new(:name('self'), :scope('local')) + # Need to wrap an exception handler around + if $needs_wrapping { + $stmts := QAST::Op.new( :op, + $stmts, + 'RETURN', + QAST::Op.new( :op ) ); + } - # Register the block in its SC - $!w.cur_lexpad()[0].push($block); - - my $invocant_type := $!w.create_definite_type( - $!w.find_symbol(['Metamodel','DefiniteHOW']), - $!w.find_symbol(['Any']), - 1 - ); + # Add the statements to the block + $block.push($stmts); - my $sig := $!w.create_signature_and_params( - NQPMu, %sig_init, $block, 'Any', :method, :$invocant_type - ); +# :(Foo:D: %init) + my $sig := $!w.create_signature_and_params( + NQPMu, %sig_init, $block, 'Any', :method, :$invocant_type + ); - # Create the code object, save and return it - $!empty_buildplan_method := - $!w.create_code_object($block,'Submethod',$sig) - } + # Create the code object and return it + $!w.create_code_object($block, 'Submethod', $sig) } } From af2ab751b838f91d506acb6310d3d1b9624a34c1 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Thu, 28 Sep 2017 18:09:57 +0200 Subject: [PATCH 209/692] We want the definite type, jnthn++ --- src/Perl6/World.nqp | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index 5ff076aad70..c72e93085c0 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -3079,8 +3079,7 @@ class Perl6::World is HLL::World { $!w.cur_lexpad()[0].push($block); # Create the invocant type we need - my $invocant_type := $object; - $!w.create_definite_type( + my $invocant_type := $!w.create_definite_type( $!w.find_symbol(['Metamodel','DefiniteHOW']), $object, 1 From 9ff2f98f796bbc7cab3b4de37ba905de5b3a3a2a Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Thu, 28 Sep 2017 18:54:41 +0000 Subject: [PATCH 210/692] Polish unicode -> ascii op converter - Explain why .find_lexical is needed - Move the call to converter after .find_lexical is called for target op - Remove args that weren't used in the helper sub --- src/Perl6/Optimizer.nqp | 32 ++++++++++++++------------------ 1 file changed, 14 insertions(+), 18 deletions(-) diff --git a/src/Perl6/Optimizer.nqp b/src/Perl6/Optimizer.nqp index 0954dfc2c19..5d6fb6ed0fd 100644 --- a/src/Perl6/Optimizer.nqp +++ b/src/Perl6/Optimizer.nqp @@ -1376,25 +1376,20 @@ class Perl6::Optimizer { } } - method convert_unicode_op_to_texas($op) { - sub should-texify ($from, $to) { + method convert_unicode_op_to_ascii($op) { + sub asciify-to ($to) { try { - $!symbols.find_lexical($to); - $!symbols.is_from_core($to) && 1; - } ?? 1 !! 0; + # this method reifies lazy symbol's values, and the value + # is then looked at by the is_from_core method. + $!symbols.find_lexical($to); # dies if can't find + $!symbols.is_from_core($to) && $op.name: $to + } } - if $!symbols.is_from_core: $op.name { - my $name := $op.name; - if ($name eq '&infix:<≤>' - && should-texify('&infix:<≤>', '&infix:«<=»')) { - $op.name: '&infix:«<=»' } - elsif ($name eq '&infix:<≥>' - && should-texify('&infix:<≥>', '&infix:«>=»')) { - $op.name: '&infix:«>=»' } - elsif ($name eq '&infix:<≠>' - && should-texify('&infix:<≠>', '&infix:')) { - $op.name: '&infix:' } + if $!symbols.is_from_core: my $name := $op.name { + if ($name eq '&infix:<≤>') { asciify-to('&infix:«<=»') } + elsif ($name eq '&infix:<≥>') { asciify-to('&infix:«>=»') } + elsif ($name eq '&infix:<≠>') { asciify-to('&infix:') } } } @@ -1404,13 +1399,14 @@ class Perl6::Optimizer { my int $found := 0; note("method optimize_call $!void_context\n" ~ $op.dump) if $!debug; - self.convert_unicode_op_to_texas($op); - try { $obj := $!symbols.find_lexical($op.name); $found := 1; } + if $found { + self.convert_unicode_op_to_ascii($op); + # Pure operators can be constant folded. if nqp::can($obj, 'IS_PURE') && $obj.IS_PURE { # First ensure we're not in void context; warn if so. From d60ba6339a75863cd8720fb5db7c0d5b535f0cd3 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Thu, 28 Sep 2017 22:15:33 +0200 Subject: [PATCH 211/692] HLLize shortname parameter to CU::DependencySpecification This change makes all of the auto-generated BUILDALL stuff work. Theory is that having a native str as a named parameter doesn't jive well with doing Str:D checking. But this can apparently only happen when being called from NQP, as in Perl 6 a native str will be hllized automatically. --- src/Perl6/World.nqp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index c72e93085c0..65a5ab49b7a 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -1207,7 +1207,7 @@ class Perl6::World is HLL::World { my $line := self.current_line($/); my $true := self.find_symbol(['True']); my $spec := self.find_symbol(['CompUnit', 'DependencySpecification']).new( - :short-name($module_name), + :short-name(nqp::hllize($module_name)), :from(%opts // 'Perl6'), :auth-matcher(%opts // $true), :version-matcher(%opts // $true), From 04ea446dd3034b97c5b8dff53271cf8b2b1ba434 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Thu, 28 Sep 2017 22:43:28 +0200 Subject: [PATCH 212/692] Revert "HLLize shortname parameter to CU::DependencySpecification" This reverts commit d60ba6339a75863cd8720fb5db7c0d5b535f0cd3. --- src/Perl6/World.nqp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index 65a5ab49b7a..c72e93085c0 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -1207,7 +1207,7 @@ class Perl6::World is HLL::World { my $line := self.current_line($/); my $true := self.find_symbol(['True']); my $spec := self.find_symbol(['CompUnit', 'DependencySpecification']).new( - :short-name(nqp::hllize($module_name)), + :short-name($module_name), :from(%opts // 'Perl6'), :auth-matcher(%opts // $true), :version-matcher(%opts // $true), From 5cd9197fe3707d513671af6ff1abdc8a2134c369 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Thu, 28 Sep 2017 22:44:51 +0200 Subject: [PATCH 213/692] Nativy :D attributes on CU::DependencySpecification Seems to be the only way to get auto-generated BUILDALL to work. --- src/core/CompUnit/DependencySpecification.pm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/core/CompUnit/DependencySpecification.pm b/src/core/CompUnit/DependencySpecification.pm index fbefbcfcc7b..00fa9c3b40a 100644 --- a/src/core/CompUnit/DependencySpecification.pm +++ b/src/core/CompUnit/DependencySpecification.pm @@ -1,7 +1,7 @@ class CompUnit::DependencySpecification { - has Str:D $.short-name is required; - has Int:D $.source-line-number = 0; - has Str:D $.from = 'Perl6'; + has str $.short-name is required; + has int $.source-line-number = 0; + has str $.from = 'Perl6'; has $.version-matcher = True; has $.auth-matcher = True; has $.api-matcher = True; From 6824e19282e19a0953fc64faf14445600d9b24e6 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Thu, 28 Sep 2017 22:50:22 +0200 Subject: [PATCH 214/692] Stage 6 of auto-generated BUILDALL - auto-generated BUILDALL now installed as BUILDALL - so all classes have their own BUILDALL unless there was nothing to do, in which case they fall back to Mu.BUILDALL - removed/commented out debugging ops Benchmarks show that .new on a class that uses Mu.new and named parameters, is now about 1.5x as fast. This means .2 seconds faster for test-t on my machine (about 9% faster). --- src/Perl6/Metamodel/ClassHOW.nqp | 4 +-- src/Perl6/World.nqp | 42 +++++++++++++------------------- 2 files changed, 19 insertions(+), 27 deletions(-) diff --git a/src/Perl6/Metamodel/ClassHOW.nqp b/src/Perl6/Metamodel/ClassHOW.nqp index f186e31c86e..b8471df44f9 100644 --- a/src/Perl6/Metamodel/ClassHOW.nqp +++ b/src/Perl6/Metamodel/ClassHOW.nqp @@ -162,9 +162,9 @@ class Perl6::Metamodel::ClassHOW my $method := $builder($compiler_services,$obj,$BUILDALLPLAN); unless $method =:= NQPMu { - $method.set_name('BUILDALL_UNDER_CONSTRUCTION'); + $method.set_name('BUILDALL'); my $result := try { - self.add_method($obj,'BUILDALL_UNDER_CONSTRUCTION',$method); + self.add_method($obj,'BUILDALL',$method); } unless $result { nqp::say($obj.HOW.name($obj) ~ ' failed to add a BUILDALL'); diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index c72e93085c0..ebfb76081ba 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -1204,7 +1204,7 @@ class Perl6::World is HLL::World { $RMD(" Late loading '$module_name'") if $RMD; # Immediate loading. - my $line := self.current_line($/); + my $line := self.current_line($/); my $true := self.find_symbol(['True']); my $spec := self.find_symbol(['CompUnit', 'DependencySpecification']).new( :short-name($module_name), @@ -3086,21 +3086,21 @@ class Perl6::World is HLL::World { ); # Debugging - $stmts.push( - QAST::Op.new( :op, - QAST::SVal.new( :value( - $object.HOW.name($object) ~ '.BUILDALL called' - )) - ), - ); - $stmts.push( - QAST::Op.new( :op, - QAST::Op.new( :op, - QAST::Var.new( :scope, :name('%init') ), - QAST::SVal.new( :value ) - ) - ) - ); +# $stmts.push( +# QAST::Op.new( :op, +# QAST::SVal.new( :value( +# $object.HOW.name($object) ~ '.BUILDALL called' +# )) +# ), +# ); +# $stmts.push( +# QAST::Op.new( :op, +# QAST::Op.new( :op, +# QAST::Var.new( :scope, :name('%init') ), +# QAST::SVal.new( :value ) +# ) +# ) +# ); # my $init := nqp::getattr(%init,Map,'$!storage') $stmts.push(QAST::Op.new( @@ -3134,8 +3134,7 @@ class Perl6::World is HLL::World { if $code < 4 { # nqp::existskey($init,'a') - my $existskeyop := QAST::Op.new( - :op('existskey'), + my $existskeyop := QAST::Op.new( :op('existskey'), $init, QAST::SVal.new( :value(nqp::atpos($task,3)) ) ); @@ -3468,13 +3467,6 @@ class Perl6::World is HLL::World { } } - # Debugging - $stmts.push( - QAST::Op.new( :op, - QAST::SVal.new( :value('....done') ) - ) - ); - # Finally, add the return value $stmts.push(QAST::Var.new(:name('self'), :scope('local'))); From 7363f898f67ee7d8117ff958b3d2286d03e07feb Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Thu, 28 Sep 2017 23:51:30 +0200 Subject: [PATCH 215/692] Move up Rakudo::Internals::CompilerServices So that other classes inside Rakudo::Internals get a proper autogenerated BUILDALL. Which should allow us to make Mu.BUILDALL a noop basically. --- src/core/Rakudo/Internals.pm | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/src/core/Rakudo/Internals.pm b/src/core/Rakudo/Internals.pm index dac0c86e844..090cbf0247a 100644 --- a/src/core/Rakudo/Internals.pm +++ b/src/core/Rakudo/Internals.pm @@ -17,6 +17,20 @@ my class Rakudo::Internals { # for use in nqp::splice my $empty := nqp::list; + our class CompilerServices { + has Mu $!compiler; + has Mu $!current-match; + + method generate_accessor(str $name, Mu \package_type, str $attr_name, Mu \type, int $rw) { + $!compiler.generate_accessor( + $!current-match, $name, package_type, $attr_name, type, $rw); + } + method generate_buildplan_executor(Mu \obj, Mu \buildplan) { + $!compiler.generate_buildplan_executor( + $!current-match, obj, buildplan) + } + } + # rotate nqp list to another given list without using push/pop method RotateListToList(\from,\n,\to) { nqp::stmts( @@ -1250,20 +1264,6 @@ my class Rakudo::Internals { nqp::stat_time(nqp::unbox_s(abspath), nqp::const::STAT_CHANGETIME) } - our class CompilerServices { - has Mu $!compiler; - has Mu $!current-match; - - method generate_accessor(str $name, Mu \package_type, str $attr_name, Mu \type, int $rw) { - $!compiler.generate_accessor( - $!current-match, $name, package_type, $attr_name, type, $rw); - } - method generate_buildplan_executor(Mu \obj, Mu \buildplan) { - $!compiler.generate_buildplan_executor( - $!current-match, obj, buildplan) - } - } - method HANDLE-NQP-SPRINTF-ERRORS(Mu \exception) { my $vmex := nqp::getattr(nqp::decont(exception), Exception, '$!ex'); my \payload := nqp::getpayload($vmex); From 2448195df82006d78884c37e784e4024693f98ce Mon Sep 17 00:00:00 2001 From: skids Date: Thu, 28 Sep 2017 18:37:45 -0400 Subject: [PATCH 216/692] Move security RT#131079 fix from Grammar to Actions This lets us catch compound name cases Use appropriate syntax errors before flagging restricted status Give prohibition on longname aliases a typed exception --- src/Perl6/Actions.nqp | 18 +++++++++++++++++- src/Perl6/Grammar.nqp | 1 - src/core/Exception.pm | 4 ++++ 3 files changed, 21 insertions(+), 2 deletions(-) diff --git a/src/Perl6/Actions.nqp b/src/Perl6/Actions.nqp index d9751638bb5..36fa59b2bf1 100644 --- a/src/Perl6/Actions.nqp +++ b/src/Perl6/Actions.nqp @@ -9922,6 +9922,22 @@ class Perl6::RegexActions is QRegex::P6Regex::Actions does STDActions { my $qast; # We got something like <::($foo)> if $lng.contains_indirect_lookup() { + if $ { + if +$lng.components() > 1 { + $/.typed_panic('X::Syntax::Regex::Alias::LongName'); + } + else { + # If ever implemented, take care with RESTRICTED + $/.typed_panic('X::Syntax::Reserved', :reserved('dynamic alias name in regex')); + } + } + if +$lng.components() > 1 { + # If ever implemented, take care with RESTRICTED + $/.typed_panic('X::NYI', :feature('long dynamic name in regex assertion')); + } + if $*RESTRICTED { + $/.typed_panic('X::SecurityPolicy::Eval', :payload($*RESTRICTED)); + } $qast := QAST::Regex.new( :rxtype, :subtype, :node($/), QAST::NodeList.new(QAST::SVal.new( :value('INDMETHOD') ), $lng.name_past()) ); } @@ -9931,7 +9947,7 @@ class Perl6::RegexActions is QRegex::P6Regex::Actions does STDActions { my $c := $/; if $ { if +@parts { - $c.panic("Can only alias to a short name (without '::')"); + $c.typed_panic('X::Syntax::Regex::Alias::LongName'); } $qast := $.ast; if $qast.rxtype eq 'subrule' { diff --git a/src/Perl6/Grammar.nqp b/src/Perl6/Grammar.nqp index 98591810143..f4303361bdf 100644 --- a/src/Perl6/Grammar.nqp +++ b/src/Perl6/Grammar.nqp @@ -5421,7 +5421,6 @@ grammar Perl6::RegexGrammar is QRegex::P6Regex::Grammar does STD does MatchPacka } token assertion:sym { - > [ | ]> diff --git a/src/core/Exception.pm b/src/core/Exception.pm index 2d30a50c38b..4438637767f 100644 --- a/src/core/Exception.pm +++ b/src/core/Exception.pm @@ -1708,6 +1708,10 @@ my class X::Syntax::Regex::SolitaryBacktrackControl does X::Syntax { method message { "Backtrack control ':' does not seem to have a preceding atom to control" } } +my class X::Syntax::Regex::Alias::LongName does X::Syntax { + method message() { "Can only alias to a short name (without '::')"; } +} + my class X::Syntax::Term::MissingInitializer does X::Syntax { method message { 'Term definition requires an initializer' } } From cd043f2ae4cb617eae89252de3263a49c54311f3 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Thu, 28 Sep 2017 23:05:44 +0000 Subject: [PATCH 217/692] "Remove" is_approx in 6.d It long lived out its deprecation period, but is still used by 6.c roast. I'm not sure how such removals are meant to be handled, since a routine removed in 6.n is still in used in previous langs. So I made it just die in 6.d. Close enough? --- lib/Test.pm6 | 3 +++ t/02-rakudo/v6.d-tests/01-deprecations.t | 9 ++++++++- 2 files changed, 11 insertions(+), 1 deletion(-) diff --git a/lib/Test.pm6 b/lib/Test.pm6 index 6ba89e9f131..4bde5738ceb 100644 --- a/lib/Test.pm6 +++ b/lib/Test.pm6 @@ -270,6 +270,9 @@ sub bail-out ($desc?) is export { multi sub is_approx(Mu $got, Mu $expected, $desc = '') is export { DEPRECATED('is-approx'); # Remove for 6.d release + $*PERL.version after v6.c + and die 'is_approx() has been removed as of v6.d. ' + ~ 'Please switch to is-approx()'; $time_after = nqp::time_n; my $tol = $expected.abs < 1e-6 ?? 1e-5 !! $expected.abs * 1e-6; diff --git a/t/02-rakudo/v6.d-tests/01-deprecations.t b/t/02-rakudo/v6.d-tests/01-deprecations.t index dfdb8315ac5..1833788c04a 100644 --- a/t/02-rakudo/v6.d-tests/01-deprecations.t +++ b/t/02-rakudo/v6.d-tests/01-deprecations.t @@ -2,7 +2,7 @@ use lib ; use Test; use Test::Util; -plan 6; +plan 7; # XXX TODO: swap v6.d.PREVIEW to v6.d, once the latter is available constant $v6d = 'v6.d.PREVIEW'; @@ -42,3 +42,10 @@ subtest 'IO::Handle.slurp-rest' => { is-newly-deprecated "$file.IO.open.slurp-rest", '.slurp-rest'; is-newly-deprecated "$file.IO.open.slurp-rest: :bin", '.slurp-rest: :bin'; } + + +# Should be removed in 6.d, but I made it just die, at least for now, +# as I'm unsure how the removal is meant to happen, if we still wish +# to have it working in 6.c tests +is_run 'use \qq[$v6d]; use Test; try is_approx 1, 1; $! and say "test passed"', + {:out(/'test passed'/), :0status }, 'is_approx dies in v6.d'; From 01d4939c38dba9c98b76991cd59be9e438d42a76 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Thu, 28 Sep 2017 23:19:34 +0000 Subject: [PATCH 218/692] Deprecate Str.lines: :$count in 6.d --- src/core/Str.pm | 2 +- t/02-rakudo/v6.d-tests/01-deprecations.t | 4 +++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/src/core/Str.pm b/src/core/Str.pm index f7492739d32..d5078c000e3 100644 --- a/src/core/Str.pm +++ b/src/core/Str.pm @@ -1297,7 +1297,7 @@ my class Str does Stringy { # declared in BOOTSTRAP proto method lines(|) { * } multi method lines(Str:D: :$count!) { - # we should probably deprecate this feature + DEPRECATED '.lines.elems', '6.d', '6.e', :lang-vers; $count ?? self.lines.elems !! self.lines; } multi method lines(Str:D: $limit) { diff --git a/t/02-rakudo/v6.d-tests/01-deprecations.t b/t/02-rakudo/v6.d-tests/01-deprecations.t index 1833788c04a..a039c967c15 100644 --- a/t/02-rakudo/v6.d-tests/01-deprecations.t +++ b/t/02-rakudo/v6.d-tests/01-deprecations.t @@ -2,7 +2,7 @@ use lib ; use Test; use Test::Util; -plan 7; +plan 9; # XXX TODO: swap v6.d.PREVIEW to v6.d, once the latter is available constant $v6d = 'v6.d.PREVIEW'; @@ -35,6 +35,8 @@ is-newly-deprecated 「$ = 4.2.FatRat: 42」; is-newly-deprecated 「$ = FatRat.new(4,2).Rat: 42」; is-newly-deprecated 「$ = FatRat.new(4,2).FatRat: 42」; is-newly-deprecated 「".".IO.chdir: "."」; +is-newly-deprecated 「"".lines: :count」; +is-newly-deprecated 「"".lines: :!count」; subtest 'IO::Handle.slurp-rest' => { plan 2; From 9cb4b167f5e0abb414366c3024d465e0056caffc Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Thu, 28 Sep 2017 23:46:11 +0000 Subject: [PATCH 219/692] Remove $*MAIN-ALLOW-NAMED-ANYWHERE It was unspecced and temporarily added to transition users of old panda. --- src/core/Main.pm | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/core/Main.pm b/src/core/Main.pm index aa6afd5d7a6..21bb6bf21a5 100644 --- a/src/core/Main.pm +++ b/src/core/Main.pm @@ -10,9 +10,8 @@ my sub MAIN_HELPER($retval = 0) { my $m = callframe(1).my<&MAIN>; return $retval unless $m; - my %SUB-MAIN-OPTS := %*SUB-MAIN-OPTS // {}; - my $no-named-after = - !(%SUB-MAIN-OPTS // $*MAIN-ALLOW-NAMED-ANYWHERE); + my %SUB-MAIN-OPTS := %*SUB-MAIN-OPTS // {}; + my $no-named-after := nqp::isfalse(%SUB-MAIN-OPTS); sub thevalue(\a) { ((my $type := ::(a)) andthen Metamodel::EnumHOW.ACCEPTS($type.HOW)) From 03b1febc93abc79ba28816cf4b4a658baa5783ea Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Fri, 29 Sep 2017 00:26:53 +0000 Subject: [PATCH 220/692] Add S32-io/open.t to 6.c test files --- t/spectest.data.6.c | 1 + 1 file changed, 1 insertion(+) diff --git a/t/spectest.data.6.c b/t/spectest.data.6.c index 2e29ef4ced7..000d6287dee 100644 --- a/t/spectest.data.6.c +++ b/t/spectest.data.6.c @@ -924,6 +924,7 @@ S32-io/IO-Socket-INET.t S32-io/move.t S32-io/native-descriptor.t # moar S32-io/note.t +S32-io/open.t S32-io/other.t S32-io/pipe.t S32-io/rename.t From 4959df3f314837e2ef658efd0ff0d7ee3b3dadcc Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Fri, 29 Sep 2017 10:18:03 +0200 Subject: [PATCH 221/692] Remove $/ support from CompilerServices This reverts the first commit (and subsequent commits related to this) that dogbert++ found to be the first that caused failures for him. --- src/Perl6/World.nqp | 34 +++++++++++----------------------- src/core/Rakudo/Internals.pm | 6 ++---- 2 files changed, 13 insertions(+), 27 deletions(-) diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index ebfb76081ba..5a3c5c41e1a 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -2950,7 +2950,7 @@ class Perl6::World is HLL::World { # Composes the package, and stores an event for this action. method pkg_compose($/, $obj) { - my $compiler_services := self.get_compiler_services($/); + my $compiler_services := self.get_compiler_services; if nqp::isconcrete($compiler_services) { self.ex-handle($/, { $obj.HOW.compose($obj, :$compiler_services) }) } @@ -2968,7 +2968,7 @@ class Perl6::World is HLL::World { has $!acc_sig_cache; has $!acc_sig_cache_type; - method generate_accessor($/, str $meth_name, $package_type, str $attr_name, $type, int $rw) { + method generate_accessor(str $meth_name, $package_type, str $attr_name, $type, int $rw) { my $native := nqp::objprimspec($type) != 0; my $acc := QAST::Var.new( :scope($native && $rw ?? 'attributeref' !! 'attribute'), @@ -2985,7 +2985,6 @@ class Perl6::World is HLL::World { my $block := QAST::Block.new( :name($meth_name), :blocktype('declaration_static'), QAST::Stmts.new( - :node($/), QAST::Var.new( :decl('param'), :scope('local'), :name('self') ), @@ -3034,7 +3033,7 @@ class Perl6::World is HLL::World { # attributes. Basically a flattened version of Mu.BUILDALL, which # iterates over the BUILDALLPLAN at runtime with fewer inlining # and JITting opportunities. - method generate_buildplan_executor($/, $in_object, $in_build_plan) { + method generate_buildplan_executor($in_object, $in_build_plan) { # low level hash access my $build_plan := nqp::getattr( @@ -3060,7 +3059,7 @@ class Perl6::World is HLL::World { # The basic statements for object initialization, to be # filled in later - my $stmts := QAST::Stmts.new(:node($/)); + my $stmts := QAST::Stmts.new(); my $declarations := QAST::Stmts.new( QAST::Var.new(:decl, :scope, :name), @@ -3492,24 +3491,13 @@ class Perl6::World is HLL::World { } } - method get_compiler_services($/) { - if nqp::isconcrete($!compiler_services) { - nqp::bindattr( - $!compiler_services, - $!compiler_services.WHAT, - '$!current-match', - $/ - ); - } - else { - try { - my $wtype := self.find_symbol(['Rakudo', 'Internals', 'CompilerServices']); - my $wrapped := CompilerServices.new(w => self); - my $wrapper := nqp::create($wtype); - nqp::bindattr($wrapper, $wtype, '$!compiler', $wrapped); - nqp::bindattr($wrapper, $wtype, '$!current-match', $/); - $!compiler_services := $wrapper; - } + method get_compiler_services() { + try { + my $wtype := self.find_symbol(['Rakudo', 'Internals', 'CompilerServices']); + my $wrapped := CompilerServices.new(w => self); + my $wrapper := nqp::create($wtype); + nqp::bindattr($wrapper, $wtype, '$!compiler', $wrapped); + $!compiler_services := $wrapper; } $!compiler_services } diff --git a/src/core/Rakudo/Internals.pm b/src/core/Rakudo/Internals.pm index 090cbf0247a..21190ad22af 100644 --- a/src/core/Rakudo/Internals.pm +++ b/src/core/Rakudo/Internals.pm @@ -19,15 +19,13 @@ my class Rakudo::Internals { our class CompilerServices { has Mu $!compiler; - has Mu $!current-match; method generate_accessor(str $name, Mu \package_type, str $attr_name, Mu \type, int $rw) { $!compiler.generate_accessor( - $!current-match, $name, package_type, $attr_name, type, $rw); + $name, package_type, $attr_name, type, $rw); } method generate_buildplan_executor(Mu \obj, Mu \buildplan) { - $!compiler.generate_buildplan_executor( - $!current-match, obj, buildplan) + $!compiler.generate_buildplan_executor(obj, buildplan) } } From 22d3d933b39d688cffe62a0aff2f02c24f0106b9 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Fri, 29 Sep 2017 09:15:15 +0000 Subject: [PATCH 222/692] Revert "Deprecate Str.lines: :$count in 6.d" This reverts commit 01d4939c38dba9c98b76991cd59be9e438d42a76. https://irclog.perlgeek.de/perl6-dev/2017-09-29#i_15233995 --- src/core/Str.pm | 2 +- t/02-rakudo/v6.d-tests/01-deprecations.t | 4 +--- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/src/core/Str.pm b/src/core/Str.pm index d5078c000e3..f7492739d32 100644 --- a/src/core/Str.pm +++ b/src/core/Str.pm @@ -1297,7 +1297,7 @@ my class Str does Stringy { # declared in BOOTSTRAP proto method lines(|) { * } multi method lines(Str:D: :$count!) { - DEPRECATED '.lines.elems', '6.d', '6.e', :lang-vers; + # we should probably deprecate this feature $count ?? self.lines.elems !! self.lines; } multi method lines(Str:D: $limit) { diff --git a/t/02-rakudo/v6.d-tests/01-deprecations.t b/t/02-rakudo/v6.d-tests/01-deprecations.t index a039c967c15..1833788c04a 100644 --- a/t/02-rakudo/v6.d-tests/01-deprecations.t +++ b/t/02-rakudo/v6.d-tests/01-deprecations.t @@ -2,7 +2,7 @@ use lib ; use Test; use Test::Util; -plan 9; +plan 7; # XXX TODO: swap v6.d.PREVIEW to v6.d, once the latter is available constant $v6d = 'v6.d.PREVIEW'; @@ -35,8 +35,6 @@ is-newly-deprecated 「$ = 4.2.FatRat: 42」; is-newly-deprecated 「$ = FatRat.new(4,2).Rat: 42」; is-newly-deprecated 「$ = FatRat.new(4,2).FatRat: 42」; is-newly-deprecated 「".".IO.chdir: "."」; -is-newly-deprecated 「"".lines: :count」; -is-newly-deprecated 「"".lines: :!count」; subtest 'IO::Handle.slurp-rest' => { plan 2; From 8ed7adf1a689d7f1e10304979239ddc0e7e0ce2b Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Fri, 29 Sep 2017 09:16:23 +0000 Subject: [PATCH 223/692] Revert ""Remove" is_approx in 6.d" This reverts commit cd043f2ae4cb617eae89252de3263a49c54311f3. https://irclog.perlgeek.de/perl6-dev/2017-09-29#i_15233995 --- lib/Test.pm6 | 3 --- t/02-rakudo/v6.d-tests/01-deprecations.t | 9 +-------- 2 files changed, 1 insertion(+), 11 deletions(-) diff --git a/lib/Test.pm6 b/lib/Test.pm6 index 4bde5738ceb..6ba89e9f131 100644 --- a/lib/Test.pm6 +++ b/lib/Test.pm6 @@ -270,9 +270,6 @@ sub bail-out ($desc?) is export { multi sub is_approx(Mu $got, Mu $expected, $desc = '') is export { DEPRECATED('is-approx'); # Remove for 6.d release - $*PERL.version after v6.c - and die 'is_approx() has been removed as of v6.d. ' - ~ 'Please switch to is-approx()'; $time_after = nqp::time_n; my $tol = $expected.abs < 1e-6 ?? 1e-5 !! $expected.abs * 1e-6; diff --git a/t/02-rakudo/v6.d-tests/01-deprecations.t b/t/02-rakudo/v6.d-tests/01-deprecations.t index 1833788c04a..dfdb8315ac5 100644 --- a/t/02-rakudo/v6.d-tests/01-deprecations.t +++ b/t/02-rakudo/v6.d-tests/01-deprecations.t @@ -2,7 +2,7 @@ use lib ; use Test; use Test::Util; -plan 7; +plan 6; # XXX TODO: swap v6.d.PREVIEW to v6.d, once the latter is available constant $v6d = 'v6.d.PREVIEW'; @@ -42,10 +42,3 @@ subtest 'IO::Handle.slurp-rest' => { is-newly-deprecated "$file.IO.open.slurp-rest", '.slurp-rest'; is-newly-deprecated "$file.IO.open.slurp-rest: :bin", '.slurp-rest: :bin'; } - - -# Should be removed in 6.d, but I made it just die, at least for now, -# as I'm unsure how the removal is meant to happen, if we still wish -# to have it working in 6.c tests -is_run 'use \qq[$v6d]; use Test; try is_approx 1, 1; $! and say "test passed"', - {:out(/'test passed'/), :0status }, 'is_approx dies in v6.d'; From 68fdeff3b61f16eaa7ae9455cdd94d3a16289666 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Fri, 29 Sep 2017 09:18:22 +0000 Subject: [PATCH 224/692] Revert "[6.d] Deprecate IO::Handle.slurp-rest" This reverts commit 3341384bfe1341200a75ddc7ec869812cd58aeed. https://irclog.perlgeek.de/perl6-dev/2017-09-29#i_15233995 --- t/02-rakudo/v6.d-tests/01-deprecations.t | 9 +-------- 1 file changed, 1 insertion(+), 8 deletions(-) diff --git a/t/02-rakudo/v6.d-tests/01-deprecations.t b/t/02-rakudo/v6.d-tests/01-deprecations.t index dfdb8315ac5..b37b2f506a6 100644 --- a/t/02-rakudo/v6.d-tests/01-deprecations.t +++ b/t/02-rakudo/v6.d-tests/01-deprecations.t @@ -2,7 +2,7 @@ use lib ; use Test; use Test::Util; -plan 6; +plan 5; # XXX TODO: swap v6.d.PREVIEW to v6.d, once the latter is available constant $v6d = 'v6.d.PREVIEW'; @@ -35,10 +35,3 @@ is-newly-deprecated 「$ = 4.2.FatRat: 42」; is-newly-deprecated 「$ = FatRat.new(4,2).Rat: 42」; is-newly-deprecated 「$ = FatRat.new(4,2).FatRat: 42」; is-newly-deprecated 「".".IO.chdir: "."」; - -subtest 'IO::Handle.slurp-rest' => { - plan 2; - my $file := make-temp-file(:content).absolute.perl; - is-newly-deprecated "$file.IO.open.slurp-rest", '.slurp-rest'; - is-newly-deprecated "$file.IO.open.slurp-rest: :bin", '.slurp-rest: :bin'; -} From 142f772e3224c6fefe6685f4708baa8f337a4406 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Fri, 29 Sep 2017 09:19:22 +0000 Subject: [PATCH 225/692] Revert "[6.d] Deprecate IO::Handle.slurp-rest" This reverts commit 3341384bfe1341200a75ddc7ec869812cd58aeed. https://irclog.perlgeek.de/perl6-dev/2017-09-29#i_15233995 --- src/core/IO/Handle.pm | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/src/core/IO/Handle.pm b/src/core/IO/Handle.pm index 40bffae7958..debb60e8351 100644 --- a/src/core/IO/Handle.pm +++ b/src/core/IO/Handle.pm @@ -674,8 +674,9 @@ my class IO::Handle { proto method slurp-rest(|) { * } multi method slurp-rest(IO::Handle:D: :$bin! where *.so, :$close --> Buf:D) { - DEPRECATED '.slurp', '6.d', '6.e', :lang-vers; - + # NOTE: THIS METHOD WILL BE DEPRECATED IN 6.d in favour of .slurp() + # Testing of it in roast master has been removed and only kept in 6.c + # If you're changing this code for whatever reason, test with 6.c-errata LEAVE self.close if $close; my $res := buf8.new; loop { @@ -686,8 +687,9 @@ my class IO::Handle { } } multi method slurp-rest(IO::Handle:D: :$enc, :$bin, :$close --> Str:D) { - DEPRECATED '.slurp', '6.d', '6.e', :lang-vers; - + # NOTE: THIS METHOD WILL BE DEPRECATED IN 6.d in favour of .slurp() + # Testing of it in roast master has been removed and only kept in 6.c + # If you're changing this code for whatever reason, test with 6.c-errata $!decoder or die X::IO::BinaryMode.new(:trying); LEAVE self.close if $close; self.encoding($enc) if $enc.defined; From a65d5f922aeeff2c4dfd288f54a50a159f683aae Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Fri, 29 Sep 2017 09:21:28 +0000 Subject: [PATCH 226/692] Revert "[6.d] Deprecate IO::Path.chdir" This reverts commit 6d2adb20f2529e36e32b50936281ef3f11f078b0. https://irclog.perlgeek.de/perl6-dev/2017-09-29#i_15233995 Conflicts: t/02-rakudo/v6.d-tests/01-deprecations.t --- src/core/IO/Path.pm | 41 ++++++++++++++++++++++-- src/core/io_operators.pm | 32 ++---------------- t/02-rakudo/v6.d-tests/01-deprecations.t | 3 +- 3 files changed, 41 insertions(+), 35 deletions(-) diff --git a/src/core/IO/Path.pm b/src/core/IO/Path.pm index 8148dcae940..c1baace2df2 100644 --- a/src/core/IO/Path.pm +++ b/src/core/IO/Path.pm @@ -411,9 +411,44 @@ my class IO::Path is Cool does IO { multi method chdir( IO::Path:D: Str() $path is copy, :$d = True, :$r, :$w, :$x, ) { - DEPRECATED 'subroutine chdir()', '6.d', '6.e', :lang-vers; - temp $*CWD = self; - chdir $path + unless $!SPEC.is-absolute($path) { + my ($volume,$dirs) = $!SPEC.splitpath(self.absolute, :nofile); + my @dirs = $!SPEC.splitdir($dirs); + @dirs.shift; # the first is always empty for absolute dirs + for $!SPEC.splitdir($path) -> $dir { + if $dir eq '..' { + @dirs.pop if @dirs; + } + elsif $dir ne '.' { + @dirs.push: $dir; + } + } + @dirs.push('') if !@dirs; # need at least the rootdir + $path = join($!SPEC.dir-sep, $volume, @dirs); + } + my $dir = IO::Path!new-from-absolute-path($path,:$!SPEC,:CWD(self)); + + nqp::stmts( + nqp::unless( + nqp::unless(nqp::isfalse($d), $dir.d), + fail X::IO::Chdir.new: :$path, :os-error( + nqp::if($dir.e, 'is not a directory', 'does not exist') + ) + ), + nqp::unless( + nqp::unless(nqp::isfalse($r), $dir.r), + fail X::IO::Chdir.new: :$path, :os-error("did not pass :r test") + ), + nqp::unless( + nqp::unless(nqp::isfalse($w), $dir.w), + fail X::IO::Chdir.new: :$path, :os-error("did not pass :w test") + ), + nqp::unless( + nqp::unless(nqp::isfalse($x), $dir.x), + fail X::IO::Chdir.new: :$path, :os-error("did not pass :x test") + ), + $dir + ) } method rename(IO::Path:D: IO() $to, :$createonly --> True) { diff --git a/src/core/io_operators.pm b/src/core/io_operators.pm index 3817816c007..e1669f75d9d 100644 --- a/src/core/io_operators.pm +++ b/src/core/io_operators.pm @@ -130,36 +130,8 @@ multi sub spurt(IO() $path, |c) { $path.spurt(|c) } PROCESS::<&chdir> := &chdir; } -sub chdir(Str() $path is copy, :$d = True, :$r, :$w, :$x) { - my $CWD := $*CWD; - my $SPEC := $CWD.SPEC; - my $new-path := $path; - - unless $SPEC.is-absolute($path) { - my ($volume,$dirs) = $SPEC.splitpath: $CWD.absolute, :nofile; - my @dirs = $SPEC.splitdir: $dirs; - @dirs.shift; # the first is always empty for absolute dirs - for $SPEC.splitdir($path) -> $dir { - if $dir eq '..' { @dirs.pop if @dirs } - elsif $dir ne '.' { @dirs.push: $dir } - } - @dirs.push: '' if !@dirs; # need at least the rootdir - $path := join $SPEC.dir-sep, $volume, @dirs; - } - - my $dir := IO::Path.new: $path, :$SPEC, :$CWD; - - fail X::IO::Chdir.new: :$path, :os-error( - $dir.e ?? 'is not a directory' !! 'does not exist' - ) if $d and nqp::isfalse($dir.d); - fail X::IO::Chdir.new: :$path, :os-error("did not pass :r test") - if $r and nqp::isfalse($dir.r); - fail X::IO::Chdir.new: :$path, :os-error("did not pass :w test") - if $w and nqp::isfalse($dir.w); - fail X::IO::Chdir.new: :$path, :os-error("did not pass :x test") - if $x and nqp::isfalse($dir.x); - - $*CWD = $dir +sub chdir(|c) { + nqp::if(nqp::istype(($_ := $*CWD.chdir(|c)), Failure), $_, $*CWD = $_) } proto sub indir(|) {*} diff --git a/t/02-rakudo/v6.d-tests/01-deprecations.t b/t/02-rakudo/v6.d-tests/01-deprecations.t index b37b2f506a6..594fe2b8edc 100644 --- a/t/02-rakudo/v6.d-tests/01-deprecations.t +++ b/t/02-rakudo/v6.d-tests/01-deprecations.t @@ -2,7 +2,7 @@ use lib ; use Test; use Test::Util; -plan 5; +plan 4; # XXX TODO: swap v6.d.PREVIEW to v6.d, once the latter is available constant $v6d = 'v6.d.PREVIEW'; @@ -34,4 +34,3 @@ is-newly-deprecated 「$ = 4.2.Rat: 42」; is-newly-deprecated 「$ = 4.2.FatRat: 42」; is-newly-deprecated 「$ = FatRat.new(4,2).Rat: 42」; is-newly-deprecated 「$ = FatRat.new(4,2).FatRat: 42」; -is-newly-deprecated 「".".IO.chdir: "."」; From 44d5256cd2cbd6e26066d027a71a16c88bfc63e6 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Fri, 29 Sep 2017 09:22:42 +0000 Subject: [PATCH 227/692] =?UTF-8?q?Revert=20"Deprecate=20dummy=20arg=20on?= =?UTF-8?q?=20.Rat/.FatRat=E2=80=A6"?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This reverts commit 4c337e8ef9fa8a117761f5a74dc444a188471b71. Conflicts: t/02-rakudo/v6.d-tests/01-deprecations.t --- src/core/Int.pm | 14 +++-------- src/core/Rat.pm | 32 +++--------------------- t/02-rakudo/v6.d-tests/01-deprecations.t | 32 +----------------------- 3 files changed, 9 insertions(+), 69 deletions(-) diff --git a/src/core/Int.pm b/src/core/Int.pm index efa76374732..e08a093146f 100644 --- a/src/core/Int.pm +++ b/src/core/Int.pm @@ -48,17 +48,11 @@ my class Int does Real { # declared in BOOTSTRAP nqp::p6box_n(nqp::tonum_I(self)); } - proto method Rat(|) {*} - multi method Rat(Int:D:) { Rat.new(self, 1) } - multi method Rat(Int:D: $) { - DEPRECATED :lang-vers, '.Rat coercer without an argument', '6.d', '6.e'; - self.Rat + method Rat(Int:D: $?) { + Rat.new(self, 1); } - proto method FatRat(|) {*} - multi method FatRat(Int:D:) { FatRat.new(self, 1) } - multi method FatRat(Int:D: $) { - DEPRECATED :lang-vers, '.FatRat coercer without an argument', '6.d', '6.e'; - self.FatRat + method FatRat(Int:D: $?) { + FatRat.new(self, 1); } method abs(Int:D:) { diff --git a/src/core/Rat.pm b/src/core/Rat.pm index 47eb60f975b..f96ff0c1c44 100644 --- a/src/core/Rat.pm +++ b/src/core/Rat.pm @@ -1,19 +1,7 @@ # XXX: should be Rational[Int, UInt64] my class Rat is Cool does Rational[Int, Int] { - proto method Rat(|) {*} - multi method Rat(Rat:D: ) { self } - multi method Rat(Rat:D: Real) { - DEPRECATED :lang-vers, '.Rat coercer without an argument', '6.d', '6.e'; - self - } - - proto method FatRat(|) {*} - multi method FatRat(Rat:D:) { FatRat.new($!numerator, $!denominator); } - multi method FatRat(Rat:D: Real) { - DEPRECATED :lang-vers, '.FatRat coercer without an argument', '6.d', '6.e'; - self.FatRat - } - + method Rat (Rat:D: Real $?) { self } + method FatRat(Rat:D: Real $?) { FatRat.new($!numerator, $!denominator); } multi method perl(Rat:D:) { if $!denominator == 1 { $!numerator ~ '.0' @@ -36,24 +24,12 @@ my class Rat is Cool does Rational[Int, Int] { } my class FatRat is Cool does Rational[Int, Int] { - proto method FatRat(|) {*} - multi method FatRat(FatRat:D:) { self } - multi method FatRat(FatRat:D: Real) { - DEPRECATED :lang-vers, '.FatRat coercer without an argument', '6.d', '6.e'; - self - } - - proto method Rat(|) {*} - multi method Rat(FatRat:D:) { + method FatRat(FatRat:D: Real $?) { self } + method Rat (FatRat:D: Real $?) { $!denominator < $UINT64_UPPER ?? Rat.new($!numerator, $!denominator) !! Failure.new("Cannot convert from FatRat to Rat because denominator is too big") } - multi method Rat (FatRat:D: Real) { - DEPRECATED :lang-vers, '.Rat coercer without an argument', '6.d', '6.e'; - self.Rat - } - multi method perl(FatRat:D:) { "FatRat.new($!numerator, $!denominator)"; } diff --git a/t/02-rakudo/v6.d-tests/01-deprecations.t b/t/02-rakudo/v6.d-tests/01-deprecations.t index 594fe2b8edc..1685222597f 100644 --- a/t/02-rakudo/v6.d-tests/01-deprecations.t +++ b/t/02-rakudo/v6.d-tests/01-deprecations.t @@ -2,35 +2,5 @@ use lib ; use Test; use Test::Util; -plan 4; +plan 1; ok 'dummy'; -# XXX TODO: swap v6.d.PREVIEW to v6.d, once the latter is available -constant $v6d = 'v6.d.PREVIEW'; - -################### HELPER ROUTINES ################################### - -sub test-deprecation (Str:D $lang, Str:D $code, Bool :$is-visible) { - is_run ' - use \qq[$lang]; - %*ENV:delete; - \qq[$code] - ', { :out(''), :err($is-visible ?? /deprecated/ !! ''), :0status }, - ($is-visible ?? 'shows' !! 'no ') - ~ " deprecation message using $lang"; -} -sub is-deprecated (|c) { test-deprecation |c, :is-visible } -sub isn't-deprecated (|c) { test-deprecation |c } -sub is-newly-deprecated (Str:D $code, Str:D $desc = "with `$code`") { - subtest $desc => { - plan 2; - test-deprecation $v6d, $code, :is-visible; - test-deprecation 'v6.c', $code; - } -} - -###################################################################### - -is-newly-deprecated 「$ = 4.2.Rat: 42」; -is-newly-deprecated 「$ = 4.2.FatRat: 42」; -is-newly-deprecated 「$ = FatRat.new(4,2).Rat: 42」; -is-newly-deprecated 「$ = FatRat.new(4,2).FatRat: 42」; From d3c481854ec34626a731d4362f38a495ee3c1802 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Fri, 29 Sep 2017 11:45:11 +0200 Subject: [PATCH 228/692] Improve readability of BUILDALL autogenerating logic And perhaps a bit of streamlining, but I doubt that'd be noticeable. --- src/Perl6/World.nqp | 170 ++++++++++++++------------------------------ 1 file changed, 54 insertions(+), 116 deletions(-) diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index 5a3c5c41e1a..960eeab722b 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -3101,15 +3101,17 @@ class Perl6::World is HLL::World { # ) # ); + # We always need a self and the low level init hash + my $self := QAST::Var.new( :name, :scope ); + my $init := QAST::Var.new( :name, :scope ); + # my $init := nqp::getattr(%init,Map,'$!storage') - $stmts.push(QAST::Op.new( - :op('bind'), - (my $init := QAST::Var.new(:scope, :name)), - QAST::Op.new( - :op('getattr'), + $stmts.push(QAST::Op.new( :op, + $init, + QAST::Op.new( :op, QAST::Var.new( :scope, :name('%init') ), QAST::WVal.new( :value($!w.find_symbol(['Map'])) ), - QAST::SVal.new( :value('$!storage') ) + QAST::SVal.new( :value<$!storage> ) ) )); @@ -3123,54 +3125,40 @@ class Perl6::World is HLL::World { # Register the class in the SC if needed $!w.add_object_if_no_sc( nqp::atpos($task,1) ); - # Generate the WVal for setting the class object - my $classwval := - QAST::WVal.new( :value(nqp::atpos($task,1) ) ); + # We always need the class object and full attribute name + my $class := QAST::WVal.new( :value(nqp::atpos($task,1)) ); + my $attr := QAST::SVal.new( :value(nqp::atpos($task,2)) ); if nqp::atpos($task,0) -> $code { # 1,2,3 = initialize native from %init if $code < 4 { -# nqp::existskey($init,'a') - my $existskeyop := QAST::Op.new( :op('existskey'), - $init, - QAST::SVal.new( :value(nqp::atpos($task,3)) ) - ); - -# nqp::bindattr_x(self,Foo,'$!a',nqp::decont(%init.AT-KEY('a'))) - my $bindattrop := QAST::Op.new( - :op( 'bindattr' ~ @psp[$code] ), - QAST::Var.new( :name, :scope ), - $classwval, - QAST::SVal.new( :value(nqp::atpos($task,2)) ), - QAST::Op.new( :op, - QAST::Op.new( :op, - QAST::Var.new(:scope, :name('%init')), - QAST::SVal.new( :value ), - QAST::SVal.new( - :value(nqp::atpos($task,3)) ) - ) - ) - ); - # nqp::if( # nqp::existskey($init,'a'), # nqp::bindattr_x(self,Foo,'$!a',nqp::decont(%init.AT-KEY('a'))) # ), + my $key := + QAST::SVal.new(:value(nqp::atpos($task,3))); $stmts.push( - QAST::Op.new(:op,$existskeyop,$bindattrop) + QAST::Op.new(:op, + QAST::Op.new(:op, $init, $key), + QAST::Op.new(:op('bindattr' ~ @psp[$code]), + $self, $class, $attr, + QAST::Op.new( :op, + QAST::Op.new( :op, + QAST::Var.new(:scope,:name<%init>), + QAST::SVal.new( :value ), + $key + ) + ) + ) + ) ); } # 4 = set opaque with default if not set yet elsif $code == 4 { -# nqp::getattr(self,Foo,'$!a') - my $getattrop := QAST::Op.new( :op, - QAST::Var.new( :name, :scope ), - $classwval, - QAST::SVal.new( :value(nqp::atpos($task,2)) ) - ); # set assign operation to be used my $sigil := @@ -3183,14 +3171,13 @@ class Perl6::World is HLL::World { # (nqp::getattr(self,Foo,'$!a') = # $initializer(self,nqp::getattr(self,Foo,'$!a'))) # ), + my $getattrop := QAST::Op.new( :op, + $self, $class, $attr + ); $stmts.push( QAST::Op.new( :op, QAST::Op.new( :op, - QAST::Var.new(:name, :scope), - $classwval, - QAST::SVal.new( - :value(nqp::atpos($task,2)) - ) + $self, $class, $attr ), QAST::Op.new( :$op, $getattrop, @@ -3198,11 +3185,7 @@ class Perl6::World is HLL::World { QAST::WVal.new( :value(nqp::atpos($task,3)) ), - QAST::Var.new( - :name('self'), - :scope('local') - ), - $getattrop + $self, $getattrop ) ) ) @@ -3213,13 +3196,6 @@ class Perl6::World is HLL::World { # 5,6 = set native numeric with default if not set elsif $code < 7 { -# nqp::getattr_x(self,Foo,'$!a') - my $getattrop := QAST::Op.new( - :op('getattr' ~ @psp[$code - 4]), - QAST::Var.new( :name, :scope ), - $classwval, - QAST::SVal.new( :value(nqp::atpos($task,2)) ) - ); # nqp::if( # nqp::iseq_x( # nqp::getattr_x(self,Foo,'$!a'), @@ -3228,25 +3204,21 @@ class Perl6::World is HLL::World { # nqp::bindattr_x(self,Foo,'$!a', # $initializer(self,nqp::getattr_x(self,Foo,'$!a'))) # ), + my $getattrop := QAST::Op.new( + :op('getattr' ~ @psp[$code - 4]), + $self, $class, $attr + ); $stmts.push( QAST::Op.new( :op, - QAST::Op.new( - :op('iseq' ~ @psp[$code - 4]), + QAST::Op.new( :op('iseq' ~ @psp[$code - 4]), $getattrop, @psd[$code - 4], ), - QAST::Op.new( - :op('bindattr' ~ @psp[$code - 4]), - QAST::Var.new(:name, :scope), - $classwval, - QAST::SVal.new(:value(nqp::atpos($task,2))), + QAST::Op.new( :op('bindattr' ~ @psp[$code - 4]), + $self, $class, $attr, QAST::Op.new( :op, - QAST::WVal.new(:value(nqp::atpos($task,3)) - ), - QAST::Var.new( - :name('self'), - :scope('local') - ), + QAST::WVal.new(:value(nqp::atpos($task,3))), + $self, $getattrop ) ) @@ -3258,31 +3230,22 @@ class Perl6::World is HLL::World { # 7 = set native string with default if not set elsif $code == 7 { -# nqp::getattr_s(self,Foo,'$!a') - my $getattrop := QAST::Op.new( :op, - QAST::Var.new( :name, :scope ), - $classwval, - QAST::SVal.new( :value(nqp::atpos($task,2)) ) - ); - # nqp::if( # nqp::isnull_s(nqp::getattr_s(self,Foo,'$!a')), # nqp::bindattr_s(self,Foo,'$!a', # $initializer(self,nqp::getattr_s(self,Foo,'$!a'))) # ), + my $getattrop := QAST::Op.new( :op, + $self, $class, $attr + ); $stmts.push( QAST::Op.new( :op, QAST::Op.new( :op, $getattrop), QAST::Op.new( :op, - QAST::Var.new(:name, :scope), - $classwval, - QAST::SVal.new(:value(nqp::atpos($task,2))), + $self, $class, $attr, QAST::Op.new( :op, QAST::WVal.new(:value(nqp::atpos($task,3))), - QAST::Var.new( - :name('self'), - :scope('local') - ), + $self, $getattrop ) ) @@ -3294,12 +3257,6 @@ class Perl6::World is HLL::World { # 8 = bail if opaque not yet initialized elsif $code == 8 { -# nqp::getattr(self,Foo,'$!a') - my $getattrop := QAST::Op.new( :op, - QAST::Var.new( :name, :scope ), - $classwval, - QAST::SVal.new( :value(nqp::atpos($task,2)) ) - ); # nqp::unless( # nqp::attrinited(self,Foo,'$!a'), @@ -3308,9 +3265,7 @@ class Perl6::World is HLL::World { $stmts.push( QAST::Op.new( :op, QAST::Op.new( :op, - QAST::Var.new(:name, :scope), - $classwval, - QAST::SVal.new(:value(nqp::atpos($task,2))) + $self, $class, $attr ), QAST::Op.new( :op, QAST::Op.new( :op, @@ -3339,9 +3294,7 @@ class Perl6::World is HLL::World { # nqp::bindattr(self,Foo,'$!a',$initializer()) $stmts.push( QAST::Op.new( :op, - QAST::Var.new(:name, :scope), - $classwval, - QAST::SVal.new(:value(nqp::atpos($task,2))), + $self, $class, $attr, QAST::Op.new( :op, QAST::WVal.new(:value(nqp::atpos($task,3))) ) @@ -3359,19 +3312,6 @@ class Perl6::World is HLL::World { # 0 = initialize opaque from %init else { -# nqp::existskey($init,'a') - my $existskeyop := QAST::Op.new( :op('existskey'), - $init, - QAST::SVal.new( :value(nqp::atpos($task,3)) ) - ); - -# nqp::getattr(self,Foo,'$!a') - my $getattrop := QAST::Op.new( :op, - QAST::Var.new( :name, :scope ), - $classwval, - QAST::SVal.new( :value( nqp::atpos($task,2) ) ) - ); - # set assign operation to be used my $sigil := nqp::substr(nqp::atpos($task,2),0,1); @@ -3382,15 +3322,16 @@ class Perl6::World is HLL::World { # nqp::existskey($init,'a'), # nqp::getattr(self,Foo,'$!a') = %init.AT-KEY('a') # ), + my $key := QAST::SVal.new(:value(nqp::atpos($task,3))); $stmts.push( QAST::Op.new( :op, - $existskeyop, + QAST::Op.new(:op('existskey'), $init, $key), QAST::Op.new( :$op, - $getattrop, + QAST::Op.new(:op, $self, $class, $attr), QAST::Op.new( :op, QAST::Var.new(:scope,:name('%init')), QAST::SVal.new(:value), - QAST::SVal.new(:value(nqp::atpos($task,3))) + $key ) ) ) @@ -3432,10 +3373,7 @@ class Perl6::World is HLL::World { QAST::Op.new( :op, $init ), QAST::Op.new( :op, QAST::WVal.new( :value($task) ), - QAST::Var.new( - :name('self'), - :scope('local') - ), + $self, QAST::Var.new( :scope, :name, # use nqp::hash directly @@ -3445,7 +3383,7 @@ class Perl6::World is HLL::World { ), QAST::Op.new( :op, QAST::WVal.new( :value($task) ), - QAST::Var.new(:name('self'),:scope('local')) + $self, ) ) ), @@ -3467,7 +3405,7 @@ class Perl6::World is HLL::World { } # Finally, add the return value - $stmts.push(QAST::Var.new(:name('self'), :scope('local'))); + $stmts.push($self); # Need to wrap an exception handler around if $needs_wrapping { From 371befe8f7aad5a4342eca2ee8ef7e0eabae548f Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Fri, 29 Sep 2017 13:11:41 +0200 Subject: [PATCH 229/692] Give @/% attributes optimized handling - instead of having to go through p6store, which then does a .STORE - we call .STORE directly - This makes them a few percent faster --- src/Perl6/World.nqp | 137 ++++++++++++++++++++++++++++---------------- 1 file changed, 88 insertions(+), 49 deletions(-) diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index 960eeab722b..c33b8d78d0e 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -3160,36 +3160,51 @@ class Perl6::World is HLL::World { # 4 = set opaque with default if not set yet elsif $code == 4 { - # set assign operation to be used - my $sigil := - nqp::substr(nqp::atpos($task,2),0,1); - my $op := $sigil eq '$' || $sigil eq '&' - ?? 'assign' - !! 'p6store'; # nqp::unless( # nqp::attrinited(self,Foo,'$!a'), -# (nqp::getattr(self,Foo,'$!a') = -# $initializer(self,nqp::getattr(self,Foo,'$!a'))) -# ), - my $getattrop := QAST::Op.new( :op, - $self, $class, $attr - ); - $stmts.push( - QAST::Op.new( :op, + my $unless := QAST::Op.new( :op, QAST::Op.new( :op, $self, $class, $attr - ), - QAST::Op.new( :$op, - $getattrop, - QAST::Op.new( :op, - QAST::WVal.new( - :value(nqp::atpos($task,3)) + ) + ); + +# nqp::getattr(self,Foo,'$!a') + my $getattr := QAST::Op.new( :op, + $self, $class, $attr + ); + +# $code(self,nqp::getattr(self,Foo,'$!a'))) + my $initializer := QAST::Op.new( :op, + QAST::WVal.new(:value(nqp::atpos($task,3))), + $self, $getattr + ); + + my $sigil := nqp::substr(nqp::atpos($task,2),0,1); +# nqp::getattr(self,Foo,'$!a').STORE($code(self,nqp::getattr(self,Foo,'$!a'))) + if $sigil eq '@' || $sigil eq '%' { + $unless.push( + QAST::Op.new( :op, + $getattr, + QAST::SVal.new( :value ), + $initializer + ) + ); + } + + else { +# (nqp::getattr(self,Foo,'$!a') = $code(self,nqp::getattr(self,Foo,'$!a'))) + $unless.push( + QAST::Op.new( + :op( $sigil eq '$' || $sigil eq '&' + ?? 'assign' !! 'p6store' ), - $self, $getattrop + $getattr, $initializer ) ) - ) - ); + } + +# ), + $stmts.push($unless); $!w.add_object_if_no_sc(nqp::atpos($task,3)); } @@ -3204,14 +3219,14 @@ class Perl6::World is HLL::World { # nqp::bindattr_x(self,Foo,'$!a', # $initializer(self,nqp::getattr_x(self,Foo,'$!a'))) # ), - my $getattrop := QAST::Op.new( + my $getattr := QAST::Op.new( :op('getattr' ~ @psp[$code - 4]), $self, $class, $attr ); $stmts.push( QAST::Op.new( :op, QAST::Op.new( :op('iseq' ~ @psp[$code - 4]), - $getattrop, + $getattr, @psd[$code - 4], ), QAST::Op.new( :op('bindattr' ~ @psp[$code - 4]), @@ -3219,7 +3234,7 @@ class Perl6::World is HLL::World { QAST::Op.new( :op, QAST::WVal.new(:value(nqp::atpos($task,3))), $self, - $getattrop + $getattr ) ) ) @@ -3235,18 +3250,18 @@ class Perl6::World is HLL::World { # nqp::bindattr_s(self,Foo,'$!a', # $initializer(self,nqp::getattr_s(self,Foo,'$!a'))) # ), - my $getattrop := QAST::Op.new( :op, + my $getattr := QAST::Op.new( :op, $self, $class, $attr ); $stmts.push( QAST::Op.new( :op, - QAST::Op.new( :op, $getattrop), + QAST::Op.new( :op, $getattr), QAST::Op.new( :op, $self, $class, $attr, QAST::Op.new( :op, QAST::WVal.new(:value(nqp::atpos($task,3))), $self, - $getattrop + $getattr ) ) ) @@ -3312,30 +3327,54 @@ class Perl6::World is HLL::World { # 0 = initialize opaque from %init else { - # set assign operation to be used - my $sigil := - nqp::substr(nqp::atpos($task,2),0,1); - my $op := $sigil eq '$' || $sigil eq '&' - ?? 'assign' - !! 'p6store'; +# 'a' + my $key := QAST::SVal.new(:value(nqp::atpos($task,3))); + +# nqp::getattr(self,Foo,'$!a') + my $getattr := QAST::Op.new( :op, + $self, $class, $attr + ); + # nqp::if( # nqp::existskey($init,'a'), -# nqp::getattr(self,Foo,'$!a') = %init.AT-KEY('a') -# ), - my $key := QAST::SVal.new(:value(nqp::atpos($task,3))); - $stmts.push( - QAST::Op.new( :op, - QAST::Op.new(:op('existskey'), $init, $key), - QAST::Op.new( :$op, - QAST::Op.new(:op, $self, $class, $attr), + my $if := QAST::Op.new( :op, + QAST::Op.new( :op, $init, $key) + ); + +# %init.AT-KEY('a') + my $value := QAST::Op.new( :op, + QAST::Var.new( :name<%init>, :scope ), + QAST::SVal.new( :value ), + $key + ); + + my $sigil := nqp::substr(nqp::atpos($task,2),0,1); + +# nqp::getattr(self,Foo,'$!a').STORE(%init.AT-KEY('a')) + if $sigil eq '@' || $sigil eq '%' { + $if.push( QAST::Op.new( :op, - QAST::Var.new(:scope,:name('%init')), - QAST::SVal.new(:value), - $key + $getattr, + QAST::SVal.new( :value ), + $value ) - ) - ) - ); + ); + } + +# nqp::getattr(self,Foo,'$!a') = %init.AT-KEY('a') + else { + $if.push( + QAST::Op.new( + :op( $sigil eq '$' || $sigil eq '&' + ?? 'assign' !! 'p6store' + ), + $getattr, $value + ) + ); + } + +# ), + $stmts.push($if); } } From 9d4a833b832278bd4a8aedbfc5dea7a89a3c86c0 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Fri, 29 Sep 2017 14:35:08 +0200 Subject: [PATCH 230/692] Take all constant SVal values out of the loop Should help a bit with CPU and memory pressure of compilation. --- src/Perl6/World.nqp | 34 ++++++++++++++++++---------------- 1 file changed, 18 insertions(+), 16 deletions(-) diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index c33b8d78d0e..30ce57f752d 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -3028,6 +3028,17 @@ class Perl6::World is HLL::World { nqp::hash('variable_name','%init') ]); + # We always need a self and the low level init hash + my $self := QAST::Var.new( :name, :scope ); + my $init := QAST::Var.new( :name, :scope ); + + # String values we always need + my $storage := QAST::SVal.new( :value<$!storage> ); + my $AT-KEY := QAST::SVal.new( :value ); + my $STORE := QAST::SVal.new( :value ); + my $new := QAST::SVal.new( :value ); + my $throw := QAST::SVal.new( :value ); + # Generate a method for building a new object that takes a hash # with attribute => value pairs to be assigned to the object's # attributes. Basically a flattened version of Mu.BUILDALL, which @@ -3101,17 +3112,13 @@ class Perl6::World is HLL::World { # ) # ); - # We always need a self and the low level init hash - my $self := QAST::Var.new( :name, :scope ); - my $init := QAST::Var.new( :name, :scope ); - # my $init := nqp::getattr(%init,Map,'$!storage') $stmts.push(QAST::Op.new( :op, $init, QAST::Op.new( :op, QAST::Var.new( :scope, :name('%init') ), QAST::WVal.new( :value($!w.find_symbol(['Map'])) ), - QAST::SVal.new( :value<$!storage> ) + $storage ) )); @@ -3148,7 +3155,7 @@ class Perl6::World is HLL::World { QAST::Op.new( :op, QAST::Op.new( :op, QAST::Var.new(:scope,:name<%init>), - QAST::SVal.new( :value ), + $AT-KEY, $key ) ) @@ -3184,9 +3191,7 @@ class Perl6::World is HLL::World { if $sigil eq '@' || $sigil eq '%' { $unless.push( QAST::Op.new( :op, - $getattr, - QAST::SVal.new( :value ), - $initializer + $getattr, $STORE, $initializer ) ); } @@ -3289,7 +3294,7 @@ class Perl6::World is HLL::World { ['X','Attribute','Required'] ) )), - QAST::SVal.new( :value ), + $new, QAST::SVal.new( :named('name'), :value(nqp::atpos($task,2)) ), @@ -3297,7 +3302,7 @@ class Perl6::World is HLL::World { :value(nqp::atpos($task,3)) ) ), - QAST::SVal.new( :value ), + $throw ) ) ); @@ -3344,8 +3349,7 @@ class Perl6::World is HLL::World { # %init.AT-KEY('a') my $value := QAST::Op.new( :op, QAST::Var.new( :name<%init>, :scope ), - QAST::SVal.new( :value ), - $key + $AT-KEY, $key ); my $sigil := nqp::substr(nqp::atpos($task,2),0,1); @@ -3354,9 +3358,7 @@ class Perl6::World is HLL::World { if $sigil eq '@' || $sigil eq '%' { $if.push( QAST::Op.new( :op, - $getattr, - QAST::SVal.new( :value ), - $value + $getattr, $STORE, $value ) ); } From 6902c59042715e7246c0e39ccac4f34f83c2c287 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Fri, 29 Sep 2017 14:50:44 +0200 Subject: [PATCH 231/692] Turns out callmethod also takes a :name So we don't need these SVals after all. --- src/Perl6/World.nqp | 27 ++++++++++----------------- 1 file changed, 10 insertions(+), 17 deletions(-) diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index 30ce57f752d..b22db5babe4 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -3034,10 +3034,6 @@ class Perl6::World is HLL::World { # String values we always need my $storage := QAST::SVal.new( :value<$!storage> ); - my $AT-KEY := QAST::SVal.new( :value ); - my $STORE := QAST::SVal.new( :value ); - my $new := QAST::SVal.new( :value ); - my $throw := QAST::SVal.new( :value ); # Generate a method for building a new object that takes a hash # with attribute => value pairs to be assigned to the object's @@ -3153,9 +3149,8 @@ class Perl6::World is HLL::World { QAST::Op.new(:op('bindattr' ~ @psp[$code]), $self, $class, $attr, QAST::Op.new( :op, - QAST::Op.new( :op, + QAST::Op.new(:op, :name, QAST::Var.new(:scope,:name<%init>), - $AT-KEY, $key ) ) @@ -3190,8 +3185,8 @@ class Perl6::World is HLL::World { # nqp::getattr(self,Foo,'$!a').STORE($code(self,nqp::getattr(self,Foo,'$!a'))) if $sigil eq '@' || $sigil eq '%' { $unless.push( - QAST::Op.new( :op, - $getattr, $STORE, $initializer + QAST::Op.new( :op, :name, + $getattr, $initializer ) ); } @@ -3287,22 +3282,20 @@ class Perl6::World is HLL::World { QAST::Op.new( :op, $self, $class, $attr ), - QAST::Op.new( :op, - QAST::Op.new( :op, + QAST::Op.new( :op, :name, + QAST::Op.new( :op, :name, QAST::WVal.new( :value( $!w.find_symbol( ['X','Attribute','Required'] ) )), - $new, QAST::SVal.new( :named('name'), :value(nqp::atpos($task,2)) ), QAST::WVal.new( :named('why'), :value(nqp::atpos($task,3)) ) - ), - $throw + ) ) ) ); @@ -3347,9 +3340,9 @@ class Perl6::World is HLL::World { ); # %init.AT-KEY('a') - my $value := QAST::Op.new( :op, + my $value := QAST::Op.new(:op,:name, QAST::Var.new( :name<%init>, :scope ), - $AT-KEY, $key + $key ); my $sigil := nqp::substr(nqp::atpos($task,2),0,1); @@ -3357,8 +3350,8 @@ class Perl6::World is HLL::World { # nqp::getattr(self,Foo,'$!a').STORE(%init.AT-KEY('a')) if $sigil eq '@' || $sigil eq '%' { $if.push( - QAST::Op.new( :op, - $getattr, $STORE, $value + QAST::Op.new( :op, :name, + $getattr, $value ) ); } From fb4eb666b0b521e1df8a3b3a21e07b79e70b1b17 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Fri, 29 Sep 2017 20:09:23 +0200 Subject: [PATCH 232/692] Takes some more constant QAST out of the loop --- src/Perl6/World.nqp | 44 +++++++++++++++++++++----------------------- 1 file changed, 21 insertions(+), 23 deletions(-) diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index b22db5babe4..757bdd9b783 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -3028,9 +3028,20 @@ class Perl6::World is HLL::World { nqp::hash('variable_name','%init') ]); - # We always need a self and the low level init hash - my $self := QAST::Var.new( :name, :scope ); - my $init := QAST::Var.new( :name, :scope ); + # Parameters we always need + my $pself := QAST::Var.new(:decl, :scope, :name); + my $pauto := QAST::Var.new(:decl, :scope, :name<@auto>); + my $pinit := QAST::Var.new(:decl, :scope, :name<%init>); + + # Declarations we always need + my $dinit := QAST::Var.new(:decl, :scope, :name); + my $dreturn := QAST::Var.new(:decl, :scope, :name); + + # References to variables we always need + my $self := QAST::Var.new( :scope, :name ); + my $init := QAST::Var.new( :scope, :name ); + my $hllinit := QAST::Var.new( :scope, :name<%init> ); + my $return := QAST::Var.new( :scope, :name ); # String values we always need my $storage := QAST::SVal.new( :value<$!storage> ); @@ -3068,12 +3079,7 @@ class Perl6::World is HLL::World { # filled in later my $stmts := QAST::Stmts.new(); - my $declarations := QAST::Stmts.new( - QAST::Var.new(:decl, :scope, :name), - QAST::Var.new(:decl, :scope, :name('@auto')), - QAST::Var.new(:decl, :scope, :name('%init')), - QAST::Var.new(:decl, :scope, :name) - ); + my $declarations := QAST::Stmts.new($pself, $pauto, $pinit, $dinit); # The block of the method my $block := QAST::Block.new( @@ -3101,10 +3107,7 @@ class Perl6::World is HLL::World { # ); # $stmts.push( # QAST::Op.new( :op, -# QAST::Op.new( :op, -# QAST::Var.new( :scope, :name('%init') ), -# QAST::SVal.new( :value ) -# ) +# QAST::Op.new( :op, :name, $hllinit ) # ) # ); @@ -3112,7 +3115,7 @@ class Perl6::World is HLL::World { $stmts.push(QAST::Op.new( :op, $init, QAST::Op.new( :op, - QAST::Var.new( :scope, :name('%init') ), + $hllinit, QAST::WVal.new( :value($!w.find_symbol(['Map'])) ), $storage ) @@ -3150,8 +3153,7 @@ class Perl6::World is HLL::World { $self, $class, $attr, QAST::Op.new( :op, QAST::Op.new(:op, :name, - QAST::Var.new(:scope,:name<%init>), - $key + $hllinit, $key ) ) ) @@ -3341,8 +3343,7 @@ class Perl6::World is HLL::World { # %init.AT-KEY('a') my $value := QAST::Op.new(:op,:name, - QAST::Var.new( :name<%init>, :scope ), - $key + $hllinit, $key ); my $sigil := nqp::substr(nqp::atpos($task,2),0,1); @@ -3380,10 +3381,7 @@ class Perl6::World is HLL::World { unless $needs_wrapping { # (my $return), - $declarations.push( - QAST::Var.new( - :decl, :scope, :name) - ); + $declarations.push($dreturn); $needs_wrapping := 1 }; @@ -3402,7 +3400,7 @@ class Perl6::World is HLL::World { QAST::Op.new( :op, QAST::Op.new( :op, QAST::Op.new( :op, - QAST::Var.new(:scope, :name), + $return, QAST::Op.new( :op, QAST::Op.new( :op, $init ), QAST::Op.new( :op, From b9c98531c57715642de83492b0209b2667d91e5f Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sat, 30 Sep 2017 01:11:42 +0200 Subject: [PATCH 233/692] Take some more static QAST out of the loop - now also for the accessor generator logic - reformat code and add comments for better maintainability --- src/Perl6/World.nqp | 119 ++++++++++++++++++++++++++------------------ 1 file changed, 70 insertions(+), 49 deletions(-) diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index 757bdd9b783..563d9026627 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -2968,50 +2968,92 @@ class Perl6::World is HLL::World { has $!acc_sig_cache; has $!acc_sig_cache_type; - method generate_accessor(str $meth_name, $package_type, str $attr_name, $type, int $rw) { - my $native := nqp::objprimspec($type) != 0; - my $acc := QAST::Var.new( - :scope($native && $rw ?? 'attributeref' !! 'attribute'), - :name($attr_name), :returns($type), - QAST::Op.new( - :op('decont'), - QAST::Var.new( :name('self'), :scope('local') ) - ), - QAST::WVal.new( :value($package_type) ) + # Parameters we always need + my $pself := QAST::Var.new(:decl, :scope, :name); + my $pauto := QAST::Var.new(:decl, :scope, :name<@auto>); + my $pinit := QAST::Var.new(:decl, :scope, :name<%init>); + my $p_ := QAST::Var.new(:decl, :scope, :name('_'), + :slurpy, :named); + + # Declarations we always need + my $dinit := QAST::Var.new(:decl, :scope, :name); + my $dreturn := QAST::Var.new(:decl, :scope, :name); + + # References to variables we always need + my $self := QAST::Var.new( :scope, :name ); + my $init := QAST::Var.new( :scope, :name ); + my $hllinit := QAST::Var.new( :scope, :name<%init> ); + my $return := QAST::Var.new( :scope, :name ); + + # String values we always need + my $storage := QAST::SVal.new( :value<$!storage> ); + + # signature configuration hashes + my %sig_empty := nqp::hash('parameters', []); # :() + my %sig_init := nqp::hash( + 'parameters', [nqp::hash('variable_name','%init')] + ); + + # Generate an accessor method with the given method name, package, + # attribute name, type of attribute and rw flag. Returns a code + # object that can be installed as a method. + method generate_accessor( + str $meth_name, $package_type, str $attr_name, $type, int $rw + ) { + + # Is it a native attribute? (primpspec != 0) + my $native := nqp::objprimspec($type); + + # Set up the actual statements, starting with "self" +# nqp::attribute(self,$package_type,$attr_name) + my $stmts := QAST::Var.new( + :scope($native && $rw ?? 'attributeref' !! 'attribute'), + :name($attr_name), + :returns($type), + QAST::Op.new( :op, $self ), + QAST::WVal.new( :value($package_type) ) ); + + # Opaque and read-only accessors need a decont unless $native || $rw { - $acc := QAST::Op.new( :op('decont'), $acc ); + $stmts := QAST::Op.new( :op, $stmts ); } + + # Create the block my $block := QAST::Block.new( - :name($meth_name), :blocktype('declaration_static'), - QAST::Stmts.new( - QAST::Var.new( - :decl('param'), :scope('local'), :name('self') - ), - QAST::Var.new( - :decl('param'), :scope('local'), :name('_'), :slurpy, :named - ) - ), - QAST::Stmts.new($acc)); + :name($meth_name), + :blocktype('declaration_static'), + QAST::Stmts.new( $pself, $p_ ), + QAST::Stmts.new($stmts) + ); + + # Make sure the block has a SC $!w.cur_lexpad()[0].push($block); + # Find/Create the type of the invocant + my $invocant_type := $!w.create_definite_type( + $!w.find_symbol(['Metamodel','DefiniteHOW']), $package_type, 1 ); + + # Seen accessors of this class before, so use existing signature my $sig; - my $invocant_type := - $!w.create_definite_type( $!w.find_symbol(['Metamodel','DefiniteHOW']), $package_type, 1 ); if $invocant_type =:= $!acc_sig_cache_type { $sig := $!acc_sig_cache; } + + # First time, create new signature and mark it cached else { - my %sig_info := nqp::hash('parameters', []); - $sig := $!w.create_signature_and_params(NQPMu, %sig_info, - $block, 'Any', :method, :$invocant_type); - $!acc_sig_cache := $sig; + $sig := $!w.create_signature_and_params( + NQPMu, %sig_empty, $block, 'Any', :method, :$invocant_type); + $!acc_sig_cache := $sig; $!acc_sig_cache_type := $invocant_type; } + # Create a code object of the block, make sure we can write if ok my $code := $!w.create_code_object($block, 'Method', $sig); $code.set_rw() if $rw; - return $code; + + # That's it + $code } # Mapping of primspec to attribute postfix @@ -3024,27 +3066,6 @@ class Perl6::World is HLL::World { ); # signature configuration hash for ":(%init)" - my %sig_init := nqp::hash('parameters', [ - nqp::hash('variable_name','%init') - ]); - - # Parameters we always need - my $pself := QAST::Var.new(:decl, :scope, :name); - my $pauto := QAST::Var.new(:decl, :scope, :name<@auto>); - my $pinit := QAST::Var.new(:decl, :scope, :name<%init>); - - # Declarations we always need - my $dinit := QAST::Var.new(:decl, :scope, :name); - my $dreturn := QAST::Var.new(:decl, :scope, :name); - - # References to variables we always need - my $self := QAST::Var.new( :scope, :name ); - my $init := QAST::Var.new( :scope, :name ); - my $hllinit := QAST::Var.new( :scope, :name<%init> ); - my $return := QAST::Var.new( :scope, :name ); - - # String values we always need - my $storage := QAST::SVal.new( :value<$!storage> ); # Generate a method for building a new object that takes a hash # with attribute => value pairs to be assigned to the object's From 415e9adb96df1dd6c29583777c3fac57e2508925 Mon Sep 17 00:00:00 2001 From: Tom Browder Date: Fri, 29 Sep 2017 20:17:24 -0500 Subject: [PATCH 234/692] changes for Texas => ASCII --- src/core/set_addition.pm | 2 +- src/core/set_difference.pm | 2 +- src/core/set_elem.pm | 4 ++-- src/core/set_intersection.pm | 2 +- src/core/set_multiply.pm | 2 +- src/core/set_precedes.pm | 4 ++-- src/core/set_proper_subset.pm | 4 ++-- src/core/set_subset.pm | 4 ++-- src/core/set_union.pm | 2 +- 9 files changed, 13 insertions(+), 13 deletions(-) diff --git a/src/core/set_addition.pm b/src/core/set_addition.pm index 2ec24601d44..d597fe781c2 100644 --- a/src/core/set_addition.pm +++ b/src/core/set_addition.pm @@ -1,5 +1,5 @@ # This file implements the following set operators: -# (+) baggy addition (Texas) +# (+) baggy addition (ASCII) # ⊎ baggy addition proto sub infix:<(+)>(|) is pure { * } diff --git a/src/core/set_difference.pm b/src/core/set_difference.pm index 88998a2cd48..76ed6dd8c1a 100644 --- a/src/core/set_difference.pm +++ b/src/core/set_difference.pm @@ -1,5 +1,5 @@ # This file implements the following set operators: -# (-) set difference (Texas) +# (-) set difference (ASCII) # ∖ set difference proto sub infix:<(-)>(|) is pure { * } diff --git a/src/core/set_elem.pm b/src/core/set_elem.pm index 1225f4ebbb9..8f99f53de95 100644 --- a/src/core/set_elem.pm +++ b/src/core/set_elem.pm @@ -1,8 +1,8 @@ # This file implements the following set operators: -# (elem) is an element of (Texas) +# (elem) is an element of (ASCII) # ∈ is an element of # ∉ is NOT an element of -# (cont) contains (Texas) +# (cont) contains (ASCII) # ∋ contains # ∌ does NOT contain diff --git a/src/core/set_intersection.pm b/src/core/set_intersection.pm index 2619c7b8a49..d95d8a30967 100644 --- a/src/core/set_intersection.pm +++ b/src/core/set_intersection.pm @@ -1,5 +1,5 @@ # This file implements the following set operators: -# (&) intersection (Texas) +# (&) intersection (ASCII) # ∩ intersection proto sub infix:<(&)>(|) is pure { * } diff --git a/src/core/set_multiply.pm b/src/core/set_multiply.pm index 3eba6c1f3ea..8b0ec16b973 100644 --- a/src/core/set_multiply.pm +++ b/src/core/set_multiply.pm @@ -1,5 +1,5 @@ # This file implements the following set operators: -# (.) set multiplication (Texas) +# (.) set multiplication (ASCII) # ⊍ set multiplication proto sub infix:<(.)>(|) is pure { * } diff --git a/src/core/set_precedes.pm b/src/core/set_precedes.pm index a2c5c017c18..c3df6282a18 100644 --- a/src/core/set_precedes.pm +++ b/src/core/set_precedes.pm @@ -1,7 +1,7 @@ # This file implements the following set operators: -# (<+) precedes (Texas) +# (<+) precedes (ASCII) # ≼ precedes -# (>+) succeeds (Texas) +# (>+) succeeds (ASCII) # ≽ succeeds proto sub infix:<<(<+)>>($, $ --> Bool:D) is pure { diff --git a/src/core/set_proper_subset.pm b/src/core/set_proper_subset.pm index bd845b61897..d466aee3e33 100644 --- a/src/core/set_proper_subset.pm +++ b/src/core/set_proper_subset.pm @@ -1,8 +1,8 @@ # This file implements the following set operators: -# (<) is a proper subset of (Texas) +# (<) is a proper subset of (ASCII) # ⊂ is a proper subset of # ⊄ is NOT a proper subset of -# (>) is a proper superset of (Texas) +# (>) is a proper superset of (ASCII) # ⊃ is a proper superset of # ⊅ is NOT a proper superset of diff --git a/src/core/set_subset.pm b/src/core/set_subset.pm index 225dd458c0c..f608d73a8ab 100644 --- a/src/core/set_subset.pm +++ b/src/core/set_subset.pm @@ -1,8 +1,8 @@ # This file implements the following set operators: -# (<=) is a subset of (Texas) +# (<=) is a subset of (ASCII) # ⊆ is a subset of # ⊈ is NOT a subset of -# (>=) is a superset of (Texas) +# (>=) is a superset of (ASCII) # ⊇ is a superset of # ⊉ is NOT a superset of diff --git a/src/core/set_union.pm b/src/core/set_union.pm index 44d37ea2e01..6984587c24e 100644 --- a/src/core/set_union.pm +++ b/src/core/set_union.pm @@ -1,5 +1,5 @@ # This file implements the following set operators: -# (|) union (Texas) +# (|) union (ASCII) # ∪ union proto sub infix:<(|)>(|) is pure { * } From 41896b7bbf9fe5abc2eed64db6f1013bb2f4482e Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 30 Sep 2017 11:20:48 -0400 Subject: [PATCH 235/692] Fix .push-all/.skip-all on SlippyIterators Fixes RT#132109: https://rt.perl.org/Ticket/Display.html?id=132109 The implemented methods forget to check whether we're currently $!slipping, which causes loss of all the remaining elements in the currently slipping Slip. Fix by add ing a check for $!slipping and doing self.skip-one and pushing (or skipping) those values before we go into the main loop of pulling more from the source iterator. --- src/core/Any-iterable-methods.pm | 251 +++++++++++++++++++------------ 1 file changed, 153 insertions(+), 98 deletions(-) diff --git a/src/core/Any-iterable-methods.pm b/src/core/Any-iterable-methods.pm index 138f3b82974..2958526eb90 100644 --- a/src/core/Any-iterable-methods.pm +++ b/src/core/Any-iterable-methods.pm @@ -159,6 +159,15 @@ Did you mean to add a stub (\{...\}) or did you mean to .classify?" my int $done; my $pulled; my $value; + + nqp::if( + $!slipping, + nqp::until( + nqp::eqaddr(($value := self.slip-one),IterationEnd), + $target.push($value) + ) + ); + until $done || nqp::eqaddr(($value := $!source.pull-one),IterationEnd) { nqp::stmts( @@ -211,6 +220,14 @@ Did you mean to add a stub (\{...\}) or did you mean to .classify?" ) ); + nqp::if( + $!slipping, + nqp::until( + nqp::eqaddr(self.slip-one,IterationEnd), + nqp::null + ) + ); + my int $stopped; my int $done; my $value; @@ -424,49 +441,68 @@ Did you mean to add a stub (\{...\}) or did you mean to .classify?" } method push-all($target --> IterationEnd) { - nqp::until( - nqp::eqaddr((my $value := $!source.pull-one),IterationEnd), - nqp::stmts( - (my int $redo = 1), - nqp::while( - $redo, - nqp::stmts( - ($redo = 0), - nqp::handle( - nqp::if( - nqp::istype((my $result := &!block($value)),Slip), - self.slip-all($result,$target), - $target.push($result) - ), - 'LABELED', $!label, - 'REDO', ($redo = 1), - 'LAST', return, - 'NEXT', nqp::null, # need NEXT for next LABEL support - ) - ), - :nohandler + nqp::stmts( + (my $value), + nqp::if( + $!slipping, + nqp::until( + nqp::eqaddr(($value := self.slip-one),IterationEnd), + $target.push($value) + ) + ), + nqp::until( + nqp::eqaddr(($value := $!source.pull-one),IterationEnd), + nqp::stmts( + (my int $redo = 1), + nqp::while( + $redo, + nqp::stmts( + ($redo = 0), + nqp::handle( + nqp::if( + nqp::istype((my $result := &!block($value)),Slip), + self.slip-all($result,$target), + $target.push($result) + ), + 'LABELED', $!label, + 'REDO', ($redo = 1), + 'LAST', return, + 'NEXT', nqp::null, # need NEXT for next LABEL support + ) + ), + :nohandler + ) ) ) ) } method sink-all(--> IterationEnd) { - nqp::until( - nqp::eqaddr((my $value := $!source.pull-one()),IterationEnd), - nqp::stmts( - (my int $redo = 1), - nqp::while( - $redo, - nqp::stmts( - ($redo = 0), - nqp::handle( # doesn't sink - &!block($value), - 'LABELED', $!label, - 'NEXT', nqp::null, # need NEXT for next LABEL support - 'REDO', ($redo = 1), - 'LAST', return - ), - :nohandler + nqp::stmts( + nqp::if( + $!slipping, + nqp::until( + nqp::eqaddr(self.slip-one,IterationEnd), + nqp::null + ) + ), + nqp::until( + nqp::eqaddr((my $value := $!source.pull-one()),IterationEnd), + nqp::stmts( + (my int $redo = 1), + nqp::while( + $redo, + nqp::stmts( + ($redo = 0), + nqp::handle( # doesn't sink + &!block($value), + 'LABELED', $!label, + 'NEXT', nqp::null, # need NEXT for next LABEL support + 'REDO', ($redo = 1), + 'LAST', return + ), + :nohandler + ) ) ) ) @@ -554,78 +590,97 @@ Did you mean to add a stub (\{...\}) or did you mean to .classify?" } method push-all($target --> IterationEnd) { - nqp::until( - nqp::eqaddr((my $value := $!source.pull-one),IterationEnd), - nqp::stmts( - (my int $redo = 1), - nqp::while( - $redo, - nqp::stmts( - ($redo = 0), - nqp::handle( - nqp::if( - nqp::eqaddr( - (my $value2 := $!source.pull-one), - IterationEnd - ), - nqp::stmts( - (my $result := &!block($value)), + nqp::stmts( + (my $value), + nqp::if( + $!slipping, + nqp::until( + nqp::eqaddr(($value := self.slip-one),IterationEnd), + $target.push($value) + ) + ), + nqp::until( + nqp::eqaddr(($value := $!source.pull-one),IterationEnd), + nqp::stmts( + (my int $redo = 1), + nqp::while( + $redo, + nqp::stmts( + ($redo = 0), + nqp::handle( + nqp::if( + nqp::eqaddr( + (my $value2 := $!source.pull-one), + IterationEnd + ), + nqp::stmts( + (my $result := &!block($value)), + nqp::if( + nqp::istype($result,Slip), + self.slip-all($result,$target), + $target.push($result) + ), + return + ), nqp::if( - nqp::istype($result,Slip), + nqp::istype( + ($result := &!block($value,$value2)), + Slip + ), self.slip-all($result,$target), $target.push($result) - ), - return + ) ), - nqp::if( - nqp::istype( - ($result := &!block($value,$value2)), - Slip - ), - self.slip-all($result,$target), - $target.push($result) - ) - ), - 'LABELED', $!label, - 'REDO', ($redo = 1), - 'LAST', return, - 'NEXT', nqp::null, # need NEXT for next LABEL support - ) - ), - :nohandler + 'LABELED', $!label, + 'REDO', ($redo = 1), + 'LAST', return, + 'NEXT', nqp::null, # need NEXT for next LABEL support + ) + ), + :nohandler + ) ) ) ) } method sink-all(--> IterationEnd) { - nqp::until( - nqp::eqaddr((my $value := $!source.pull-one()),IterationEnd), - nqp::stmts( - (my int $redo = 1), - nqp::while( - $redo, - nqp::stmts( - ($redo = 0), - nqp::handle( # doesn't sink - nqp::if( - nqp::eqaddr( - (my $value2 := $!source.pull-one), - IterationEnd - ), - nqp::stmts( - (&!block($value)), - return + nqp::stmts( + nqp::if( + $!slipping, + nqp::until( + nqp::eqaddr(self.slip-one,IterationEnd), + nqp::null, + ) + ), + nqp::until( + nqp::eqaddr((my $value := $!source.pull-one()),IterationEnd), + nqp::stmts( + (my int $redo = 1), + nqp::while( + $redo, + nqp::stmts( + ($redo = 0), + nqp::handle( # doesn't sink + nqp::if( + nqp::eqaddr( + (my $value2 := $!source.pull-one), + IterationEnd + ), + nqp::stmts( + (&!block($value)), + return + ), + (&!block($value,$value2)) ), - (&!block($value,$value2)) - ), - 'LABELED', $!label, - 'NEXT', nqp::null, # need NEXT for next LABEL support - 'REDO', ($redo = 1), - 'LAST', return - ) - ), - :nohandler + 'LABELED', $!label, + 'NEXT', nqp::null, # need NEXT for next LABEL support + 'REDO', ($redo = 1), + 'LAST', return + ) + ), + :nohandler + ) ) ) ) From 4d0ead240aff4510ecb066b59dfaa1ad9f184935 Mon Sep 17 00:00:00 2001 From: Timo Paulssen Date: Sat, 30 Sep 2017 17:40:07 +0200 Subject: [PATCH 236/692] don't output when add_method for BUILDALL fails. --- src/Perl6/Metamodel/ClassHOW.nqp | 3 --- 1 file changed, 3 deletions(-) diff --git a/src/Perl6/Metamodel/ClassHOW.nqp b/src/Perl6/Metamodel/ClassHOW.nqp index b8471df44f9..df8f6dde372 100644 --- a/src/Perl6/Metamodel/ClassHOW.nqp +++ b/src/Perl6/Metamodel/ClassHOW.nqp @@ -166,9 +166,6 @@ class Perl6::Metamodel::ClassHOW my $result := try { self.add_method($obj,'BUILDALL',$method); } - unless $result { - nqp::say($obj.HOW.name($obj) ~ ' failed to add a BUILDALL'); - } } } } From 80d6b425ce0facda1e9e6faa93d834d0668893bc Mon Sep 17 00:00:00 2001 From: Stefan Seifert Date: Sun, 1 Oct 2017 08:59:38 +0200 Subject: [PATCH 237/692] Compile optimized bodies of native subs at compile time Previously the optimized bodies of native subs were compiled on the first call of the sub. NativeCall now exports a CHECK phaser to do this at the end of the compilation phase. This means that it happens e.g. during precompilation and can be done once per installation instead of once per run. Note that loading the native library is still done at runtime. Also since we only know if we can JIT compile the calling code after nativecallbuild, we compile both the JITed and non-JITed body candidates and select the appropriate one in !setup. --- lib/NativeCall.pm6 | 234 +++++++++++++++++++++++++++++---------------- 1 file changed, 152 insertions(+), 82 deletions(-) diff --git a/lib/NativeCall.pm6 b/lib/NativeCall.pm6 index 57752ddc3a4..24ba1ccf23a 100644 --- a/lib/NativeCall.pm6 +++ b/lib/NativeCall.pm6 @@ -1,12 +1,21 @@ use nqp; use QAST:from; -module NativeCall { - use NativeCall::Types; use NativeCall::Compiler::GNU; use NativeCall::Compiler::MSVC; +my $repr_map := nqp::hash( + "CArray", "carray", + "CPPStruct", "cppstruct", + "CPointer", "cpointer", + "CStruct", "cstruct", + "CUnion", "cunion", + "VMArray", "vmarray", +); + +module NativeCall { + my constant long is export(:types, :DEFAULT) = NativeCall::Types::long; my constant longlong is export(:types, :DEFAULT) = NativeCall::Types::longlong; my constant ulong is export(:types, :DEFAULT) = NativeCall::Types::ulong; @@ -146,15 +155,6 @@ my $type_map := nqp::hash( "ulonglong", "ulonglong", ); -my $repr_map := nqp::hash( - "CArray", "carray", - "CPPStruct", "cppstruct", - "CPointer", "cpointer", - "CStruct", "cstruct", - "CUnion", "cunion", - "VMArray", "vmarray", -); - sub type_code_for(Mu ::T) { if nqp::atkey($type_map,T.^shortname) -> $type { $type @@ -231,39 +231,6 @@ sub guess_library_name($lib) is export(:TEST) { return $*VM.platform-library-name($libname.IO, :version($apiversion || Version)).Str; } -sub check_routine_sanity(Routine $r) is export(:TEST) { - #Maybe this should use the hash already existing? - sub validnctype (Mu ::T) { - return True if nqp::existskey($repr_map,T.REPR) && T.REPR ne 'CArray' | 'CPointer'; - return True if T.^name eq 'Str' | 'str' | 'Bool'; - return False if T.REPR eq 'P6opaque'; - return False if T.HOW.^can("nativesize") && !nqp::defined(T.^nativesize); #to disting int and int32 for example - return validnctype(T.of) if T.REPR eq 'CArray' | 'CPointer' and T.^can('of'); - return True; - } - my $sig = $r.signature; - for @($sig.params).kv -> $i, $param { - next if $r ~~ Method and ($i < 1 or $i == $sig.params.elems - 1); #Method have two extra parameters - if $param.type ~~ Callable { - # We probably want to check the given routine type too here. but I don't know how - next; - } - next unless $param.type ~~ Buf | Blob #Buf are Uninstantiable, make this buggy - || $param.type.^can('gist'); #FIXME, it's to handle case of class A { sub foo(A) is native) }, the type is not complete - if !validnctype($param.type) { - warn "In '{$r.name}' routine declaration - Not an accepted NativeCall type" - ~ " for parameter [{$i + 1}] {$param.name ?? $param.name !! ''} : {$param.type.^name}\n" - ~ " --> For Numerical type, use the appropriate int32/int64/num64..."; - } - } - return True if $r.returns.REPR eq 'CPointer' | 'CStruct' | 'CPPStruct'; #Meh fix but 'imcomplete' type are a pain - if $r.returns.^name ne 'Mu' && !validnctype($r.returns) { - warn "The returning type of '{$r.name}' --> {$r.returns.^name} is erroneous." - ~ " You should not return a non NativeCall supported type (like Int inplace of int32)," - ~ " truncating errors can appear with different architectures"; - } -} - my %lib; my @cpp-name-mangler = &NativeCall::Compiler::MSVC::mangle_cpp_symbol, @@ -291,7 +258,7 @@ my Lock $setup-lock .= new; # This role is mixed in to any routine that is marked as being a # native call. -my role Native[Routine $r, $libname where Str|Callable|List|IO::Path|Distribution::Resource] { +our role Native[Routine $r, $libname where Str|Callable|List|IO::Path|Distribution::Resource] { has int $!setup; has native_callsite $!call is box_target; has Mu $!rettype; @@ -300,6 +267,8 @@ my role Native[Routine $r, $libname where Str|Callable|List|IO::Path|Distributio has int $!arity; has int8 $!is-clone; has int8 $!any-optionals; + has Mu $!optimized-body; + has Mu $!jit-optimized-body; method !setup() { $setup-lock.protect: { @@ -323,11 +292,25 @@ my role Native[Routine $r, $libname where Str|Callable|List|IO::Path|Distributio nqp::unbox_s($conv), # calling convention $arg_info, return_hash_for($r.signature, $r, :$!entry-point)); - $!rettype := nqp::decont(map_return_type($r.returns)); + $!rettype := nqp::decont(map_return_type($r.returns)) unless $!rettype; $!arity = $r.signature.arity; $!setup = $jitted ?? 2 !! 1; $!any-optionals = self!any-optionals; + + my $body := $jitted ?? $!jit-optimized-body !! $!optimized-body; + if $body { + nqp::bindattr( + self, + Code, + '$!do', + nqp::getattr(nqp::hllizefor($body, 'perl6'), ForeignCode, '$!do') + ); + nqp::setinvokespec(self, + Code.HOW.invocation_attr_class(Code), + Code.HOW.invocation_attr_name(Code), + nqp::null()); + } } } @@ -346,7 +329,7 @@ my role Native[Routine $r, $libname where Str|Callable|List|IO::Path|Distributio } method !create-jit-compiled-function-body(Routine $r) { - my $block := QAST::Block.new(:name($r.name), :arity($!arity)); + my $block := QAST::Block.new(:name($r.name), :arity($!arity), :blocktype('declaration_static')); my $locals = 0; my @deconts; my @params; @@ -398,6 +381,7 @@ my role Native[Routine $r, $libname where Str|Callable|List|IO::Path|Distributio ); } $block.push: nqp::decont($_) for @deconts; # do not interrupt the locals definitions + $!rettype := nqp::decont(map_return_type($r.returns)) unless $!rettype; my $invoke_op := QAST::Op.new( :op, QAST::WVal.new(:value(self)), @@ -409,7 +393,7 @@ my role Native[Routine $r, $libname where Str|Callable|List|IO::Path|Distributio } method !create-function-body(Routine $r) { - my $block := QAST::Block.new(:name($r.name), :arity($!arity)); + my $block := QAST::Block.new(:name($r.name), :arity($!arity), :blocktype('declaration_static')); my $arglist := QAST::Op.new(:op); my $locals = 0; for $r.signature.params { @@ -463,6 +447,7 @@ my role Native[Routine $r, $libname where Str|Callable|List|IO::Path|Distributio $arglist.push: QAST::Var.new(:scope, :name($lowered_name)); } } + $!rettype := nqp::decont(map_return_type($r.returns)) unless $!rettype; $block.push: QAST::Op.new( :op, QAST::WVal.new(:value($!rettype)), @@ -476,47 +461,82 @@ my role Native[Routine $r, $libname where Str|Callable|List|IO::Path|Distributio my @stages = $perl6comp.stages; Nil until @stages.shift eq 'optimize'; - method !create-optimized-call() { - $setup-lock.protect: { - unless nqp::defined(nqp::getobjsc(self)) { - my $sc := nqp::createsc('NativeCallSub' ~ nqp::objectid(self)); - nqp::setobjsc(self, $sc); - my int $idx = nqp::scobjcount($sc); - nqp::scsetobj($sc, $idx, self); - } + method !compile-function-body(Mu $block) { + my $result := $block; + $result := $perl6comp.^can($_) + ?? $perl6comp."$_"($result) + !! $perl6comp.backend."$_"($result) + for @stages; + my $body := nqp::compunitmainline($result); + $*W.add_object($body) if $*W; + + nqp::setcodename($body, $r.name); + $body + } - my $block := $!setup == 2 - ?? self!create-jit-compiled-function-body($r) - !! self!create-function-body($r); - - my $result := $block; - $result := $perl6comp.^can($_) - ?? $perl6comp."$_"($result) - !! $perl6comp.backend."$_"($result) - for @stages; - my $body := nqp::compunitmainline($result); - - nqp::setcodename($body, $r.name); - nqp::bindattr(self, Code, '$!do', $body); - nqp::setinvokespec(self, - Code.HOW.invocation_attr_class(Code), - Code.HOW.invocation_attr_name(Code), - nqp::null()); + method create-optimized-call() { + unless $!optimized-body { + $setup-lock.protect: { + unless nqp::defined(nqp::getobjsc(self)) { + if $*W { + $*W.add_object(self); + } + else { + my $sc := nqp::createsc('NativeCallSub' ~ nqp::objectid(self)); + nqp::setobjsc(self, $sc); + my int $idx = nqp::scobjcount($sc); + nqp::scsetobj($sc, $idx, self); + } + } + + my $optimized-body := self!create-function-body($r); + $optimized-body.annotate('code_object', self); + $optimized-body.code_object(self); + my $stub := nqp::freshcoderef(nqp::getattr(sub (*@args, *%named) { die "stub called" }, Code, '$!do')); + nqp::setcodename($stub, self.name); + nqp::markcodestatic($stub); + nqp::markcodestub($stub); + nqp::bindattr(self, $?CLASS, '$!optimized-body', $stub); + my $jit-optimized-body := self!create-jit-compiled-function-body($r); + $jit-optimized-body.annotate('code_object', self); + $jit-optimized-body.code_object(self); + nqp::bindattr(self, $?CLASS, '$!jit-optimized-body', $stub); + my $fixups := QAST::Stmts.new(); + my $des := QAST::Stmts.new(); + if $*W { + $*W.add_root_code_ref($stub, $optimized-body); + $*W.add_root_code_ref($stub, $jit-optimized-body); + $*W.add_object($?CLASS); + $*UNIT.push($optimized-body); + $*UNIT.push($jit-optimized-body); + $fixups.push($*W.set_attribute(self, $?CLASS, '$!optimized-body', + QAST::BVal.new( :value($optimized-body) ))); + $fixups.push($*W.set_attribute(self, $?CLASS, '$!jit-optimized-body', + QAST::BVal.new( :value($jit-optimized-body) ))); + $*W.add_fixup_task(:deserialize_ast($fixups), :fixup_ast($fixups)); + } + else { + $!optimized-body := self!compile-function-body(self!create-function-body($r)); + $!jit-optimized-body := self!compile-function-body(self!create-jit-compiled-function-body($r)); + } + } } } method clone() { my $clone := callsame; nqp::bindattr_i($clone, $?CLASS, '$!is-clone', 1); + nqp::bindattr($clone, $?CLASS, '$!optimized-body', Mu); + nqp::bindattr($clone, $?CLASS, '$!jit-optimized-body', Mu); $clone } method CALL-ME(|args) { - self!setup(); - self!create-optimized-call() unless + self.create-optimized-call() unless $!is-clone # Clones and original would share the invokespec but not the $!do attribute or $!any-optionals # the compiled code doesn't support optional parameters yet or $*W; # Avoid issues with compiling specialized version during BEGIN time + self!setup(); my Mu $args := nqp::getattr(nqp::decont(args), Capture, '@!list'); if nqp::elems($args) != $!arity { @@ -542,13 +562,6 @@ multi trait_mod:(Routine $r, :$symbol!) is export(:DEFAULT, :traits) { $r does NativeCallSymbol[$symbol]; } -# Specifies that the routine is actually a native call, into the -# current executable (platform specific) or into a named library -multi trait_mod:(Routine $r, :$native!) is export(:DEFAULT, :traits) { - check_routine_sanity($r); - $r does Native[$r, $native === True ?? Str !! $native]; -} - # Specifies the calling convention to use for a native call. multi trait_mod:(Routine $r, :$nativeconv!) is export(:DEFAULT, :traits) { $r does NativeCallingConvention[$nativeconv]; @@ -628,4 +641,61 @@ sub cglobal($libname, $symbol, $target-type) is export is rw { } +sub check_routine_sanity(Routine $r) is export(:TEST) { + #Maybe this should use the hash already existing? + sub validnctype (Mu ::T) { + return True if nqp::existskey($repr_map,T.REPR) && T.REPR ne 'CArray' | 'CPointer'; + return True if T.^name eq 'Str' | 'str' | 'Bool'; + return False if T.REPR eq 'P6opaque'; + return False if T.HOW.^can("nativesize") && !nqp::defined(T.^nativesize); #to disting int and int32 for example + return validnctype(T.of) if T.REPR eq 'CArray' | 'CPointer' and T.^can('of'); + return True; + } + my $sig = $r.signature; + for @($sig.params).kv -> $i, $param { + next if $r ~~ Method and ($i < 1 or $i == $sig.params.elems - 1); #Method have two extra parameters + if $param.type ~~ Callable { + # We probably want to check the given routine type too here. but I don't know how + next; + } + next unless $param.type ~~ Buf | Blob #Buf are Uninstantiable, make this buggy + || $param.type.^can('gist'); #FIXME, it's to handle case of class A { sub foo(A) is native) }, the type is not complete + if !validnctype($param.type) { + warn "In '{$r.name}' routine declaration - Not an accepted NativeCall type" + ~ " for parameter [{$i + 1}] {$param.name ?? $param.name !! ''} : {$param.type.^name}\n" + ~ " --> For Numerical type, use the appropriate int32/int64/num64..."; + } + } + return True if $r.returns.REPR eq 'CPointer' | 'CStruct' | 'CPPStruct'; #Meh fix but 'imcomplete' type are a pain + if $r.returns.^name ne 'Mu' && !validnctype($r.returns) { + warn "The returning type of '{$r.name}' --> {$r.returns.^name} is erroneous." + ~ " You should not return a non NativeCall supported type (like Int inplace of int32)," + ~ " truncating errors can appear with different architectures"; + } +} + +sub EXPORT(|) { + my @routines_to_setup; + if ($*W) { + my $block := { + for @routines_to_setup { + .create-optimized-call; + CATCH { default { note $_ } } + } + }; + $*W.add_object($block); + my $op := $*W.add_phaser(Mu, 'CHECK', $block, class :: { method cuid { (^2**128).pick }}); + } + # Specifies that the routine is actually a native call, into the + # current executable (platform specific) or into a named library + my $native_trait := multi trait_mod:(Routine $r, :$native!) { + check_routine_sanity($r); + $r does NativeCall::Native[$r, $native === True ?? Str !! $native]; + @routines_to_setup.push: $r; + }; + Map.new( + '&trait_mod:' => $native_trait.dispatcher, + ); +} + # vim:ft=perl6 From 681d6be9742e7c031003a79f1ec9e11d2535fee6 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sun, 1 Oct 2017 08:11:05 +0000 Subject: [PATCH 238/692] Fix and improve `**` regex quantifier Fixes RT#130911: https://rt.perl.org/Ticket/Display.html?id=130911 Fixes RT#130127: https://rt.perl.org/Ticket/Display.html?id=130127 Fixes RT#130125: https://rt.perl.org/Ticket/Display.html?id=130125 Fixes RT#130124: https://rt.perl.org/Ticket/Display.html?id=130124 - Negative values are treated as zero. The only thing I'm unsure of here is that /{2..1}/ throws about empty Range, while {-1..-2} would match zero characters, since it's effectively {0..0} - Throw typed exceptions; don't return Failures (they get exploded somewhere in the regex engine, causing poor errors) - Add X::Syntax::Regex::QuantifierValue exception. The X::Syntax isn't a perfect classification, but all the other Regex errors are under this umbrella, so this felt righter than creating an exception outside of X::Syntax::Regex - Dies with "cannot unbox to native integer" on large Int values, which is a bit unhelpful, but this behaviour existed without this patch --- src/Perl6/Actions.nqp | 5 +++- src/core/Exception.pm | 19 +++++++++++++++ src/core/Match.pm | 56 ++++++++++++++++++++++++++++++++++--------- 3 files changed, 68 insertions(+), 12 deletions(-) diff --git a/src/Perl6/Actions.nqp b/src/Perl6/Actions.nqp index 36fa59b2bf1..a70e4b20a8e 100644 --- a/src/Perl6/Actions.nqp +++ b/src/Perl6/Actions.nqp @@ -9798,7 +9798,10 @@ class Perl6::RegexActions is QRegex::P6Regex::Actions does STDActions { if $ eq '^' { $max--; } - $/.panic("Empty range") if $min > $max; + + $/.typed_panic( + 'X::Syntax::Regex::QuantifierValue', :empty-range + ) if $min > $max; } $qast := QAST::Regex.new( :rxtype, :min($min), :max($max), :node($/) ); } diff --git a/src/core/Exception.pm b/src/core/Exception.pm index 4438637767f..251e2bca995 100644 --- a/src/core/Exception.pm +++ b/src/core/Exception.pm @@ -1696,6 +1696,25 @@ my class X::Syntax::Regex::SpacesInBareRange does X::Syntax { method message { 'Spaces not allowed in bare range.' } } +my class X::Syntax::Regex::QuantifierValue does X::Syntax { + has $.inf; + has $.non-numeric; + has $.non-numeric-range; + has $.empty-range; + method message { + $!inf + && 'Minimum quantity to match for quantifier cannot be Inf.' + ~ ' Did you mean to use + or * quantifiers instead of **?' + || $!non-numeric-range + && 'Cannot use Range with non-Numeric or NaN end points as quantifier' + || $!non-numeric + && 'Cannot non-Numeric or NaN value as quantifier' + || $!empty-range + && 'Cannot use empty Range as quantifier' + || 'Invalid quantifier value' + } +} + my class X::Syntax::Regex::SolitaryQuantifier does X::Syntax { method message { 'Quantifier quantifies nothing' } } diff --git a/src/core/Match.pm b/src/core/Match.pm index ff6213b1894..ac881f490c4 100644 --- a/src/core/Match.pm +++ b/src/core/Match.pm @@ -412,17 +412,51 @@ my class Match is Capture is Cool does NQPMatchRole { } method DYNQUANT_LIMITS($mm) { - nqp::istype($mm,Range) - ?? $mm.min == Inf - ?? die 'Range minimum in quantifier (**) cannot be +Inf' - !! $mm.max == -Inf - ?? die 'Range maximum in quantifier (**) cannot be -Inf' - !! nqp::list_i( - $mm.min < 0 ?? 0 !! $mm.min.Int, - $mm.max == Inf ?? -1 !! $mm.max.Int) - !! $mm == -Inf || $mm == Inf - ?? Failure.new('Fixed quantifier cannot be infinite') - !! nqp::list_i($mm.Int, $mm.Int) + # Treat non-Range values as range with that value on both end points + # Throw for non-Numeric or NaN Ranges, or if minimum limit is +Inf + # If starting end point is less than 0, treat is as 0 + nqp::if( + nqp::istype($mm,Range), + nqp::if( + nqp::isfalse(nqp::istype((my $min := $mm.min),Numeric)) + || nqp::isfalse(nqp::istype((my $max := $mm.max),Numeric)) + || $min.isNaN || $max.isNaN, + X::Syntax::Regex::QuantifierValue.new(:non-numeric-range).throw, + nqp::if( + $min == Inf, + X::Syntax::Regex::QuantifierValue.new(:inf).throw, + nqp::stmts( + nqp::if( + nqp::islt_i( + ($min := nqp::add_i($min == -Inf ?? -1 !! $min.Int, + $mm.excludes-min)), + 0), + $min := 0), + nqp::if( + $max == Inf, + nqp::list_i($min,-1), + nqp::stmts( + nqp::if( + $max == -Inf || nqp::islt_i( + ($max := nqp::sub_i($max.Int,$mm.excludes-max)),0), + $max := 0), + nqp::if( + nqp::islt_i($max, $min), + X::Syntax::Regex::QuantifierValue.new(:empty-range).throw, + nqp::list_i($min,$max))))))), + nqp::if( + nqp::istype((my $v := $mm.Int), Failure), + nqp::if( + nqp::istype($mm,Numeric) && nqp::isfalse($mm.isNaN), + nqp::if( + $mm == Inf, + X::Syntax::Regex::QuantifierValue.new(:inf).throw, + nqp::list_i(0,0)), # if we got here, $mm is -Inf, treat as zero + X::Syntax::Regex::QuantifierValue.new(:non-numeric).throw), + nqp::if( + nqp::islt_i($v,0), + nqp::list_i(0,0), + nqp::list_i($v,$v)))) } method OTHERGRAMMAR($grammar, $name, |) { From 07c1e4fc895e982912a4ee62608bfc79c4fbc5a7 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sun, 1 Oct 2017 04:48:36 -0400 Subject: [PATCH 239/692] Add more info to the comment --- src/core/Match.pm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/core/Match.pm b/src/core/Match.pm index ac881f490c4..86df68d3e61 100644 --- a/src/core/Match.pm +++ b/src/core/Match.pm @@ -414,7 +414,8 @@ my class Match is Capture is Cool does NQPMatchRole { method DYNQUANT_LIMITS($mm) { # Treat non-Range values as range with that value on both end points # Throw for non-Numeric or NaN Ranges, or if minimum limit is +Inf - # If starting end point is less than 0, treat is as 0 + # Convert endpoints that are less than 0 to 0, then, + # throw if Range is empty. nqp::if( nqp::istype($mm,Range), nqp::if( From f8a74eabaeb7de9bcdd6bcc312a0827f78c22166 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sun, 1 Oct 2017 08:12:45 -0400 Subject: [PATCH 240/692] Fix typo in Exception's message; MasterDuke++ --- src/core/Exception.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/Exception.pm b/src/core/Exception.pm index 251e2bca995..67b021d6b66 100644 --- a/src/core/Exception.pm +++ b/src/core/Exception.pm @@ -1708,7 +1708,7 @@ my class X::Syntax::Regex::QuantifierValue does X::Syntax { || $!non-numeric-range && 'Cannot use Range with non-Numeric or NaN end points as quantifier' || $!non-numeric - && 'Cannot non-Numeric or NaN value as quantifier' + && 'Cannot use non-Numeric or NaN value as quantifier' || $!empty-range && 'Cannot use empty Range as quantifier' || 'Invalid quantifier value' From 78c967cbd58ae78a23d288452285adf6ee4607f3 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sun, 1 Oct 2017 08:13:39 -0400 Subject: [PATCH 241/692] Remove Perlism; MaserDuke++ --- lib/NativeCall.pm6 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/NativeCall.pm6 b/lib/NativeCall.pm6 index 24ba1ccf23a..6ccd6d2d905 100644 --- a/lib/NativeCall.pm6 +++ b/lib/NativeCall.pm6 @@ -676,7 +676,7 @@ sub check_routine_sanity(Routine $r) is export(:TEST) { sub EXPORT(|) { my @routines_to_setup; - if ($*W) { + if $*W { my $block := { for @routines_to_setup { .create-optimized-call; From 921db910f147cd511c19f1de646dd76c64d18f0a Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sun, 1 Oct 2017 12:38:31 +0000 Subject: [PATCH 242/692] Bump NQP --- tools/build/NQP_REVISION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/build/NQP_REVISION b/tools/build/NQP_REVISION index 0bd4babcb8f..d74c176f98c 100644 --- a/tools/build/NQP_REVISION +++ b/tools/build/NQP_REVISION @@ -1 +1 @@ -2017.09-37-g71fc322e5 +2017.09-38-ga0618a6 From edce8f53bd29c3d5659104961a213b511e3d1290 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sun, 1 Oct 2017 09:19:47 -0400 Subject: [PATCH 243/692] Add all Rakudo's tests to `make test` --- tools/build/Makefile-JVM.in | 2 +- tools/build/Makefile-Moar.in | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/tools/build/Makefile-JVM.in b/tools/build/Makefile-JVM.in index 9058451d0a3..5e63a7d6083 100644 --- a/tools/build/Makefile-JVM.in +++ b/tools/build/Makefile-JVM.in @@ -178,7 +178,7 @@ j-test : j-coretest j-fulltest: j-coretest j-stresstest j-coretest: j-all - $(J_HARNESS5) t/01-sanity t/03-jvm t/04-nativecall + $(J_HARNESS5) t/01-sanity t/02-rakudo t/03-jvm t/04-nativecall t/05-messages # Run the spectests that we know work. j-spectest: j-testable t/spectest.data diff --git a/tools/build/Makefile-Moar.in b/tools/build/Makefile-Moar.in index 42400b9af4e..e5970ac5fd7 100644 --- a/tools/build/Makefile-Moar.in +++ b/tools/build/Makefile-Moar.in @@ -231,7 +231,7 @@ m-quicktest: m-quicktest$(HARNESS_TYPE) m-stresstest: m-stresstest$(HARNESS_TYPE) m-coretest5: m-all - $(M_HARNESS5) t/01-sanity t/04-nativecall + $(M_HARNESS5) t/01-sanity t/02-rakudo t/04-nativecall t/05-messages # Run the spectests that we know work. m-spectest5: m-testable t/spectest.data @@ -248,7 +248,7 @@ m-stresstest5: m-testable t/spectest.data m-coretest6: m-all - $(M_HARNESS6) t/01-sanity t/04-nativecall + $(M_HARNESS6) t/01-sanity t/02-rakudo t/04-nativecall t/05-messages # Run the spectests that we know work. m-spectest6: m-testable t/spectest.data From c6ff787a67c87ca2df9e4dbf4e73a448e6132455 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sun, 1 Oct 2017 09:52:47 -0400 Subject: [PATCH 244/692] Don't rely on roast checkout for `make test` --- .gitignore | 2 +- t/02-rakudo/08-slangs.t | 21 +++++++++--------- t/02-rakudo/11-deprecated.t | 9 ++++---- t/02-rakudo/v6.d-tests/01-deprecations.t | 5 ++--- t/packages/Test/Helpers.pm6 | 28 ++++++++++++++++++++++++ 5 files changed, 45 insertions(+), 20 deletions(-) create mode 100644 t/packages/Test/Helpers.pm6 diff --git a/.gitignore b/.gitignore index e377261b1dd..255c5f33f64 100644 --- a/.gitignore +++ b/.gitignore @@ -64,7 +64,7 @@ perl6-debug-m perl6-debug-m.bat t/localtest.data t/spec -t/packages +t/packages/tap-harness6 /panda perl6.c perl6.o diff --git a/t/02-rakudo/08-slangs.t b/t/02-rakudo/08-slangs.t index 296bfc360dd..b9bf2e76285 100644 --- a/t/02-rakudo/08-slangs.t +++ b/t/02-rakudo/08-slangs.t @@ -1,18 +1,17 @@ use v6; -use lib ; +use lib ; use Test; -use Test::Util; +use Test::Helpers; # Tests for slang interface that aren't yet spec plan 1; -is_run 「 - BEGIN $?LANG.refine_slang( - 'MAIN', - role { token apostrophe { <[ - ' \\ ]> } }, - role {}, - ); - my $foo\bar = "pass"; say $foo\bar; - 」, {:out("pass\n"), :err(''), :0status}, - 'no crash when giving an Actions class to .refine_slang'; +is-run 「 + BEGIN $?LANG.refine_slang( + 'MAIN', + role { token apostrophe { <[ - ' \\ ]> } }, + role {}, + ); + my $foo\bar = "pass"; say $foo\bar; +」, :out("pass\n"), 'no crash when giving an Actions class to .refine_slang'; diff --git a/t/02-rakudo/11-deprecated.t b/t/02-rakudo/11-deprecated.t index 104a141cba2..8090093cbe6 100644 --- a/t/02-rakudo/11-deprecated.t +++ b/t/02-rakudo/11-deprecated.t @@ -1,16 +1,16 @@ -use lib ; +use lib ; use Test; -use Test::Util; +use Test::Helpers; plan 2; sub test-deprecation (Str:D $lang, Bool :$is-visible, |c) { my $args = c.perl; - is_run ' + is-run ' use \qq[$lang]; %*ENV:delete; DEPRECATED "meow", |(\qq[$args]); - ', { :out(''), :err($is-visible ?? /meow/ !! ''), :0status }, + ', :err($is-visible ?? /meow/ !! ''), ($is-visible ?? 'shows' !! 'no') ~ " deprecation message with $args"; } sub is-deprecated (|c) { test-deprecation |c, :is-visible } @@ -20,4 +20,3 @@ isn't-deprecated 'v6.c', v6.d, v6.e, :lang-vers; # XXX TODO: remove `.PREVIEW` part when 6.d comes out: is-deprecated 'v6.d.PREVIEW', v6.d, v6.e, :lang-vers; - diff --git a/t/02-rakudo/v6.d-tests/01-deprecations.t b/t/02-rakudo/v6.d-tests/01-deprecations.t index 1685222597f..942be85ba5a 100644 --- a/t/02-rakudo/v6.d-tests/01-deprecations.t +++ b/t/02-rakudo/v6.d-tests/01-deprecations.t @@ -1,6 +1,5 @@ -use lib ; +use lib ; use Test; -use Test::Util; +use Test::Helpers; plan 1; ok 'dummy'; - diff --git a/t/packages/Test/Helpers.pm6 b/t/packages/Test/Helpers.pm6 new file mode 100644 index 00000000000..44511b9ccc2 --- /dev/null +++ b/t/packages/Test/Helpers.pm6 @@ -0,0 +1,28 @@ +unit module Test::Helpers; +use Test; + +sub is-run ( + Str() $code, $desc = "$code runs", + Stringy :$in, :@compiler-args, :@args, :$out, :$err, :$status +) is export { + with run :in, :out, :err, + $*EXECUTABLE, @compiler-args, '-e', $code, @args + { + $in ~~ Blob ?? .in.write: $in !! .in.print: $in if $in; + $ = .in.close; + my $proc-out = .out.slurp: :close; + my $proc-err = .err.slurp: :close; + my $proc-status = .status; + + my $wanted-status = $status // 0; + my $wanted-out = $out // ''; + my $wanted-err = $err // ''; + + subtest $desc => { + plan 3; + cmp-ok $proc-out, '~~', $wanted-out, 'STDOUT'; + cmp-ok $proc-err, '~~', $wanted-err, 'STDERR'; + cmp-ok $proc-status, '~~', $wanted-status, 'Status'; + } + } +} From 8479a1ba037b013258edef6ec627cdc53ae8ad19 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sun, 1 Oct 2017 14:35:01 +0000 Subject: [PATCH 245/692] Make cmp-ok try harder to get useful description Merely stringifying the $got/$expected sometimes results in warnings/empty descriptions in the failed description output. Make descriptions via .perl//.gist --- lib/Test.pm6 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/lib/Test.pm6 b/lib/Test.pm6 index 6ba89e9f131..3b173657a94 100644 --- a/lib/Test.pm6 +++ b/lib/Test.pm6 @@ -248,9 +248,11 @@ multi sub cmp-ok(Mu $got, $op, Mu $expected, $desc = '') is export { if $matcher { $ok = proclaim($matcher($got,$expected), $desc); if !$ok { - _diag "expected: '" ~ ($expected // $expected.^name) ~ "'\n" + my $expected-desc = (try $expected.perl) // $expected.gist; + my $got-desc = (try $got .perl) // $got .gist; + _diag "expected: $expected-desc\n" ~ " matcher: '" ~ ($matcher.?name || $matcher.^name) ~ "'\n" - ~ " got: '$got'"; + ~ " got: $got-desc"; } } else { From bbc6570f5db7a769e24a59295f3170aeb3803fce Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sun, 1 Oct 2017 14:36:54 +0000 Subject: [PATCH 246/692] Add S24-testing/13-cmp-ok.t to list of test files --- t/spectest.data | 1 + 1 file changed, 1 insertion(+) diff --git a/t/spectest.data b/t/spectest.data index 881972a3110..10f136542ad 100644 --- a/t/spectest.data +++ b/t/spectest.data @@ -911,6 +911,7 @@ S24-testing/10-is-approx.t S24-testing/11-plan-skip-all.t # stress S24-testing/11-plan-skip-all-subtests.t S24-testing/12-subtest-todo.t +S24-testing/13-cmp-ok.t S24-testing/line-numbers.t S26-documentation/01-delimited.t S26-documentation/02-paragraph.t From 1b9638e2b5dd36f3d7998e798cc13b06cfee07a1 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sun, 1 Oct 2017 14:58:31 +0000 Subject: [PATCH 247/692] Make List.ACCEPTS non-fatal for lazy iterables Since we tend to never die in our other ACCEPTS --- src/core/List.pm | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/core/List.pm b/src/core/List.pm index 8bedef1951b..f4472dbc13a 100644 --- a/src/core/List.pm +++ b/src/core/List.pm @@ -647,6 +647,9 @@ my class List does Iterable does Positional { # declared in BOOTSTRAP } multi method ACCEPTS(List:D: $topic) { + CATCH { default { return False } } # .elems on lazies throws + return True if nqp::eqaddr(self, nqp::decont($topic)); + unless nqp::istype($topic, Iterable) { return self unless self.elems; return self if nqp::istype(self[0], Match); From 4ca1fc3c163a7263ed750fec1dfa46a3a7928827 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sun, 1 Oct 2017 16:18:32 +0000 Subject: [PATCH 248/692] =?UTF-8?q?Fix=20regex=20`**`=20with=20non-Int=20v?= =?UTF-8?q?alues=E2=80=A6?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit …leaving behind unhandled Failures --- src/core/Match.pm | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/src/core/Match.pm b/src/core/Match.pm index 86df68d3e61..a496e8c5ee7 100644 --- a/src/core/Match.pm +++ b/src/core/Match.pm @@ -447,13 +447,15 @@ my class Match is Capture is Cool does NQPMatchRole { nqp::list_i($min,$max))))))), nqp::if( nqp::istype((my $v := $mm.Int), Failure), - nqp::if( - nqp::istype($mm,Numeric) && nqp::isfalse($mm.isNaN), + nqp::stmts( + ($v.so), # handle Failure nqp::if( - $mm == Inf, - X::Syntax::Regex::QuantifierValue.new(:inf).throw, - nqp::list_i(0,0)), # if we got here, $mm is -Inf, treat as zero - X::Syntax::Regex::QuantifierValue.new(:non-numeric).throw), + nqp::istype($mm,Numeric) && nqp::isfalse($mm.isNaN), + nqp::if( + $mm == Inf, + X::Syntax::Regex::QuantifierValue.new(:inf).throw, + nqp::list_i(0,0)), # if we got here, $mm is -Inf, treat as zero + X::Syntax::Regex::QuantifierValue.new(:non-numeric).throw)), nqp::if( nqp::islt_i($v,0), nqp::list_i(0,0), From 11070e0feecadbb93eb3148812d563829e2a211b Mon Sep 17 00:00:00 2001 From: skids Date: Sun, 1 Oct 2017 12:29:36 -0400 Subject: [PATCH 249/692] Fix some unspace parsing cases (RT#128462 and degenerate unspace) see RT for analysis/explanation --- src/Perl6/Grammar.nqp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Perl6/Grammar.nqp b/src/Perl6/Grammar.nqp index f4303361bdf..8a4a8da768e 100644 --- a/src/Perl6/Grammar.nqp +++ b/src/Perl6/Grammar.nqp @@ -3344,7 +3344,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD { token term:sym { :my $pos; - ]) }> |'('> + ]) }> [ ? '('> | \\ ] { $pos := $/.pos } { @@ -3422,7 +3422,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD { } } [ ]? - || + || [ \\ ]? { if !$ { my $name := ~$; From 4fae0711ef2f465723ec7b9c3f6306166945e213 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sun, 1 Oct 2017 21:02:46 +0200 Subject: [PATCH 250/692] We actually don't need an nqp::stmts for accessors This probably doesn't mean much in the scale of things, but it *does* happen at compilation for every public attribute. --- src/Perl6/World.nqp | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index 563d9026627..5794de3271b 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -3006,7 +3006,7 @@ class Perl6::World is HLL::World { # Set up the actual statements, starting with "self" # nqp::attribute(self,$package_type,$attr_name) - my $stmts := QAST::Var.new( + my $accessor := QAST::Var.new( :scope($native && $rw ?? 'attributeref' !! 'attribute'), :name($attr_name), :returns($type), @@ -3016,7 +3016,7 @@ class Perl6::World is HLL::World { # Opaque and read-only accessors need a decont unless $native || $rw { - $stmts := QAST::Op.new( :op, $stmts ); + $accessor := QAST::Op.new( :op, $accessor ); } # Create the block @@ -3024,7 +3024,7 @@ class Perl6::World is HLL::World { :name($meth_name), :blocktype('declaration_static'), QAST::Stmts.new( $pself, $p_ ), - QAST::Stmts.new($stmts) + $accessor ); # Make sure the block has a SC From 92f239b5570278e9eb1d45ce6bbc710d0af6180c Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Mon, 2 Oct 2017 12:56:25 +0200 Subject: [PATCH 251/692] Attributes set from nqp land wind up unhllized - circumvent the issue by making the attributes natives - fixes failures in S32-str/sprintf.t that occurred since BUILDALL refactor --- src/core/Exception.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/Exception.pm b/src/core/Exception.pm index 67b021d6b66..3350e3d2ca0 100644 --- a/src/core/Exception.pm +++ b/src/core/Exception.pm @@ -2007,8 +2007,8 @@ my class X::Str::Trans::InvalidArg is Exception { } my class X::Str::Sprintf::Directives::Count is Exception { - has $.args-used; - has $.args-have; + has int $.args-used; + has num $.args-have; method message() { "Your printf-style directives specify " ~ ($.args-used == 1 ?? "1 argument, but " From 7fa707db73474ec6e6693f3c71e75bddb961bbda Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Mon, 2 Oct 2017 13:23:37 +0200 Subject: [PATCH 252/692] We shouldn't let BUILDALL installation fail silently We want to be able to remove the actual BUILDALLPLAN from memory once the method is installed. --- src/Perl6/Metamodel/ClassHOW.nqp | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/Perl6/Metamodel/ClassHOW.nqp b/src/Perl6/Metamodel/ClassHOW.nqp index df8f6dde372..15730b04386 100644 --- a/src/Perl6/Metamodel/ClassHOW.nqp +++ b/src/Perl6/Metamodel/ClassHOW.nqp @@ -163,9 +163,7 @@ class Perl6::Metamodel::ClassHOW $builder($compiler_services,$obj,$BUILDALLPLAN); unless $method =:= NQPMu { $method.set_name('BUILDALL'); - my $result := try { - self.add_method($obj,'BUILDALL',$method); - } + self.add_method($obj,'BUILDALL',$method); } } } From d76af6aa45600abbfe8b555c5701f14d6cc80a57 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Mon, 2 Oct 2017 13:59:10 +0200 Subject: [PATCH 253/692] Make the use-case a native str If we get one passed from NQP land, e.g. with "BEGIN die", we can handle it. This is another ad-hoc fix for an apparent change in behaviour between autogenerated BUILDALL and Mu.BUILDALL. --- src/core/Exception.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/Exception.pm b/src/core/Exception.pm index 3350e3d2ca0..55e0eed7958 100644 --- a/src/core/Exception.pm +++ b/src/core/Exception.pm @@ -733,7 +733,7 @@ my class X::Comp::Group is Exception { my role X::MOP is Exception { } my class X::Comp::BeginTime does X::Comp { - has $.use-case; + has str $.use-case; has $.exception; method message() { From e513b857c0157b5254053194dede7d6936fe25dd Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Mon, 2 Oct 2017 14:15:31 +0200 Subject: [PATCH 254/692] Should check both (sub)method tables for BUILDALL - because a class could have a custom method BUILDALL - also fix typo in name, spotted by timotimo++ --- src/Perl6/Metamodel/ClassHOW.nqp | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/src/Perl6/Metamodel/ClassHOW.nqp b/src/Perl6/Metamodel/ClassHOW.nqp index 15730b04386..5c32f04dc82 100644 --- a/src/Perl6/Metamodel/ClassHOW.nqp +++ b/src/Perl6/Metamodel/ClassHOW.nqp @@ -153,14 +153,16 @@ class Perl6::Metamodel::ClassHOW # Mu will be used, which will iterate over the BUILDALLPLAN at # runtime). if nqp::isconcrete($compiler_services) { - if nqp::existskey($obj.HOW.method_table($obj),'BUILDPLAN') { - nqp::say($obj.HOW.name($obj) ~ ' already has a BUILDALL'); - } - else { + + # Class does not appear to have a BUILDALL yet + unless nqp::existskey($obj.HOW.submethod_table($obj),'BUILDALL') + || nqp::existskey($obj.HOW.method_table($obj),'BUILDALL') { my $builder := nqp::findmethod( $compiler_services,'generate_buildplan_executor'); my $method := $builder($compiler_services,$obj,$BUILDALLPLAN); + + # We have a generated BUILDALL submethod, so install! unless $method =:= NQPMu { $method.set_name('BUILDALL'); self.add_method($obj,'BUILDALL',$method); From 4906a1de8ae7d3740a5f59975cb8c16def7ede12 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Mon, 2 Oct 2017 09:27:14 -0400 Subject: [PATCH 255/692] Fix &chdir failing to respect :CWD attribute The method simply uses Str() coercion, but .Str on IO::Paths ignores their :CWD attribute, which causes &chdir into such IO::Paths to chdir into the wrong dir. --- src/core/IO/Path.pm | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/core/IO/Path.pm b/src/core/IO/Path.pm index c1baace2df2..39cc963b6b1 100644 --- a/src/core/IO/Path.pm +++ b/src/core/IO/Path.pm @@ -408,6 +408,9 @@ my class IO::Path is Cool does IO { ); self.chdir: $path, |$test.words.map(* => True).Hash; } + multi method chdir(IO::Path:D: IO $path, |c) { + self.chdir: $path.absolute, |c + } multi method chdir( IO::Path:D: Str() $path is copy, :$d = True, :$r, :$w, :$x, ) { From f80a84617b4a72685486d2ddf4f6e887bac30f7b Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Mon, 2 Oct 2017 17:13:12 +0200 Subject: [PATCH 256/692] Only fetch BUILDALLPLAN if we need it --- src/Perl6/Metamodel/ClassHOW.nqp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Perl6/Metamodel/ClassHOW.nqp b/src/Perl6/Metamodel/ClassHOW.nqp index 5c32f04dc82..a9ed54cf448 100644 --- a/src/Perl6/Metamodel/ClassHOW.nqp +++ b/src/Perl6/Metamodel/ClassHOW.nqp @@ -147,7 +147,7 @@ class Perl6::Metamodel::ClassHOW unless $was_composed { # Create BUILDPLAN. - my $BUILDALLPLAN := self.create_BUILDPLAN($obj); + self.create_BUILDPLAN($obj); # Create BUILDALL method if we can (if we can't, the one from # Mu will be used, which will iterate over the BUILDALLPLAN at @@ -160,7 +160,7 @@ class Perl6::Metamodel::ClassHOW my $builder := nqp::findmethod( $compiler_services,'generate_buildplan_executor'); my $method := - $builder($compiler_services,$obj,$BUILDALLPLAN); + $builder($compiler_services,$obj,self.BUILDALLPLAN($obj)); # We have a generated BUILDALL submethod, so install! unless $method =:= NQPMu { From fcbd8adbe586e21c8bcd6ac7bb319b84136d6fc0 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Mon, 2 Oct 2017 18:24:58 +0200 Subject: [PATCH 257/692] Make only one CompilerServices instance per World We have to clean it up at the end of compilation; failing to do so can break precompilation. --- src/Perl6/World.nqp | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index 5794de3271b..afcf48614e0 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -3483,12 +3483,14 @@ class Perl6::World is HLL::World { } method get_compiler_services() { - try { - my $wtype := self.find_symbol(['Rakudo', 'Internals', 'CompilerServices']); - my $wrapped := CompilerServices.new(w => self); - my $wrapper := nqp::create($wtype); - nqp::bindattr($wrapper, $wtype, '$!compiler', $wrapped); - $!compiler_services := $wrapper; + unless nqp::isconcrete($!compiler_services) { + try { + my $wtype := self.find_symbol(['Rakudo', 'Internals', 'CompilerServices']); + my $wrapped := CompilerServices.new(w => self); + my $wrapper := nqp::create($wtype); + nqp::bindattr($wrapper, $wtype, '$!compiler', $wrapped); + $!compiler_services := $wrapper; + } } $!compiler_services } From 21788c89094020faa9a0ac9bbf87fda87f6585e8 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Tue, 3 Oct 2017 10:30:35 +0200 Subject: [PATCH 258/692] Make all classes with empty BUILDALLPLAN share BUILDALL - so they don't need to go to Mu.BUILDALL and run the plan --- src/Perl6/World.nqp | 373 ++++++++++++++++++++++++-------------------- 1 file changed, 203 insertions(+), 170 deletions(-) diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index afcf48614e0..20f1e26d1bb 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -2968,6 +2968,9 @@ class Perl6::World is HLL::World { has $!acc_sig_cache; has $!acc_sig_cache_type; + # The generic BUILDALL method for empty BUILDPLANs + has $!empty_buildplan_method; + # Parameters we always need my $pself := QAST::Var.new(:decl, :scope, :name); my $pauto := QAST::Var.new(:decl, :scope, :name<@auto>); @@ -3081,85 +3084,130 @@ class Perl6::World is HLL::World { '$!reified' ); - # No buildplan? we're done! - my int $count := nqp::elems($build_plan); - unless $count { - - # Indicate that we're not going to auto-generate a BUILDALL - # for this class, but let it be handled by Mu.BUILDALL. - return NQPMu; - } + if nqp::elems($build_plan) -> $count { - # The bare object - my $object := nqp::decont($in_object); + # The bare object + my $object := nqp::decont($in_object); - # Do we need to wrap an exception handler - my int $needs_wrapping; + # Do we need to wrap an exception handler + my int $needs_wrapping; - # The basic statements for object initialization, to be - # filled in later - my $stmts := QAST::Stmts.new(); + # The basic statements for object initialization, to be + # filled in later + my $stmts := QAST::Stmts.new(); - my $declarations := QAST::Stmts.new($pself, $pauto, $pinit, $dinit); + my $declarations := + QAST::Stmts.new($pself, $pauto, $pinit, $dinit); - # The block of the method - my $block := QAST::Block.new( - :name, :blocktype, - $declarations - ); + # The block of the method + my $block := QAST::Block.new( + :name, :blocktype, + $declarations + ); - # Register the block in its SC - $!w.cur_lexpad()[0].push($block); + # Register the block in its SC + $!w.cur_lexpad()[0].push($block); - # Create the invocant type we need - my $invocant_type := $!w.create_definite_type( - $!w.find_symbol(['Metamodel','DefiniteHOW']), - $object, - 1 - ); + # Create the invocant type we need + my $invocant_type := $!w.create_definite_type( + $!w.find_symbol(['Metamodel','DefiniteHOW']), + $object, + 1 + ); - # Debugging -# $stmts.push( -# QAST::Op.new( :op, -# QAST::SVal.new( :value( -# $object.HOW.name($object) ~ '.BUILDALL called' -# )) -# ), -# ); -# $stmts.push( -# QAST::Op.new( :op, -# QAST::Op.new( :op, :name, $hllinit ) -# ) -# ); + # Debugging +# $stmts.push( +# QAST::Op.new( :op, +# QAST::SVal.new( :value( +# $object.HOW.name($object) ~ '.BUILDALL called' +# )) +# ), +# ); +# $stmts.push( +# QAST::Op.new( :op, +# QAST::Op.new( :op, :name, $hllinit ) +# ) +# ); # my $init := nqp::getattr(%init,Map,'$!storage') - $stmts.push(QAST::Op.new( :op, - $init, - QAST::Op.new( :op, - $hllinit, - QAST::WVal.new( :value($!w.find_symbol(['Map'])) ), - $storage - ) - )); + $stmts.push(QAST::Op.new( :op, + $init, + QAST::Op.new( :op, + $hllinit, + QAST::WVal.new( :value($!w.find_symbol(['Map'])) ), + $storage + ) + )); + + # Do all of the actions in the BUILDPLAN + my int $i := -1; + while nqp::islt_i($i := nqp::add_i($i, 1), $count) { + + # We have some intricate action to do + if nqp::islist(my $task := nqp::atpos($build_plan,$i)) { + + # Register the class in the SC if needed + $!w.add_object_if_no_sc( nqp::atpos($task,1) ); + + # We always need the class object & full attribute name + my $class := + QAST::WVal.new( :value(nqp::atpos($task,1)) ); + my $attr := + QAST::SVal.new( :value(nqp::atpos($task,2)) ); + + my int $code := nqp::atpos($task,0); + # 0 = initialize opaque from %init + if $code == 0 { + +# 'a' + my $key := + QAST::SVal.new( :value(nqp::atpos($task,3)) ); + +# nqp::getattr(self,Foo,'$!a') + my $getattr := QAST::Op.new( :op, + $self, $class, $attr + ); + +# nqp::if( +# nqp::existskey($init,'a'), + my $if := QAST::Op.new( :op, + QAST::Op.new( :op, $init, $key) + ); - # Do all of the actions in the BUILDPLAN - my int $i := -1; - while nqp::islt_i($i := nqp::add_i($i, 1), $count) { +# %init.AT-KEY('a') + my $value := QAST::Op.new( :op, + :name, $hllinit, $key + ); - # We have some intricate action to do - if nqp::islist(my $task := nqp::atpos($build_plan,$i)) { + my $sigil := nqp::substr(nqp::atpos($task,2),0,1); - # Register the class in the SC if needed - $!w.add_object_if_no_sc( nqp::atpos($task,1) ); +# nqp::getattr(self,Foo,'$!a').STORE(%init.AT-KEY('a')) + if $sigil eq '@' || $sigil eq '%' { + $if.push( + QAST::Op.new( :op, :name, + $getattr, $value + ) + ); + } - # We always need the class object and full attribute name - my $class := QAST::WVal.new( :value(nqp::atpos($task,1)) ); - my $attr := QAST::SVal.new( :value(nqp::atpos($task,2)) ); +# nqp::getattr(self,Foo,'$!a') = %init.AT-KEY('a') + else { + $if.push( + QAST::Op.new( + :op( $sigil eq '$' || $sigil eq '&' + ?? 'assign' !! 'p6store' + ), + $getattr, $value + ) + ); + } - if nqp::atpos($task,0) -> $code { +# ), + $stmts.push($if); + } # 1,2,3 = initialize native from %init - if $code < 4 { + elsif $code < 4 { # nqp::if( # nqp::existskey($init,'a'), @@ -3345,66 +3393,16 @@ class Perl6::World is HLL::World { } } - # 0 = initialize opaque from %init + # BUILD/TWEAK else { -# 'a' - my $key := QAST::SVal.new(:value(nqp::atpos($task,3))); - -# nqp::getattr(self,Foo,'$!a') - my $getattr := QAST::Op.new( :op, - $self, $class, $attr - ); - -# nqp::if( -# nqp::existskey($init,'a'), - my $if := QAST::Op.new( :op, - QAST::Op.new( :op, $init, $key) - ); - -# %init.AT-KEY('a') - my $value := QAST::Op.new(:op,:name, - $hllinit, $key - ); - - my $sigil := nqp::substr(nqp::atpos($task,2),0,1); - -# nqp::getattr(self,Foo,'$!a').STORE(%init.AT-KEY('a')) - if $sigil eq '@' || $sigil eq '%' { - $if.push( - QAST::Op.new( :op, :name, - $getattr, $value - ) - ); - } - -# nqp::getattr(self,Foo,'$!a') = %init.AT-KEY('a') - else { - $if.push( - QAST::Op.new( - :op( $sigil eq '$' || $sigil eq '&' - ?? 'assign' !! 'p6store' - ), - $getattr, $value - ) - ); - } - -# ), - $stmts.push($if); - } - } - - # BUILD/TWEAK - else { - - # BUILD or TWEAK without BUILD (first seen) - unless $needs_wrapping { + # BUILD or TWEAK without BUILD (first seen) + unless $needs_wrapping { # (my $return), - $declarations.push($dreturn); - $needs_wrapping := 1 - }; + $declarations.push($dreturn); + $needs_wrapping := 1 + } # nqp::if( # nqp::istype( @@ -3417,75 +3415,110 @@ class Perl6::World is HLL::World { # ), # return $return # ), - $stmts.push( - QAST::Op.new( :op, - QAST::Op.new( :op, - QAST::Op.new( :op, - $return, - QAST::Op.new( :op, - QAST::Op.new( :op, $init ), - QAST::Op.new( :op, - QAST::WVal.new( :value($task) ), - $self, - QAST::Var.new( - :scope, - :name, # use nqp::hash directly - :flat(1), - :named(1) - ), + $stmts.push( + QAST::Op.new( :op, + QAST::Op.new( :op, + QAST::Op.new( :op, + $return, + QAST::Op.new( :op, + QAST::Op.new( :op, $init ), + QAST::Op.new( :op, + QAST::WVal.new( :value($task) ), + $self, + QAST::Var.new( + :scope, + :name, # use nqp::hash directly + :flat(1), + :named(1) + ), + ), + QAST::Op.new( :op, + QAST::WVal.new( :value($task) ), + $self, + ) + ) ), - QAST::Op.new( :op, - QAST::WVal.new( :value($task) ), - $self, - ) + QAST::WVal.new( + :value($!w.find_symbol(['Failure'])) + ), + ), + QAST::Op.new( :op, + QAST::WVal.new( + :value($!w.find_symbol(['&return'])) + ), + QAST::Var.new(:scope, :name) ) - ), - QAST::WVal.new( - :value($!w.find_symbol(['Failure'])) - ), - ), - QAST::Op.new( :op, - QAST::WVal.new( - :value($!w.find_symbol(['&return'])) - ), - QAST::Var.new(:scope, :name) - ) - ) - ); + ) + ); - $!w.add_object_if_no_sc($task); + $!w.add_object_if_no_sc($task); + } + } + + # Finally, add the return value + $stmts.push($self); + + # Need to wrap an exception handler around + if $needs_wrapping { + $stmts := QAST::Op.new( :op, + $stmts, + 'RETURN', + QAST::Op.new( :op ) + ); } - } - # Finally, add the return value - $stmts.push($self); + # Add the statements to the block + $block.push($stmts); - # Need to wrap an exception handler around - if $needs_wrapping { - $stmts := QAST::Op.new( :op, - $stmts, - 'RETURN', - QAST::Op.new( :op ) +# :(Foo:D: %init) + my $sig := $!w.create_signature_and_params( + NQPMu, %sig_init, $block, 'Any', :method, :$invocant_type ); + + # Create the code object and return it + $!w.create_code_object($block, 'Submethod', $sig) } - # Add the statements to the block - $block.push($stmts); + # Empty buildplan, and we already have an empty buildplan method + elsif $!empty_buildplan_method { + $!empty_buildplan_method + } -# :(Foo:D: %init) - my $sig := $!w.create_signature_and_params( - NQPMu, %sig_init, $block, 'Any', :method, :$invocant_type - ); + # Empty buildplan, still need to make an empty method + else { + +# submethod :: (Any:D:) { self } + my $block := QAST::Block.new( + :name, :blocktype, + QAST::Stmts.new($pself, $pauto, $pinit), + $self + ); + + # Register the block in its SC + $!w.cur_lexpad()[0].push($block); + + my $invocant_type := $!w.create_definite_type( + $!w.find_symbol(['Metamodel','DefiniteHOW']), + $!w.find_symbol(['Any']), + 1 + ); - # Create the code object and return it - $!w.create_code_object($block, 'Submethod', $sig) + my $sig := $!w.create_signature_and_params( + NQPMu, %sig_init, $block, 'Any', :method, :$invocant_type + ); + + # Create the code object, save and return it + $!empty_buildplan_method := + $!w.create_code_object($block, 'Submethod', $sig) + } } } method get_compiler_services() { unless nqp::isconcrete($!compiler_services) { try { - my $wtype := self.find_symbol(['Rakudo', 'Internals', 'CompilerServices']); + my $wtype := + self.find_symbol(['Rakudo','Internals','CompilerServices']); my $wrapped := CompilerServices.new(w => self); my $wrapper := nqp::create($wtype); nqp::bindattr($wrapper, $wtype, '$!compiler', $wrapped); From e2f8a57dcc04f6a53e785fabd45c2ae25a199261 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Tue, 3 Oct 2017 12:31:08 +0200 Subject: [PATCH 259/692] Make sure all empty BUILDPLANs are shared - this should save a bit of memory for each class created --- src/Perl6/Metamodel/BUILDPLAN.nqp | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/src/Perl6/Metamodel/BUILDPLAN.nqp b/src/Perl6/Metamodel/BUILDPLAN.nqp index 19823bb331e..bd025509b1c 100644 --- a/src/Perl6/Metamodel/BUILDPLAN.nqp +++ b/src/Perl6/Metamodel/BUILDPLAN.nqp @@ -2,6 +2,9 @@ role Perl6::Metamodel::BUILDPLAN { has @!BUILDALLPLAN; has @!BUILDPLAN; + # Empty BUILDPLAN shared by all classes with empty BUILDPLANs + my @EMPTY := nqp::list; + # Creates the plan for building up the object. This works # out what we'll need to do up front, so we can just zip # through the "todo list" each time we need to make an object. @@ -101,7 +104,7 @@ role Perl6::Metamodel::BUILDPLAN { } # Install plan for this class. - @!BUILDPLAN := @plan; + @!BUILDPLAN := +@plan ?? @plan !! @EMPTY; # Now create the full plan by getting the MRO, and working from # least derived to most derived, copying the plans. @@ -123,7 +126,9 @@ role Perl6::Metamodel::BUILDPLAN { } # if same number of elems and no noops, identical, so just keep 1 copy - @!BUILDALLPLAN := $noops || +@all_plan != +@plan ?? @all_plan !! @plan; + @!BUILDALLPLAN := $noops || +@all_plan != +@plan + ?? @all_plan + !! @!BUILDPLAN; # if empty, shared across classes } method BUILDPLAN($obj) { From b58bd8fb1e2e0a72f0914938e79201969a4a94c0 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Tue, 3 Oct 2017 13:06:35 +0200 Subject: [PATCH 260/692] Additional BUILDPLAN sharing - if a class has an empty BUILDPLAN, it will not add to the BUILDALLPLAN - therefore its BUILDALLPLAN is the same as its first parent in MRO This should save memory for all mixins that don't add any attributes. --- src/Perl6/Metamodel/BUILDPLAN.nqp | 61 ++++++++++++++++++++----------- 1 file changed, 39 insertions(+), 22 deletions(-) diff --git a/src/Perl6/Metamodel/BUILDPLAN.nqp b/src/Perl6/Metamodel/BUILDPLAN.nqp index bd025509b1c..2111ee56fcc 100644 --- a/src/Perl6/Metamodel/BUILDPLAN.nqp +++ b/src/Perl6/Metamodel/BUILDPLAN.nqp @@ -103,32 +103,49 @@ role Perl6::Metamodel::BUILDPLAN { nqp::push(@plan,$TWEAK); } - # Install plan for this class. - @!BUILDPLAN := +@plan ?? @plan !! @EMPTY; - - # Now create the full plan by getting the MRO, and working from - # least derived to most derived, copying the plans. - my @all_plan; - my @mro := self.mro($obj); - my $i := +@mro; - my $noops := 0; - while $i > 0 { - $i := $i - 1; - my $class := @mro[$i]; - for $class.HOW.BUILDPLAN($class) { - if nqp::islist($_) && $_[0] == 10 { # noop in BUILDALLPLAN - $noops := 1; - } - else { - nqp::push(@all_plan, $_); + # Something in the buildplan of this class + if @plan { + + # Install plan for this class. + @!BUILDPLAN := @plan; + + # Now create the full plan by getting the MRO, and working from + # least derived to most derived, copying the plans. + my @all_plan; + my @mro := self.mro($obj); + my $i := +@mro; + my $noops := 0; + while $i > 0 { + $i := $i - 1; + my $class := @mro[$i]; + for $class.HOW.BUILDPLAN($class) { + if nqp::islist($_) && $_[0] == 10 { # noop in BUILDALLPLAN + $noops := 1; + } + else { + nqp::push(@all_plan, $_); + } } } + + # Same number of elems and no noops, identical, so just keep 1 copy + @!BUILDALLPLAN := $noops || +@all_plan != +@plan + ?? @all_plan + !! @plan } - # if same number of elems and no noops, identical, so just keep 1 copy - @!BUILDALLPLAN := $noops || +@all_plan != +@plan - ?? @all_plan - !! @!BUILDPLAN; # if empty, shared across classes + # BUILDPLAN of class itself is empty + else { + + # Share the empty BUILDPLAN + @!BUILDPLAN := @EMPTY; + + # Take the first "super"class's BUILDALLPLAN if possible + my @mro := self.mro($obj); + @!BUILDALLPLAN := +@mro > 1 + ?? @mro[1].HOW.BUILDALLPLAN(@mro[1]) + !! @EMPTY + } } method BUILDPLAN($obj) { From 0dd6af716d7e0763df6a3e77924dc989c1630c9d Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Tue, 3 Oct 2017 13:42:40 +0200 Subject: [PATCH 261/692] Set up auto-generated signature correctly - the first array parameter was set up correctly in declarations - but not in the signature, so introspection showed you the wrong thing --- src/Perl6/World.nqp | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index 20f1e26d1bb..0ccab0f29f8 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -2994,7 +2994,10 @@ class Perl6::World is HLL::World { # signature configuration hashes my %sig_empty := nqp::hash('parameters', []); # :() my %sig_init := nqp::hash( - 'parameters', [nqp::hash('variable_name','%init')] + 'parameters', [ + nqp::hash('variable_name','@auto'), + nqp::hash('variable_name','%init') + ] ); # Generate an accessor method with the given method name, package, From f946bd35dca39af97983ec95d4da7fdd0416b73d Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Tue, 3 Oct 2017 14:52:31 +0200 Subject: [PATCH 262/692] Don't bother with BUILDALL if BUILDPLAN is empty - because the next class with a BUILDALL in ^mro will do the right thing --- src/Perl6/Metamodel/ClassHOW.nqp | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/src/Perl6/Metamodel/ClassHOW.nqp b/src/Perl6/Metamodel/ClassHOW.nqp index a9ed54cf448..e9e05f01783 100644 --- a/src/Perl6/Metamodel/ClassHOW.nqp +++ b/src/Perl6/Metamodel/ClassHOW.nqp @@ -149,10 +149,13 @@ class Perl6::Metamodel::ClassHOW # Create BUILDPLAN. self.create_BUILDPLAN($obj); - # Create BUILDALL method if we can (if we can't, the one from - # Mu will be used, which will iterate over the BUILDALLPLAN at - # runtime). - if nqp::isconcrete($compiler_services) { + # If the BUILDPLAN is not empty, we should attempt to auto- + # generate a BUILDALL method. If the BUILDPLAN is empty, then + # the BUILDALL of the parent is already good enough. We can + # only auto-generate a BUILDALL method if we have compiler + # services. If we don't, then BUILDALL will fall back to the + # one in Mu, which will iterate over the BUILDALLPLAN. + if self.BUILDPLAN($obj) && nqp::isconcrete($compiler_services) { # Class does not appear to have a BUILDALL yet unless nqp::existskey($obj.HOW.submethod_table($obj),'BUILDALL') From c91c40115e59ff89570c5099b886d74ea3d4ef2c Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Tue, 3 Oct 2017 18:14:27 +0200 Subject: [PATCH 263/692] Eliminate dupe and slightly optimize cue * Only do a closure clone if we really need it * Use implicit return --- src/core/ThreadPoolScheduler.pm | 41 +++++++++++---------------------- 1 file changed, 14 insertions(+), 27 deletions(-) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index b7835e19dcf..6d1b9d3e419 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -593,6 +593,9 @@ my class ThreadPoolScheduler does Scheduler { if $every.defined and $times > 1 and &stop; my $delay = $at ?? $at - now !! $in // 0; + # Wrap any catch handler around the code to run. + my &run := &catch ?? wrap-catch(&code, &catch) !! &code; + # need repeating if $every { # generate a stopper if needed @@ -610,58 +613,42 @@ my class ThreadPoolScheduler does Scheduler { Cancellation.new(async_handles => [$handle]); } $handle := nqp::timer(self!timer-queue(), - &catch - ?? -> { - stop() - ?? cancellation().cancel - !! code(); - CATCH { default { catch($_) } }; - } - !! -> { - stop() - ?? cancellation().cancel - !! code(); - }, + { stop() ?? cancellation().cancel !! run() }, to-millis($delay), to-millis($every), TimerCancellation); - return cancellation() + cancellation() } # no stopper else { - my $handle := nqp::timer(self!timer-queue(), - &catch - ?? -> { code(); CATCH { default { catch($_) } } } - !! &code, + my $handle := nqp::timer(self!timer-queue(), &run, to-millis($delay), to-millis($every), TimerCancellation); - return Cancellation.new(async_handles => [$handle]); + Cancellation.new(async_handles => [$handle]) } } # only after waiting a bit or more than once elsif $delay or $times > 1 { - my $todo := &catch - ?? -> { code(); CATCH { default { catch($_) } } } - !! &code; my @async_handles; $delay = to-millis($delay) if $delay; @async_handles.push( - nqp::timer(self!timer-queue(), $todo, $delay, 0, TimerCancellation) + nqp::timer(self!timer-queue(), &run, $delay, 0, TimerCancellation) ) for 1 .. $times; - return Cancellation.new(:@async_handles); + Cancellation.new(:@async_handles) } # just cue the code else { - my &run := &catch - ?? -> { code(); CATCH { default { catch($_) } } } - !! &code; nqp::push(self!general-queue(), &run); - return Nil; + Nil } } + sub wrap-catch(&code, &catch) { + -> { code(); CATCH { default { catch($_) } } } + } + multi to-millis(Int $value) { 1000 * $value } From 2724a8514474c2f91f7236cfed7644df27d49f1e Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Tue, 3 Oct 2017 17:59:11 +0000 Subject: [PATCH 264/692] Bump NQP --- tools/build/NQP_REVISION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/build/NQP_REVISION b/tools/build/NQP_REVISION index d74c176f98c..f2311bf4b5d 100644 --- a/tools/build/NQP_REVISION +++ b/tools/build/NQP_REVISION @@ -1 +1 @@ -2017.09-38-ga0618a6 +2017.09-40-ga6a1aa0 From fa8fe84b2ff5ec86a6c606499c13cc2e93ddaa95 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Tue, 3 Oct 2017 21:15:02 +0200 Subject: [PATCH 265/692] Make dynamic variable debugging simpler --- src/core/Rakudo/Internals.pm | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/src/core/Rakudo/Internals.pm b/src/core/Rakudo/Internals.pm index 21190ad22af..1bbf38698e7 100644 --- a/src/core/Rakudo/Internals.pm +++ b/src/core/Rakudo/Internals.pm @@ -887,9 +887,7 @@ my class Rakudo::Internals { #method INITIALIZERS() { $initializers } method REGISTER-DYNAMIC(Str:D \name, &code, Str $version = '6.c' --> Nil) { -#nqp::print("Registering "); -#nqp::print(name); -#nqp::print("\n"); +#nqp::say('Registering ' ~ name); nqp::stmts( (my str $with = nqp::concat($version, nqp::concat("\0", name))), nqp::if( @@ -907,9 +905,7 @@ my class Rakudo::Internals { ) } method INITIALIZE-DYNAMIC(str \name) is raw { -#nqp::print("Initializing"); -#nqp::print(name); -#nqp::print("\n"); +#nqp::say('Initializing ' ~ name); nqp::stmts( (my str $with = nqp::concat( nqp::getcomp('perl6').language_version, nqp::concat("\0", name))), From df5899d7df640fcc232e9c1cb1089bf49fc5a0a6 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Tue, 3 Oct 2017 23:18:57 +0200 Subject: [PATCH 266/692] Promise is already stubbed at this time --- src/core/HyperSeq.pm | 1 - 1 file changed, 1 deletion(-) diff --git a/src/core/HyperSeq.pm b/src/core/HyperSeq.pm index dc8bba12498..6d9c4949850 100644 --- a/src/core/HyperSeq.pm +++ b/src/core/HyperSeq.pm @@ -3,7 +3,6 @@ # does for its iterator. If you ask for its iterator, then you are ending the # declaration of a chain of parallelizable operations. That is, in fact, the # thing that will actually kick off the parallel work. -my class Promise { ... } my class HyperSeq does Iterable does HyperIterable does PositionalBindFailover { has HyperIterator $!hyper-iter; From 98fae3d84efeb6dedeb4881ea339b634311b807f Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Tue, 3 Oct 2017 23:19:28 +0200 Subject: [PATCH 267/692] Move up initialization of %*ENV and $*SCHEDULER - these were being requested at each startup before being initialized - saves creation of 2 X::Dynamic::NotFounds and 2x Failure --- src/core/Env.pm | 2 -- src/core/ThreadPoolScheduler.pm | 3 --- src/core/core_prologue.pm | 7 +++++++ 3 files changed, 7 insertions(+), 5 deletions(-) diff --git a/src/core/Env.pm b/src/core/Env.pm index 9f14d15df2c..01d14c85675 100644 --- a/src/core/Env.pm +++ b/src/core/Env.pm @@ -1,5 +1,3 @@ -PROCESS::<%ENV> := Rakudo::Internals.createENV(0); - Rakudo::Internals.REGISTER-DYNAMIC: '$*CWD', { # PROCESS::<$CWD> = nqp::p6box_s(nqp::cwd()); my $CWD := nqp::p6box_s(nqp::cwd()); diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index 6d1b9d3e419..f054a8a69cc 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -671,7 +671,4 @@ my class ThreadPoolScheduler does Scheduler { } } -# This thread pool scheduler will be the default one. -PROCESS::<$SCHEDULER> = ThreadPoolScheduler.new(); - # vim: ft=perl6 expandtab sw=4 diff --git a/src/core/core_prologue.pm b/src/core/core_prologue.pm index ca50af6e114..e7fb1c76987 100644 --- a/src/core/core_prologue.pm +++ b/src/core/core_prologue.pm @@ -8,6 +8,7 @@ my class Failure { ... } my class Rakudo::Internals { ... } my class Rakudo::Internals::JSON { ... } my class Rakudo::Iterator { ... } +my class ThreadPoolScheduler { ... } my class X::Numeric::Overflow { ... } my class X::Numeric::Underflow { ... } @@ -35,4 +36,10 @@ my class Rakudo::Internals::IterationSet is repr('VMHash') { } # The value for \n. my constant $?NL = "\x0A"; +# Make sure we have an environment +PROCESS::<%ENV> := Rakudo::Internals.createENV(0); + +# This thread pool scheduler will be the default one. +PROCESS::<$SCHEDULER> = ThreadPoolScheduler.new(); + # vim: ft=perl6 expandtab sw=4 From 5c96d554c0ce49ba1e56a7a8ef950ba4d4304344 Mon Sep 17 00:00:00 2001 From: skids Date: Tue, 3 Oct 2017 21:44:19 -0400 Subject: [PATCH 268/692] Implement metamethod shorthand syntax (RT#131478) Silence Perl5 warning on $. Create a faux non-multipart-name desigilname token Teach dissect_longname to digest said token Teach variable action to generate a p6callmethodhow Adjust parsing to handle the meta thrigil --- src/Perl6/Actions.nqp | 9 ++++- src/Perl6/Grammar.nqp | 10 +++-- src/Perl6/World.nqp | 93 ++++++++++++++++++++++--------------------- 3 files changed, 62 insertions(+), 50 deletions(-) diff --git a/src/Perl6/Actions.nqp b/src/Perl6/Actions.nqp index a70e4b20a8e..8b4882b4deb 100644 --- a/src/Perl6/Actions.nqp +++ b/src/Perl6/Actions.nqp @@ -2706,7 +2706,7 @@ class Perl6::Actions is HLL::Actions does STDActions { setup_attr_var($/, $past); } } - elsif $twigil eq '.' && $*IN_DECL ne 'variable' { + elsif ($twigil eq '.' || $twigil eq '.^') && $*IN_DECL ne 'variable' { if !$*HAS_SELF { $*W.throw($/, ['X', 'Syntax', 'NoSelf'], variable => $name); } elsif $*HAS_SELF eq 'partial' { @@ -2714,7 +2714,12 @@ class Perl6::Actions is HLL::Actions does STDActions { } # Need to transform this to a method call. $past := $ ?? $.ast !! QAST::Op.new(); - $past.op('callmethod'); + if $twigil eq '.^' { + $past.op('p6callmethodhow'); + } + else { + $past.op('callmethod'); + } $past.name($desigilname); $past.unshift(QAST::Var.new( :name('self'), :scope('lexical') )); # Contextualize based on sigil. diff --git a/src/Perl6/Grammar.nqp b/src/Perl6/Grammar.nqp index 8a4a8da768e..5c4ffc031d3 100644 --- a/src/Perl6/Grammar.nqp +++ b/src/Perl6/Grammar.nqp @@ -2097,7 +2097,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD { } token special_variable:sym<$.> { - {} + {} <.obsvar('$.')> } @@ -2151,11 +2151,15 @@ grammar Perl6::Grammar is HLL::Grammar does STD { ] } + token desigilmetaname { + $=( $=( ) ) + } + token variable { :my $*IN_META := ''; [ | :dba('infix noun') '&[' ~ ']' - | ? + | [ $=['.^'] | ? ] [ ~ $ ~ $ }> { self.typed_panic: 'X::Syntax::Variable::Initializer', name => $*VARIABLE } ]? | @@ -2165,7 +2169,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD { | $=['$'] $=[<[/_!¢]>] | {} # try last, to allow sublanguages to redefine sigils (like & in regex) ] - [ && $ eq '.' }> + [ && ( $ eq '.' || $ eq '.^' ) }> [ <.unsp> | '\\' | ] ]? { $*LEFTSIGIL := nqp::substr(self.orig(), self.from, 1) unless $*LEFTSIGIL } diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index 0ccab0f29f8..ae8d7d54f10 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -4116,19 +4116,21 @@ class Perl6::World is HLL::World { if $name { @components.push(~$name); } - for $name { - if $_ { - @components.push(~$_); - } - elsif $_ { - my $EXPR := $_.ast; - @components.push($EXPR); - } - else { - # Either it's :: as a name entirely, in which case it's anon, - # or we're ending in ::, in which case it implies .WHO. - if +@components { - nqp::bindattr_i($result, LongName, '$!get_who', 1); + if $name { + for $name { + if $_ { + @components.push(~$_); + } + elsif $_ { + my $EXPR := $_.ast; + @components.push($EXPR); + } + else { + # Either it's :: as a name entirely, in which case it's anon, + # or we're ending in ::, in which case it implies .WHO. + if +@components { + nqp::bindattr_i($result, LongName, '$!get_who', 1); + } } } } @@ -4138,45 +4140,46 @@ class Perl6::World is HLL::World { # the last part of the name (e.g. for infix:<+>). Need to be a # little cheaty when compiling the setting due to bootstrapping. my @pairs; - for $longname { - if $_ && !$_ { - my $cp_str; - if $*COMPILING_CORE_SETTING { - my $ast := $_.ast; - - # XXX hackish for dealing with stuff, which - # doesn't get handled in a consistent way like - # stuff. The better solution, in the long run, is to - # uniformly run longname through nibble_to_str before this - if nqp::istype($ast, QAST::Op) && $ast.name eq '&val' { - $ast := $ast[0]; - } - if nqp::istype($ast, QAST::Want) && nqp::istype($ast[2], QAST::SVal) { - $cp_str := self.canonicalize_pair('',$ast[2].value); - } - elsif nqp::istype($ast, QAST::WVal) && - nqp::istype($ast.value, $*W.find_symbol(['Str'], :setting-only)) { - $cp_str := self.canonicalize_pair('', $ast.value); + if $longname { + for $longname { + if $_ && !$_ { + my $cp_str; + if $*COMPILING_CORE_SETTING { + my $ast := $_.ast; + + # XXX hackish for dealing with stuff, which + # doesn't get handled in a consistent way like + # stuff. The better solution, in the long run, is to + # uniformly run longname through nibble_to_str before this + if nqp::istype($ast, QAST::Op) && $ast.name eq '&val' { + $ast := $ast[0]; + } + if nqp::istype($ast, QAST::Want) && nqp::istype($ast[2], QAST::SVal) { + $cp_str := self.canonicalize_pair('',$ast[2].value); + } + elsif nqp::istype($ast, QAST::WVal) && + nqp::istype($ast.value, $*W.find_symbol(['Str'], :setting-only)) { + $cp_str := self.canonicalize_pair('', $ast.value); + } + else { + $cp_str := ~$_; + } } else { - $cp_str := ~$_; + # Safe to evaluate it directly; no bootstrap issues. + $cp_str := self.canonicalize_pair('',self.compile_time_evaluate($_, $_.ast)); + } + if +@components { + @components[+@components - 1] := @components[+@components - 1] ~ $cp_str; + } else { + @components[0] := $cp_str; } } - else { - # Safe to evaluate it directly; no bootstrap issues. - $cp_str := self.canonicalize_pair('',self.compile_time_evaluate($_, $_.ast)); - } - if +@components { - @components[+@components - 1] := @components[+@components - 1] ~ $cp_str; - } else { - @components[0] := $cp_str; + $_.ast.wanted(1); + @pairs.push($_); } } - else { - $_.ast.wanted(1); - @pairs.push($_); - } } nqp::bindattr($result, LongName, '@!colonpairs', @pairs); From 38186fcdf7d16441be2f3568f7dc24f0f1fc6294 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Wed, 4 Oct 2017 17:57:40 +0000 Subject: [PATCH 269/692] Improve error on Inf.base Fixes RT#125818: https://rt.perl.org/Ticket/Display.html?id=125818 --- src/core/Real.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/Real.pm b/src/core/Real.pm index ca5e6d2469c..f304a046730 100644 --- a/src/core/Real.pm +++ b/src/core/Real.pm @@ -89,7 +89,7 @@ my role Real does Numeric { :range<0..1073741824> ) if $digits.defined and $digits < 0; my $prec = $digits // 1e8.log($base.Num).Int; - my Int $int_part = self.Int; + my Int $int_part = self.Int.self; # .self blows up Failures my $frac = abs(self - $int_part); my @frac_digits; my @conversion := <0 1 2 3 4 5 6 7 8 9 From 2e7265282694dc65daa81aee61dbbde8e8d103f1 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Wed, 4 Oct 2017 19:00:58 +0000 Subject: [PATCH 270/692] Implement X::Numeric::CannotConvert exception It's a generic exception to throw when a numeric cannot be converted to something (gonna use it for Inf -> Int coercion). Ideally, X::Numeric::Real would be removed and this exception be used in its place, but there are 6.c-errata tests expecting X::Numeric::Real to exist, so I left it in as just an empty subclass of X::Numeric::CannotConvert --- src/core/Exception.pm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/core/Exception.pm b/src/core/Exception.pm index 55e0eed7958..868945b49a5 100644 --- a/src/core/Exception.pm +++ b/src/core/Exception.pm @@ -2404,7 +2404,7 @@ my class X::Import::Positional is Exception { } } -my class X::Numeric::Real is Exception { +my class X::Numeric::CannotConvert is Exception { has $.target; has $.reason; has $.source; @@ -2412,7 +2412,9 @@ my class X::Numeric::Real is Exception { method message() { "Cannot convert $.source to {$.target.^name}: $.reason"; } + } +my class X::Numeric::Real is X::Numeric::CannotConvert {} my class X::Numeric::DivideByZero is Exception { has $.using; From f04bd1d617f6001e38631786903beb3370ed68a6 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Wed, 4 Oct 2017 19:03:19 +0000 Subject: [PATCH 271/692] Fail with a typed exception when failing Num.Int --- src/core/Num.pm | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/core/Num.pm b/src/core/Num.pm index a992d08f125..42fb0fc0d44 100644 --- a/src/core/Num.pm +++ b/src/core/Num.pm @@ -1,5 +1,6 @@ -my class X::Numeric::DivideByZero { ... }; -my role Rational { ... }; +my class X::Numeric::DivideByZero { ... } +my class X::Numeric::CannotConvert { ... } +my role Rational { ... } my class Num does Real { # declared in BOOTSTRAP # class Num is Cool @@ -24,7 +25,7 @@ my class Num does Real { # declared in BOOTSTRAP method Int(Num:D:) { nqp::isnanorinf(nqp::unbox_n(self)) - ?? Failure.new("Cannot coerce {self} to an Int") + ?? X::Numeric::CannotConvert.new(:source(self), :target(Int)).fail !! nqp::fromnum_I(nqp::unbox_n(self),Int) } From cef3bf3e75411a5a664f93ea72209637eaaf5e3d Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Wed, 4 Oct 2017 23:03:53 +0200 Subject: [PATCH 272/692] Take 2 on getting $/ info into auto-generated methods - make sure we null out current-match at end of compilation as well - --profile now shows the line of the class definition --- src/Perl6/World.nqp | 21 ++++++++++++++------- src/core/Rakudo/Internals.pm | 6 ++++-- 2 files changed, 18 insertions(+), 9 deletions(-) diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index 0ccab0f29f8..1cc73f0c9a7 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -645,6 +645,7 @@ class Perl6::World is HLL::World { if $!compiler_services { my $cs := $!compiler_services; nqp::bindattr($cs, $cs.WHAT, '$!compiler', nqp::null()); + nqp::bindattr($cs, $cs.WHAT, '$!current-match', nqp::null()); } } @@ -2950,7 +2951,7 @@ class Perl6::World is HLL::World { # Composes the package, and stores an event for this action. method pkg_compose($/, $obj) { - my $compiler_services := self.get_compiler_services; + my $compiler_services := self.get_compiler_services($/); if nqp::isconcrete($compiler_services) { self.ex-handle($/, { $obj.HOW.compose($obj, :$compiler_services) }) } @@ -3004,7 +3005,7 @@ class Perl6::World is HLL::World { # attribute name, type of attribute and rw flag. Returns a code # object that can be installed as a method. method generate_accessor( - str $meth_name, $package_type, str $attr_name, $type, int $rw + $/, str $meth_name, $package_type, str $attr_name, $type, int $rw ) { # Is it a native attribute? (primpspec != 0) @@ -3029,7 +3030,7 @@ class Perl6::World is HLL::World { my $block := QAST::Block.new( :name($meth_name), :blocktype('declaration_static'), - QAST::Stmts.new( $pself, $p_ ), + QAST::Stmts.new( $pself, $p_, :node(nqp::decont($/)) ), $accessor ); @@ -3078,7 +3079,7 @@ class Perl6::World is HLL::World { # attributes. Basically a flattened version of Mu.BUILDALL, which # iterates over the BUILDALLPLAN at runtime with fewer inlining # and JITting opportunities. - method generate_buildplan_executor($in_object, $in_build_plan) { + method generate_buildplan_executor($/, $in_object, $in_build_plan) { # low level hash access my $build_plan := nqp::getattr( @@ -3097,7 +3098,7 @@ class Perl6::World is HLL::World { # The basic statements for object initialization, to be # filled in later - my $stmts := QAST::Stmts.new(); + my $stmts := QAST::Stmts.new(:node(nqp::decont($/))); my $declarations := QAST::Stmts.new($pself, $pauto, $pinit, $dinit); @@ -3517,14 +3518,20 @@ class Perl6::World is HLL::World { } } - method get_compiler_services() { - unless nqp::isconcrete($!compiler_services) { + method get_compiler_services($/) { + if nqp::isconcrete($!compiler_services) { + nqp::bindattr( + $!compiler_services,$!compiler_services.WHAT,'$!current-match',$/ + ); + } + else { try { my $wtype := self.find_symbol(['Rakudo','Internals','CompilerServices']); my $wrapped := CompilerServices.new(w => self); my $wrapper := nqp::create($wtype); nqp::bindattr($wrapper, $wtype, '$!compiler', $wrapped); + nqp::bindattr($wrapper, $wtype, '$!current-match', $/); $!compiler_services := $wrapper; } } diff --git a/src/core/Rakudo/Internals.pm b/src/core/Rakudo/Internals.pm index 1bbf38698e7..ee13be1d589 100644 --- a/src/core/Rakudo/Internals.pm +++ b/src/core/Rakudo/Internals.pm @@ -19,13 +19,15 @@ my class Rakudo::Internals { our class CompilerServices { has Mu $!compiler; + has Mu $!current-match; method generate_accessor(str $name, Mu \package_type, str $attr_name, Mu \type, int $rw) { $!compiler.generate_accessor( - $name, package_type, $attr_name, type, $rw); + $!current-match, $name, package_type, $attr_name, type, $rw); } method generate_buildplan_executor(Mu \obj, Mu \buildplan) { - $!compiler.generate_buildplan_executor(obj, buildplan) + $!compiler.generate_buildplan_executor( + $!current-match, obj, buildplan) } } From fab0667f76e55d8aaa875e1e9a08a8685b9051d5 Mon Sep 17 00:00:00 2001 From: Patrick Spek Date: Wed, 4 Oct 2017 23:20:20 +0200 Subject: [PATCH 273/692] Check for the config file's existence before trying to open it --- tools/lib/NQP/Configure.pm | 3 +++ 1 file changed, 3 insertions(+) diff --git a/tools/lib/NQP/Configure.pm b/tools/lib/NQP/Configure.pm index 47975102f40..86de757f733 100644 --- a/tools/lib/NQP/Configure.pm +++ b/tools/lib/NQP/Configure.pm @@ -97,6 +97,9 @@ sub read_config { local $_; for my $file (@config_src) { no warnings; + if (! -f $file) { + next; + } if (open my $CONFIG, '-|', "\"$file\" --show-config") { while (<$CONFIG>) { if (/^([^\s=]+)=(.*)/) { $config{$1} = $2 } From f1908a68551ac82efddd9408c4797cef117c4cea Mon Sep 17 00:00:00 2001 From: Patrick Spek Date: Wed, 4 Oct 2017 23:46:15 +0200 Subject: [PATCH 274/692] Add output line indicating a file is not found --- tools/lib/NQP/Configure.pm | 1 + 1 file changed, 1 insertion(+) diff --git a/tools/lib/NQP/Configure.pm b/tools/lib/NQP/Configure.pm index 86de757f733..80b6792fbf7 100644 --- a/tools/lib/NQP/Configure.pm +++ b/tools/lib/NQP/Configure.pm @@ -98,6 +98,7 @@ sub read_config { for my $file (@config_src) { no warnings; if (! -f $file) { + print "No pre-existing installed file found at $file\n"; next; } if (open my $CONFIG, '-|', "\"$file\" --show-config") { From b33c2d6f85e8648debd09305a59cb7b2a33e0f73 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Thu, 5 Oct 2017 12:54:49 +0200 Subject: [PATCH 275/692] Remove superfluous line The scope of 'self' is already set 3 lines earlier --- src/Perl6/Actions.nqp | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Perl6/Actions.nqp b/src/Perl6/Actions.nqp index a70e4b20a8e..7641ad72b10 100644 --- a/src/Perl6/Actions.nqp +++ b/src/Perl6/Actions.nqp @@ -9165,7 +9165,6 @@ class Perl6::Actions is HLL::Actions does STDActions { $block[0].push(QAST::Var.new( :name('self'), :scope('lexical'), :decl('var') )); $block[0].push(QAST::Var.new( :name('$_'), :scope('lexical'), :decl('var') )); $block.push(QAST::Stmts.new( WANTED($initializer, 'install_attr_init'), :node($/) )); - $block.symbol('self', :scope('lexical')); add_signature_binding_code($block, $sig, @params); $block.blocktype('declaration_static'); my $code := $*W.create_code_object($block, 'Method', $sig); From c73221225f623e1937d5bd5ddfb2d11ed100ef0e Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Thu, 5 Oct 2017 15:49:07 +0000 Subject: [PATCH 276/692] Move &EVAL/&EVALFILE further down the setting I need it to know about `Blob` and adding stubs into src/core/control.pm is unweildy because all the role mixins and the stubs for the roles need to be added as well --- src/core/ForeignCode.pm | 81 +++++++++++++++++++++++++++++++++++++++++ src/core/control.pm | 81 ----------------------------------------- 2 files changed, 81 insertions(+), 81 deletions(-) diff --git a/src/core/ForeignCode.pm b/src/core/ForeignCode.pm index c10a1378bba..fb4f3b1b34a 100644 --- a/src/core/ForeignCode.pm +++ b/src/core/ForeignCode.pm @@ -18,4 +18,85 @@ my class ForeignCode does Callable { # declared in BOOTSTRAP multi method Str(ForeignCode:D:) { self.name } } +my class Rakudo::Internals::EvalIdSource { + my Int $count = 0; + my Lock $lock = Lock.new; + method next-id() { + $lock.protect: { $count++ } + } +} +proto sub EVAL(Cool $code, Str() :$lang = 'perl6', PseudoStash :$context, *%n) { + # First look in compiler registry. + my $compiler := nqp::getcomp($lang); + if nqp::isnull($compiler) { + # Try a multi-dispatch to another EVAL candidate. If that fails to + # dispatch, map it to a typed exception. + CATCH { + when X::Multi::NoMatch { + X::Eval::NoSuchLang.new(:$lang).throw + } + } + return {*}; + } + $context := CALLER:: unless nqp::defined($context); + my $eval_ctx := nqp::getattr(nqp::decont($context), PseudoStash, '$!ctx'); + my $?FILES := 'EVAL_' ~ Rakudo::Internals::EvalIdSource.next-id; + my \mast_frames := nqp::hash(); + my $*CTXSAVE; # make sure we don't use the EVAL's MAIN context for the currently compiling compilation unit + my $compiled; + my $LANG := $context<%?LANG>; + if !$LANG { + $LANG := CALLERS::<%?LANG>; + } + if $LANG { + # XXX + my $grammar := $LANG
; + my $actions := $LANG; + $compiled := $compiler.compile( + $code.Stringy, + :outer_ctx($eval_ctx), + :global(GLOBAL), + :mast_frames(mast_frames), + :grammar($grammar), + :actions($actions), + ); + } + else { + $compiled := $compiler.compile( + $code.Stringy, + :outer_ctx($eval_ctx), + :global(GLOBAL), + :mast_frames(mast_frames), + ); + } + if $*W and $*W.is_precompilation_mode() { # we are still compiling + $*W.add_additional_frames(mast_frames); + } + nqp::forceouterctx(nqp::getattr($compiled, ForeignCode, '$!do'), $eval_ctx); + $compiled(); +} + +multi sub EVAL(Cool $code, Str :$lang where { ($lang // '') eq 'Perl5' }, PseudoStash :$context) { + my $eval_ctx := nqp::getattr(nqp::decont($context // CALLER::), PseudoStash, '$!ctx'); + my $?FILES := 'EVAL_' ~ (state $no)++; + state $p5; + unless $p5 { + { + my $compunit := $*REPO.need(CompUnit::DependencySpecification.new(:short-name)); + GLOBAL.WHO.merge-symbols($compunit.handle.globalish-package); + CATCH { + #X::Eval::NoSuchLang.new(:$lang).throw; + note $_; + } + } + $p5 = ::("Inline::Perl5").default_perl5; + } + $p5.run($code); +} + +proto sub EVALFILE($, *%) {*} +multi sub EVALFILE($filename, :$lang = 'perl6') { + EVAL slurp($filename), :$lang, :context(CALLER::); +} + # vim: ft=perl6 expandtab sw=4 diff --git a/src/core/control.pm b/src/core/control.pm index f746fa4746b..79563f35375 100644 --- a/src/core/control.pm +++ b/src/core/control.pm @@ -192,87 +192,6 @@ multi sub warn(*@msg) { 0; } -my class Rakudo::Internals::EvalIdSource { - my Int $count = 0; - my Lock $lock = Lock.new; - method next-id() { - $lock.protect: { $count++ } - } -} -proto sub EVAL(Cool $code, Str() :$lang = 'perl6', PseudoStash :$context, *%n) { - # First look in compiler registry. - my $compiler := nqp::getcomp($lang); - if nqp::isnull($compiler) { - # Try a multi-dispatch to another EVAL candidate. If that fails to - # dispatch, map it to a typed exception. - CATCH { - when X::Multi::NoMatch { - X::Eval::NoSuchLang.new(:$lang).throw - } - } - return {*}; - } - $context := CALLER:: unless nqp::defined($context); - my $eval_ctx := nqp::getattr(nqp::decont($context), PseudoStash, '$!ctx'); - my $?FILES := 'EVAL_' ~ Rakudo::Internals::EvalIdSource.next-id; - my \mast_frames := nqp::hash(); - my $*CTXSAVE; # make sure we don't use the EVAL's MAIN context for the currently compiling compilation unit - my $compiled; - my $LANG := $context<%?LANG>; - if !$LANG { - $LANG := CALLERS::<%?LANG>; - } - if $LANG { - # XXX - my $grammar := $LANG
; - my $actions := $LANG; - $compiled := $compiler.compile( - $code.Stringy, - :outer_ctx($eval_ctx), - :global(GLOBAL), - :mast_frames(mast_frames), - :grammar($grammar), - :actions($actions), - ); - } - else { - $compiled := $compiler.compile( - $code.Stringy, - :outer_ctx($eval_ctx), - :global(GLOBAL), - :mast_frames(mast_frames), - ); - } - if $*W and $*W.is_precompilation_mode() { # we are still compiling - $*W.add_additional_frames(mast_frames); - } - nqp::forceouterctx(nqp::getattr($compiled, ForeignCode, '$!do'), $eval_ctx); - $compiled(); -} - -multi sub EVAL(Cool $code, Str :$lang where { ($lang // '') eq 'Perl5' }, PseudoStash :$context) { - my $eval_ctx := nqp::getattr(nqp::decont($context // CALLER::), PseudoStash, '$!ctx'); - my $?FILES := 'EVAL_' ~ (state $no)++; - state $p5; - unless $p5 { - { - my $compunit := $*REPO.need(CompUnit::DependencySpecification.new(:short-name)); - GLOBAL.WHO.merge-symbols($compunit.handle.globalish-package); - CATCH { - #X::Eval::NoSuchLang.new(:$lang).throw; - note $_; - } - } - $p5 = ::("Inline::Perl5").default_perl5; - } - $p5.run($code); -} - -proto sub EVALFILE($, *%) {*} -multi sub EVALFILE($filename, :$lang = 'perl6') { - EVAL slurp($filename), :$lang, :context(CALLER::); -} - constant Inf = nqp::p6box_n(nqp::inf()); constant NaN = nqp::p6box_n(nqp::nan()); From 6c928d61d96998119d3426be3f229b826a409e8c Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Thu, 5 Oct 2017 17:38:58 +0000 Subject: [PATCH 277/692] Implement &EVAL/&EVALFILE with Bufs per S29; ilmari++ Closes RT#122256: https://rt.perl.org/Ticket/Display.html?id=122256 - Make EVALFILE slurp in binary and let EVAL handle encodings - Implement EVAL(Blob), decoding the same way source file would be read by $lang (per S29) - For Perl 6: use value of `--encoding` command line arg or utf8 - For Perl 5: decode in utf-c8 and let perl handle the rest. Appears to produce the same output as running the code with perl directly. ilmari++ for pointers on how perl does this --- src/core/ForeignCode.pm | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/src/core/ForeignCode.pm b/src/core/ForeignCode.pm index fb4f3b1b34a..d04ac3926f8 100644 --- a/src/core/ForeignCode.pm +++ b/src/core/ForeignCode.pm @@ -25,7 +25,7 @@ my class Rakudo::Internals::EvalIdSource { $lock.protect: { $count++ } } } -proto sub EVAL(Cool $code, Str() :$lang = 'perl6', PseudoStash :$context, *%n) { +proto sub EVAL($code is copy where Blob|Cool, Str() :$lang = 'perl6', PseudoStash :$context, *%n) { # First look in compiler registry. my $compiler := nqp::getcomp($lang); if nqp::isnull($compiler) { @@ -38,6 +38,10 @@ proto sub EVAL(Cool $code, Str() :$lang = 'perl6', PseudoStash :$context, *%n) { } return {*}; } + $code = nqp::istype($code,Blob) ?? $code.decode( + $compiler.cli-options // 'utf8' + ) !! $code.Str; + $context := CALLER:: unless nqp::defined($context); my $eval_ctx := nqp::getattr(nqp::decont($context), PseudoStash, '$!ctx'); my $?FILES := 'EVAL_' ~ Rakudo::Internals::EvalIdSource.next-id; @@ -53,7 +57,7 @@ proto sub EVAL(Cool $code, Str() :$lang = 'perl6', PseudoStash :$context, *%n) { my $grammar := $LANG
; my $actions := $LANG; $compiled := $compiler.compile( - $code.Stringy, + $code, :outer_ctx($eval_ctx), :global(GLOBAL), :mast_frames(mast_frames), @@ -63,7 +67,7 @@ proto sub EVAL(Cool $code, Str() :$lang = 'perl6', PseudoStash :$context, *%n) { } else { $compiled := $compiler.compile( - $code.Stringy, + $code, :outer_ctx($eval_ctx), :global(GLOBAL), :mast_frames(mast_frames), @@ -76,7 +80,7 @@ proto sub EVAL(Cool $code, Str() :$lang = 'perl6', PseudoStash :$context, *%n) { $compiled(); } -multi sub EVAL(Cool $code, Str :$lang where { ($lang // '') eq 'Perl5' }, PseudoStash :$context) { +multi sub EVAL($code, Str :$lang where { ($lang // '') eq 'Perl5' }, PseudoStash :$context) { my $eval_ctx := nqp::getattr(nqp::decont($context // CALLER::), PseudoStash, '$!ctx'); my $?FILES := 'EVAL_' ~ (state $no)++; state $p5; @@ -91,12 +95,14 @@ multi sub EVAL(Cool $code, Str :$lang where { ($lang // '') eq 'Perl5' }, Pseudo } $p5 = ::("Inline::Perl5").default_perl5; } - $p5.run($code); + $p5.run: nqp::istype($code,Blob) + ?? Blob.new($code).decode('utf8-c8') + !! $code.Str; } proto sub EVALFILE($, *%) {*} multi sub EVALFILE($filename, :$lang = 'perl6') { - EVAL slurp($filename), :$lang, :context(CALLER::); + EVAL slurp(:bin, $filename), :$lang, :context(CALLER::); } # vim: ft=perl6 expandtab sw=4 From ac8e5f430b69018ab17ee39da544692c92b235da Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Thu, 5 Oct 2017 18:37:37 -0400 Subject: [PATCH 278/692] Make Blob.gist trim its guts to 100 els Large blobs take ages to render and we already limit to 100 els for Lists and Maps. --- src/core/Buf.pm | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/src/core/Buf.pm b/src/core/Buf.pm index eca050ec603..f7db0c9ca42 100644 --- a/src/core/Buf.pm +++ b/src/core/Buf.pm @@ -136,7 +136,13 @@ my role Blob[::T = uint8] does Positional[T] does Stringy is repr('VMArray') is } multi method gist(Blob:D:) { - self.^name ~ ':0x<' ~ self.list.fmt('%02x', ' ') ~ '>' + self.^name ~ ':0x<' ~ self.map( -> $elem { + given ++$ { + when 101 { '...' } + when 102 { last } + default { $elem.fmt: '%02x' } + } + }) ~ '>' } multi method perl(Blob:D:) { self.^name ~ '.new(' ~ self.join(',') ~ ')'; From e2ec569b7cd693847583becca597206a10d2dc89 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Thu, 5 Oct 2017 20:43:50 -0400 Subject: [PATCH 279/692] Implement IO::Handle.slurp(:bin) During IO::Grant, we removed :bin from .slurp-rest, because it mutated the handle's encoding. After the Deasyncing of IO, we clarified the spec in that it was allowed to use binary read methods on non-bin handles. With that in mind, re-adding a non-$!encoding-mutating :bin to .slurp aligns the interface with other methods and makes it easier to bin-slurp from Proc pipes too. --- src/core/IO/Handle.pm | 36 +++++++++++++++++++++--------------- 1 file changed, 21 insertions(+), 15 deletions(-) diff --git a/src/core/IO/Handle.pm b/src/core/IO/Handle.pm index debb60e8351..73a94796162 100644 --- a/src/core/IO/Handle.pm +++ b/src/core/IO/Handle.pm @@ -696,23 +696,29 @@ my class IO::Handle { self!slurp-all-chars() } - method slurp(IO::Handle:D: :$close) { - my $res; - nqp::if( - $!decoder, - ($res := self!slurp-all-chars()), - nqp::stmts( - ($res := buf8.new), + method slurp(IO::Handle:D: :$close, :$bin) { + nqp::stmts( + (my $res), + nqp::if( + $!decoder, + nqp::if( + $bin, + nqp::stmts( + ($res := buf8.new), + nqp::if( + $!decoder.bytes-available, + $res.append($!decoder.consume-exactly-bytes( + $!decoder.bytes-available)))), + ($res := self!slurp-all-chars())), + ($res := buf8.new)), + nqp::if( + nqp::isfalse($!decoder) || $bin, nqp::while( nqp::elems(my $buf := self.read-internal(0x100000)), - $res.append($buf) - ) - ) - ); - - # don't sink result of .close; it might be a failed Proc - $ = self.close if $close; - $res + $res.append($buf))), + # don't sink result of .close; it might be a failed Proc + nqp::if($close, $ = self.close), + $res) } method !slurp-all-chars() { From be83cd4ec72c67c825d343057fa965e2086f0e47 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Thu, 5 Oct 2017 21:36:23 -0400 Subject: [PATCH 280/692] Make Blob.gist 40x faster MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Not exactly a method that gotta be über fast, but the original takes 50ms per single call on a 100+ el buf (for comparison 100+ list takes 3ms) --- src/core/Buf.pm | 25 ++++++++++++++++++------- 1 file changed, 18 insertions(+), 7 deletions(-) diff --git a/src/core/Buf.pm b/src/core/Buf.pm index f7db0c9ca42..a8788fde12b 100644 --- a/src/core/Buf.pm +++ b/src/core/Buf.pm @@ -136,13 +136,24 @@ my role Blob[::T = uint8] does Positional[T] does Stringy is repr('VMArray') is } multi method gist(Blob:D:) { - self.^name ~ ':0x<' ~ self.map( -> $elem { - given ++$ { - when 101 { '...' } - when 102 { last } - default { $elem.fmt: '%02x' } - } - }) ~ '>' + nqp::stmts( + (my str $gist = self.^name ~ ':0x<'), + (my int $els = nqp::elems(self)), + (my int $max = nqp::isle_i($els,100) ?? $els !! 100), + (my int $i = -1), + nqp::while( + nqp::islt_i(($i = nqp::add_i($i,1)),$max), + ($gist = nqp::concat($gist, nqp::concat(nqp::if( + nqp::iseq_i( + nqp::chars(my str $s = nqp::lc( + (self.AT-POS: $i).base: 16)),1), + nqp::concat('0',$s),$s),' ')))), + nqp::if( # take care of ending, removing extra ' ' if needed + nqp::isge_i($els, 101), + ($gist = nqp::concat($gist,'...')), + $els && ($gist = nqp::substr( + $gist,0,nqp::sub_i(nqp::chars($gist),1)))), + nqp::concat($gist,'>')) } multi method perl(Blob:D:) { self.^name ~ '.new(' ~ self.join(',') ~ ')'; From 66a01aa827c19ba5995c80146404599ab0083cf8 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Thu, 5 Oct 2017 21:44:51 -0400 Subject: [PATCH 281/692] Revert "Make Blob.gist 40x faster" This reverts commit be83cd4ec72c67c825d343057fa965e2086f0e47. I think I got carried away and it's too unreadable. Will make just the .fmt() call in nqp, as that's the main slowdown here. --- src/core/Buf.pm | 25 +++++++------------------ 1 file changed, 7 insertions(+), 18 deletions(-) diff --git a/src/core/Buf.pm b/src/core/Buf.pm index a8788fde12b..f7db0c9ca42 100644 --- a/src/core/Buf.pm +++ b/src/core/Buf.pm @@ -136,24 +136,13 @@ my role Blob[::T = uint8] does Positional[T] does Stringy is repr('VMArray') is } multi method gist(Blob:D:) { - nqp::stmts( - (my str $gist = self.^name ~ ':0x<'), - (my int $els = nqp::elems(self)), - (my int $max = nqp::isle_i($els,100) ?? $els !! 100), - (my int $i = -1), - nqp::while( - nqp::islt_i(($i = nqp::add_i($i,1)),$max), - ($gist = nqp::concat($gist, nqp::concat(nqp::if( - nqp::iseq_i( - nqp::chars(my str $s = nqp::lc( - (self.AT-POS: $i).base: 16)),1), - nqp::concat('0',$s),$s),' ')))), - nqp::if( # take care of ending, removing extra ' ' if needed - nqp::isge_i($els, 101), - ($gist = nqp::concat($gist,'...')), - $els && ($gist = nqp::substr( - $gist,0,nqp::sub_i(nqp::chars($gist),1)))), - nqp::concat($gist,'>')) + self.^name ~ ':0x<' ~ self.map( -> $elem { + given ++$ { + when 101 { '...' } + when 102 { last } + default { $elem.fmt: '%02x' } + } + }) ~ '>' } multi method perl(Blob:D:) { self.^name ~ '.new(' ~ self.join(',') ~ ')'; From 96669c6b0b98624e67a6b957e635523b72c08297 Mon Sep 17 00:00:00 2001 From: Samantha McVey Date: Fri, 6 Oct 2017 02:23:47 -0700 Subject: [PATCH 282/692] Add S32-str/Collation.t to spectest.data --- t/spectest.data | 1 + 1 file changed, 1 insertion(+) diff --git a/t/spectest.data b/t/spectest.data index 10f136542ad..d9c9a3c7f97 100644 --- a/t/spectest.data +++ b/t/spectest.data @@ -1115,6 +1115,7 @@ S32-scalar/undef.t S32-str/append.t S32-str/bool.t S32-str/capitalize.t +S32-str/Collation.t # moar S32-str/chomp.t S32-str/chop.t S32-str/comb.t From 20a99fc3aef0059dae6c31bcd36d257b583341ce Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Fri, 6 Oct 2017 10:10:11 +0000 Subject: [PATCH 283/692] Make Blob.gist 26x faster --- src/core/Buf.pm | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/src/core/Buf.pm b/src/core/Buf.pm index f7db0c9ca42..1879ecbfc1b 100644 --- a/src/core/Buf.pm +++ b/src/core/Buf.pm @@ -136,12 +136,13 @@ my role Blob[::T = uint8] does Positional[T] does Stringy is repr('VMArray') is } multi method gist(Blob:D:) { - self.^name ~ ':0x<' ~ self.map( -> $elem { - given ++$ { - when 101 { '...' } - when 102 { last } - default { $elem.fmt: '%02x' } - } + self.^name ~ ':0x<' ~ self.map( -> \el { + state $i = 0; + ++$i == 101 ?? '...' + !! $i == 102 ?? last() + !! nqp::if(nqp::iseq_i( # el.fmt: '%02x' + nqp::chars(my str $v = nqp::lc(el.base: 16)),1), + nqp::concat('0',$v),$v) }) ~ '>' } multi method perl(Blob:D:) { From aad8991e2a3148df73ba3fcf64b9b5a19eba533c Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Fri, 6 Oct 2017 10:13:18 +0000 Subject: [PATCH 284/692] Fix Map.perl losing cont / Make Map.gist trim to 100els Hash, List, and Buf trim .gist to 100 els, do the same for Map --- src/core/Map.pm | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/src/core/Map.pm b/src/core/Map.pm index 586f2cc9fec..26d7af8cf0b 100644 --- a/src/core/Map.pm +++ b/src/core/Map.pm @@ -120,11 +120,18 @@ my class Map does Iterable does Associative { # declared in BOOTSTRAP ) } - multi method perl(Map:D:) { - self.^name - ~ '.new((' - ~ self.sort.map({.perl}).join(',') - ~ '))'; + multi method gist(Map:D:) { + self.^name ~ '.new((' ~ self.sort.map({ + state $i = 0; + ++$i == 101 ?? '...' + !! $i == 102 ?? last() + !! .gist + }).join(',') ~ '))' + } + + multi method perl(Map:D \SELF:) { + my $p = self.^name ~ '.new((' ~ self.sort.map({.perl}).join(',') ~ '))'; + nqp::iscont(SELF) ?? '$(' ~ $p ~ ')' !! $p } method iterator(Map:D:) { From 39461368b58ef2ebe35b6719fc596d6413534e6c Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Fri, 6 Oct 2017 10:14:39 +0000 Subject: [PATCH 285/692] Make Hash.perl/.gist use proper object name in circularities --- src/core/Hash.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/Hash.pm b/src/core/Hash.pm index b6b03a86bd0..cfad3e179d9 100644 --- a/src/core/Hash.pm +++ b/src/core/Hash.pm @@ -204,14 +204,14 @@ my class Hash { # declared in BOOTSTRAP } multi method perl(Hash:D \SELF:) { - SELF.perlseen('Hash', { + SELF.perlseen(self.^name, { '$' x nqp::iscont(SELF) # self is always deconted ~ '{' ~ self.sort.map({.perl}).join(', ') ~ '}' }) } multi method gist(Hash:D:) { - self.gistseen('Hash', { + self.gistseen(self.^name, { '{' ~ self.sort.map( -> $elem { given ++$ { From 69af24c49e023188393749ad915ffb57e81da943 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Fri, 6 Oct 2017 10:15:13 +0000 Subject: [PATCH 286/692] Make Hash.gist 24% faster --- src/core/Hash.pm | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/src/core/Hash.pm b/src/core/Hash.pm index cfad3e179d9..ee2619255e5 100644 --- a/src/core/Hash.pm +++ b/src/core/Hash.pm @@ -213,13 +213,12 @@ my class Hash { # declared in BOOTSTRAP multi method gist(Hash:D:) { self.gistseen(self.^name, { '{' ~ - self.sort.map( -> $elem { - given ++$ { - when 101 { '...' } - when 102 { last } - default { $elem.gist } - } - } ).join(', ') + self.sort.map({ + state $i = 0; + ++$i == 101 ?? '...' + !! $i == 102 ?? last() + !! .gist + }).join(', ') ~ '}' }) } From d565ded0292813582a285835b4a388279ca8c6a3 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Thu, 5 Oct 2017 16:10:38 +0200 Subject: [PATCH 287/692] Make sure we have IO::Special before IO::Handle Needed for an optimization later --- src/core/IO/Handle.pm | 1 - src/core/IO/Path.pm | 2 -- src/core/IO/Special.pm | 2 ++ tools/build/jvm_core_sources | 2 +- tools/build/moar_core_sources | 2 +- 5 files changed, 4 insertions(+), 5 deletions(-) diff --git a/src/core/IO/Handle.pm b/src/core/IO/Handle.pm index 73a94796162..7ae4b480f09 100644 --- a/src/core/IO/Handle.pm +++ b/src/core/IO/Handle.pm @@ -1,5 +1,4 @@ my class IO::Path { ... } -my class IO::Special { ... } my class Proc { ... } my class IO::Handle { diff --git a/src/core/IO/Path.pm b/src/core/IO/Path.pm index 39cc963b6b1..51031a5eb99 100644 --- a/src/core/IO/Path.pm +++ b/src/core/IO/Path.pm @@ -1,5 +1,3 @@ -my class Instant { ... } - my class IO::Path is Cool does IO { has IO::Spec $.SPEC; has Str $.CWD; diff --git a/src/core/IO/Special.pm b/src/core/IO/Special.pm index a349210b1f5..44298170653 100644 --- a/src/core/IO/Special.pm +++ b/src/core/IO/Special.pm @@ -1,3 +1,5 @@ +my class Instant { ... } + class IO::Special does IO { has Str $.what; diff --git a/tools/build/jvm_core_sources b/tools/build/jvm_core_sources index 06b97f878ca..8423d23797f 100644 --- a/tools/build/jvm_core_sources +++ b/tools/build/jvm_core_sources @@ -101,10 +101,10 @@ src/core/IO/Spec/Win32.pm src/core/IO/Spec/Cygwin.pm src/core/IO/Spec/QNX.pm src/core/IO/Notification.pm +src/core/IO/Special.pm src/core/IO/Handle.pm src/core/IO/Pipe.pm src/core/IO/Path.pm -src/core/IO/Special.pm src/core/io_operators.pm src/core/IO/CatHandle.pm src/core/IO/ArgFiles.pm diff --git a/tools/build/moar_core_sources b/tools/build/moar_core_sources index b73e62816c4..87d148c9226 100644 --- a/tools/build/moar_core_sources +++ b/tools/build/moar_core_sources @@ -103,10 +103,10 @@ src/core/IO/Spec/Win32.pm src/core/IO/Spec/Cygwin.pm src/core/IO/Spec/QNX.pm src/core/IO/Notification.pm +src/core/IO/Special.pm src/core/IO/Handle.pm src/core/IO/Pipe.pm src/core/IO/Path.pm -src/core/IO/Special.pm src/core/io_operators.pm src/core/IO/CatHandle.pm src/core/IO/ArgFiles.pm From 381c4c3bb2fe6313be95432ef47cf9c0b519c5e4 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Fri, 6 Oct 2017 12:23:13 +0000 Subject: [PATCH 288/692] Add space between els in Map.gist We add one in Hash, List, and Buf .gists (Noticing though that Buf and List gists separate els with spaces, but Hash/Map with commas + spaces) --- src/core/Map.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/Map.pm b/src/core/Map.pm index 26d7af8cf0b..1e4c304c501 100644 --- a/src/core/Map.pm +++ b/src/core/Map.pm @@ -126,7 +126,7 @@ my class Map does Iterable does Associative { # declared in BOOTSTRAP ++$i == 101 ?? '...' !! $i == 102 ?? last() !! .gist - }).join(',') ~ '))' + }).join(', ') ~ '))' } multi method perl(Map:D \SELF:) { From b377de1c488d3ad8f2d5cb5dc8b7647a63aab0e1 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Fri, 6 Oct 2017 13:00:29 +0000 Subject: [PATCH 289/692] Versatilize X::Numeric::CannotConvert a bit Make it stringify .defined $!targets as is, while .perl'ifying others. This maintains the old output for X::Numeric::Real, while leaving open the possibility of using more than just a type for $!target if we'll need to. --- src/core/Exception.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/Exception.pm b/src/core/Exception.pm index 868945b49a5..e87c06bed78 100644 --- a/src/core/Exception.pm +++ b/src/core/Exception.pm @@ -2410,7 +2410,7 @@ my class X::Numeric::CannotConvert is Exception { has $.source; method message() { - "Cannot convert $.source to {$.target.^name}: $.reason"; + "Cannot convert $!source to {$!target // $!target.perl}: $!reason"; } } From c4b96e457bc826c01bc30128e1d05731fd88c705 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Fri, 6 Oct 2017 15:21:16 +0000 Subject: [PATCH 290/692] Bump NQP --- tools/build/NQP_REVISION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/build/NQP_REVISION b/tools/build/NQP_REVISION index f2311bf4b5d..46fb0479d8f 100644 --- a/tools/build/NQP_REVISION +++ b/tools/build/NQP_REVISION @@ -1 +1 @@ -2017.09-40-ga6a1aa0 +2017.09-59-g60f79d3 From 8ff76b5962ed34caa7b66b3f95644410fdb9b17e Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Fri, 6 Oct 2017 18:33:02 +0200 Subject: [PATCH 291/692] Add some # vim: ft=perl6 expandtab sw=4 --- src/core/Awaitable.pm | 2 ++ src/core/Awaiter.pm | 2 ++ src/core/Collation.pm | 2 ++ src/core/Cursor.pm | 2 ++ src/core/Encoding.pm | 2 ++ src/core/Encoding/Decoder.pm | 2 ++ src/core/Encoding/Decoder/Builtin.pm | 2 ++ src/core/Encoding/Encoder.pm | 2 ++ src/core/Encoding/Encoder/Builtin.pm | 2 ++ src/core/Encoding/Encoder/TranslateNewlineWrapper.pm | 2 ++ src/core/Encoding/Registry.pm | 2 ++ src/core/IO/Notification.pm | 2 ++ src/core/IO/Socket/Async.pm | 2 ++ src/core/IO/Special.pm | 2 ++ src/core/IterationBuffer.pm | 2 ++ src/core/JSON/Pretty.pm | 2 ++ src/core/JVM/IOAsyncFile.pm | 2 ++ src/core/JVM/KeyReducer.pm | 2 ++ src/core/Lock/Async.pm | 2 ++ src/core/Metamodel/Primitives.pm | 2 ++ src/core/Proc/Async.pm | 2 ++ src/core/REPL.pm | 2 ++ src/core/Rakudo/Internals/JSON.pm | 2 ++ src/core/Slang.pm | 2 ++ src/core/Uni.pm | 2 ++ src/core/allomorphs.pm | 2 ++ src/core/atomicops.pm | 2 ++ 27 files changed, 54 insertions(+) diff --git a/src/core/Awaitable.pm b/src/core/Awaitable.pm index 10fdedb6894..724bd8e5c81 100644 --- a/src/core/Awaitable.pm +++ b/src/core/Awaitable.pm @@ -46,3 +46,5 @@ my role Awaitable::Handle { method subscribe-awaiter(&subscriber) { ... } } + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Awaiter.pm b/src/core/Awaiter.pm index 73355ce0272..8c6457fede9 100644 --- a/src/core/Awaiter.pm +++ b/src/core/Awaiter.pm @@ -111,3 +111,5 @@ my class Awaiter::Blocking does Awaiter { } PROCESS::<$AWAITER> := Awaiter::Blocking; + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Collation.pm b/src/core/Collation.pm index 4544b24e521..3a3f0e2a34a 100644 --- a/src/core/Collation.pm +++ b/src/core/Collation.pm @@ -48,3 +48,5 @@ class Collation { Rakudo::Internals.REGISTER-DYNAMIC: '$*COLLATION', { PROCESS::<$COLLATION> := Collation.new; } + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Cursor.pm b/src/core/Cursor.pm index 16d81256a06..1429f05f1df 100644 --- a/src/core/Cursor.pm +++ b/src/core/Cursor.pm @@ -1 +1,3 @@ my constant Cursor = Match; + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Encoding.pm b/src/core/Encoding.pm index 05c7ee47ff7..6bc38f86f31 100644 --- a/src/core/Encoding.pm +++ b/src/core/Encoding.pm @@ -4,3 +4,5 @@ role Encoding { method encoder(*%options --> Encoding::Encoder) { ... } method decoder(*%options --> Encoding::Decoder) { ... } } + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Encoding/Decoder.pm b/src/core/Encoding/Decoder.pm index a4ca00dea26..883073dfc31 100644 --- a/src/core/Encoding/Decoder.pm +++ b/src/core/Encoding/Decoder.pm @@ -9,3 +9,5 @@ role Encoding::Decoder { method bytes-available(--> Int:D) { ... } method consume-exactly-bytes(int $bytes --> Blob) { ... } } + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Encoding/Decoder/Builtin.pm b/src/core/Encoding/Decoder/Builtin.pm index 804dfd5d69c..82ed683a507 100644 --- a/src/core/Encoding/Decoder/Builtin.pm +++ b/src/core/Encoding/Decoder/Builtin.pm @@ -78,3 +78,5 @@ augment class Rakudo::Internals { } } } + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Encoding/Encoder.pm b/src/core/Encoding/Encoder.pm index 70f1e4aca84..bd18ff39249 100644 --- a/src/core/Encoding/Encoder.pm +++ b/src/core/Encoding/Encoder.pm @@ -1,3 +1,5 @@ role Encoding::Encoder { method encode-chars(Str:D --> Blob:D) { ... } } + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Encoding/Encoder/Builtin.pm b/src/core/Encoding/Encoder/Builtin.pm index abb98733634..4082fda6d47 100644 --- a/src/core/Encoding/Encoder/Builtin.pm +++ b/src/core/Encoding/Encoder/Builtin.pm @@ -42,3 +42,5 @@ my class Encoding::Encoder::Builtin::Replacement does Encoding::Encoder { #?endif } } + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Encoding/Encoder/TranslateNewlineWrapper.pm b/src/core/Encoding/Encoder/TranslateNewlineWrapper.pm index 15b9e6b52d4..fa70028a29e 100644 --- a/src/core/Encoding/Encoder/TranslateNewlineWrapper.pm +++ b/src/core/Encoding/Encoder/TranslateNewlineWrapper.pm @@ -14,3 +14,5 @@ my class Encoding::Encoder::TranslateNewlineWrapper does Encoding::Encoder { $!delegate.encode-chars(Rakudo::Internals.TRANSPOSE($str, "\n", "\r\n")) } } + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Encoding/Registry.pm b/src/core/Encoding/Registry.pm index d2b173d87d9..e71d5cfedef 100644 --- a/src/core/Encoding/Registry.pm +++ b/src/core/Encoding/Registry.pm @@ -39,3 +39,5 @@ my class Encoding::Registry { } } } + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/IO/Notification.pm b/src/core/IO/Notification.pm index be9a42805ba..719c9330a28 100644 --- a/src/core/IO/Notification.pm +++ b/src/core/IO/Notification.pm @@ -34,3 +34,5 @@ my class IO::Notification { $s.Supply } } + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/IO/Socket/Async.pm b/src/core/IO/Socket/Async.pm index 3c4128d6d4c..5edb2534e43 100644 --- a/src/core/IO/Socket/Async.pm +++ b/src/core/IO/Socket/Async.pm @@ -334,3 +334,5 @@ my class IO::Socket::Async { } #?endif } + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/IO/Special.pm b/src/core/IO/Special.pm index 44298170653..3424ab74c6c 100644 --- a/src/core/IO/Special.pm +++ b/src/core/IO/Special.pm @@ -25,3 +25,5 @@ class IO::Special does IO { method changed( IO::Special:D: --> Instant) { Instant } method mode(IO::Special:D: --> Nil) { } } + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/IterationBuffer.pm b/src/core/IterationBuffer.pm index cbac850a5b6..d066b1e05be 100644 --- a/src/core/IterationBuffer.pm +++ b/src/core/IterationBuffer.pm @@ -45,3 +45,5 @@ my class IterationBuffer { nqp::p6bindattrinvres(nqp::create(List),List,'$!reified',self).perl } } + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/JSON/Pretty.pm b/src/core/JSON/Pretty.pm index 82d2bb7e4b3..8c92d6eb1ed 100644 --- a/src/core/JSON/Pretty.pm +++ b/src/core/JSON/Pretty.pm @@ -7,3 +7,5 @@ sub from-json($text) { DEPRECATED('JSON::Fast, JSON::Tiny or JSON::Pretty from https://modules.perl6.org/'); Rakudo::Internals::JSON.from-json($text); } + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/JVM/IOAsyncFile.pm b/src/core/JVM/IOAsyncFile.pm index 97cd15d8355..72fd7ed6bb3 100644 --- a/src/core/JVM/IOAsyncFile.pm +++ b/src/core/JVM/IOAsyncFile.pm @@ -74,3 +74,5 @@ my class IO::Async::File { $c } } + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/JVM/KeyReducer.pm b/src/core/JVM/KeyReducer.pm index 455d8e79402..1974a9ef09d 100644 --- a/src/core/JVM/KeyReducer.pm +++ b/src/core/JVM/KeyReducer.pm @@ -86,3 +86,5 @@ my class KeyReducer { $!exception ?? $!exception.throw !! %!result } } + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Lock/Async.pm b/src/core/Lock/Async.pm index 681a9cb949a..a71513cbaff 100644 --- a/src/core/Lock/Async.pm +++ b/src/core/Lock/Async.pm @@ -203,3 +203,5 @@ my class Lock::Async { } } } + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Metamodel/Primitives.pm b/src/core/Metamodel/Primitives.pm index 98b4cb9091e..12a9268e167 100644 --- a/src/core/Metamodel/Primitives.pm +++ b/src/core/Metamodel/Primitives.pm @@ -64,3 +64,5 @@ my class Metamodel::Primitives { nqp::p6bool(nqp::istype(obj, type)) } } + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Proc/Async.pm b/src/core/Proc/Async.pm index 22518c66829..3ac31d87cf0 100644 --- a/src/core/Proc/Async.pm +++ b/src/core/Proc/Async.pm @@ -420,3 +420,5 @@ my class Proc::Async { nqp::killprocasync($!process_handle, $*KERNEL.signal: signal) } } + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/REPL.pm b/src/core/REPL.pm index 35a23781307..0fff6605f40 100644 --- a/src/core/REPL.pm +++ b/src/core/REPL.pm @@ -412,3 +412,5 @@ do { } } } + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Rakudo/Internals/JSON.pm b/src/core/Rakudo/Internals/JSON.pm index d8ae99972f0..917348c71d4 100644 --- a/src/core/Rakudo/Internals/JSON.pm +++ b/src/core/Rakudo/Internals/JSON.pm @@ -133,3 +133,5 @@ my class Rakudo::Internals::JSON { } method to-json(|c) { to-json(|c) } } + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Slang.pm b/src/core/Slang.pm index 3530b978ab7..de5d81ab4d9 100644 --- a/src/core/Slang.pm +++ b/src/core/Slang.pm @@ -12,3 +12,5 @@ class Slang { $!grammar.parse(:$!actions, |c); } } + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Uni.pm b/src/core/Uni.pm index 3aee3706c3a..d320cf6be7a 100644 --- a/src/core/Uni.pm +++ b/src/core/Uni.pm @@ -123,3 +123,5 @@ my class NFKC is Uni { die "Cannot create an NFKC directly"; # XXX typed, better message } } + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/allomorphs.pm b/src/core/allomorphs.pm index 8e3f6becbca..d7bb74aedb4 100644 --- a/src/core/allomorphs.pm +++ b/src/core/allomorphs.pm @@ -506,3 +506,5 @@ multi sub val(Str:D $MAYBEVAL, :$val-or-fail) { parse_win $result; } + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/atomicops.pm b/src/core/atomicops.pm index 764cc20f0ae..7f416554918 100644 --- a/src/core/atomicops.pm +++ b/src/core/atomicops.pm @@ -205,3 +205,5 @@ multi sub cas(atomicint $target is rw, &code) { } } #?endif + +# vim: ft=perl6 expandtab sw=4 From 92e51c3d4e2145c159d4db32063262524ef86ee0 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Fri, 6 Oct 2017 23:19:04 +0200 Subject: [PATCH 292/692] Compile time defaults for attributes stored as value - store the compile-time value of a default if possible - makes object creation with concrete compile-time default values faster - about 40% faster for a single attribute, like "has $.foo = 42" - rather than generating a method to be installed and called during init - only supports concrete default values for now, type objects use old behaviour - this caused some test breakage and seemed obscure enough to not pursue now - abuses the Attribute.build_closure attribute for default value - so it's not always code in there: this may be a bad idea - maybe a rename of the attribute would be in order - Adapted BUILDPLAN accordingly - Adapted Mu.BUILDALL/BUILD_LEAST_DERIVED accordingly - Adapted class.BUILDALL auto-generating accordingly - breaks one attribute introspection test in roast - not sure that actually belongs in roast anyway - unbreaks two pod-tests - presumably because the "compile-time-value" doesn't eat the comment - whereas the code generation apparently does --- src/Perl6/Actions.nqp | 34 +++++++++++---- src/Perl6/Metamodel/BUILDPLAN.nqp | 2 +- src/Perl6/World.nqp | 47 +++++++++++++++------ src/core/Mu.pm | 70 +++++++++++++++++++++++-------- src/core/traits.pm | 2 +- 5 files changed, 115 insertions(+), 40 deletions(-) diff --git a/src/Perl6/Actions.nqp b/src/Perl6/Actions.nqp index 7641ad72b10..626deeaade0 100644 --- a/src/Perl6/Actions.nqp +++ b/src/Perl6/Actions.nqp @@ -9154,25 +9154,43 @@ class Perl6::Actions is HLL::Actions does STDActions { placeholder => $block.ann('placeholder_sig')[0], ); } + if $initializer.has_compile_time_value { + my $build := $initializer.compile_time_value; + if nqp::isconcrete($build) { # can't handle type values yet + return $*W.apply_trait($/, '&trait_mod:', $attr, :$build); + } + } + + # Need to construct and install an initializer method my @params := [ - hash( is_invocant => 1, nominal_type => $/.package), - hash( variable_name => '$_', nominal_type => $*W.find_symbol(['Mu'])) + hash( is_invocant => 1, nominal_type => $/.package), + hash( variable_name => '$_', nominal_type => $*W.find_symbol(['Mu'])) ]; my $sig := $*W.create_signature(nqp::hash('parameter_objects', [ - $*W.create_parameter($/, @params[0]), - $*W.create_parameter($/, @params[1]) + $*W.create_parameter($/, @params[0]), + $*W.create_parameter($/, @params[1]) ])); - $block[0].push(QAST::Var.new( :name('self'), :scope('lexical'), :decl('var') )); - $block[0].push(QAST::Var.new( :name('$_'), :scope('lexical'), :decl('var') )); - $block.push(QAST::Stmts.new( WANTED($initializer, 'install_attr_init'), :node($/) )); + + $block[0].push( + QAST::Var.new( :name('self'), :scope('lexical'), :decl('var') ) + ); + $block[0].push( + QAST::Var.new( :name('$_'), :scope('lexical'), :decl('var') ) + ); + $block.push( + QAST::Stmts.new( + WANTED($initializer, 'install_attr_init'), :node($/) + ) + ); + add_signature_binding_code($block, $sig, @params); $block.blocktype('declaration_static'); - my $code := $*W.create_code_object($block, 'Method', $sig); # Block should go in current lexpad, in correct lexical context. ($*W.cur_lexpad())[0].push($block); # Dispatch trait. + my $code := $*W.create_code_object($block, 'Method', $sig); $*W.apply_trait($/, '&trait_mod:', $attr, :build($code)); } diff --git a/src/Perl6/Metamodel/BUILDPLAN.nqp b/src/Perl6/Metamodel/BUILDPLAN.nqp index 2111ee56fcc..7452b3cde72 100644 --- a/src/Perl6/Metamodel/BUILDPLAN.nqp +++ b/src/Perl6/Metamodel/BUILDPLAN.nqp @@ -80,7 +80,7 @@ role Perl6::Metamodel::BUILDPLAN { for @attrs { if nqp::can($_, 'build') { my $default := $_.build; - if !nqp::isnull($default) && $default { + if nqp::isconcrete($default) { nqp::push(@plan,[ nqp::add_i(4,nqp::objprimspec($_.type)), $obj, diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index 1cc73f0c9a7..4503a4c5fb7 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -3250,11 +3250,16 @@ class Perl6::World is HLL::World { $self, $class, $attr ); + my $initializer := nqp::istype( + nqp::atpos($task,3), + $!w.find_symbol(['Block']) # $code(self,nqp::getattr(self,Foo,'$!a'))) - my $initializer := QAST::Op.new( :op, - QAST::WVal.new(:value(nqp::atpos($task,3))), - $self, $getattr - ); + ) ?? QAST::Op.new( :op, + QAST::WVal.new(:value(nqp::atpos($task,3))), + $self, $getattr + ) +# $value + !! QAST::WVal.new(:value(nqp::atpos($task,3))); my $sigil := nqp::substr(nqp::atpos($task,2),0,1); # nqp::getattr(self,Foo,'$!a').STORE($code(self,nqp::getattr(self,Foo,'$!a'))) @@ -3306,10 +3311,21 @@ class Perl6::World is HLL::World { ), QAST::Op.new( :op('bindattr' ~ @psp[$code - 4]), $self, $class, $attr, - QAST::Op.new( :op, - QAST::WVal.new(:value(nqp::atpos($task,3))), - $self, - $getattr + nqp::if( + nqp::istype( + nqp::atpos($task,3), + $!w.find_symbol(['Block']) + ), + QAST::Op.new( :op, + QAST::WVal.new(:value(nqp::atpos($task,3))), + $self, + $getattr + ), + nqp::if( + nqp::iseq_i($code,5), + QAST::IVal.new(:value(nqp::atpos($task,3))), + QAST::NVal.new(:value(nqp::atpos($task,3))) + ) ) ) ) @@ -3333,10 +3349,17 @@ class Perl6::World is HLL::World { QAST::Op.new( :op, $getattr), QAST::Op.new( :op, $self, $class, $attr, - QAST::Op.new( :op, - QAST::WVal.new(:value(nqp::atpos($task,3))), - $self, - $getattr + nqp::if( + nqp::istype( + nqp::atpos($task,3), + $!w.find_symbol(['Block']) + ), + QAST::Op.new( :op, + QAST::WVal.new(:value(nqp::atpos($task,3))), + $self, + $getattr + ), + QAST::SVal.new(:value(nqp::atpos($task,3))) ) ) ) diff --git a/src/core/Mu.pm b/src/core/Mu.pm index fe36179e9e0..369cfa03d9c 100644 --- a/src/core/Mu.pm +++ b/src/core/Mu.pm @@ -197,12 +197,17 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" nqp::atpos($task,1), nqp::atpos($task,2) ), - nqp::stmts( - (my \attr := nqp::getattr(self, - nqp::atpos($task,1), - nqp::atpos($task,2) - )), - (attr = nqp::atpos($task,3)(self,attr)) + nqp::if( + nqp::istype(nqp::atpos($task,3),Block), + nqp::stmts( + (my \attr := nqp::getattr(self, + nqp::atpos($task,1), + nqp::atpos($task,2) + )), + (attr = nqp::atpos($task,3)(self,attr)) + ), + nqp::getattr(self,nqp::atpos($task,1),nqp::atpos($task,2)) = + nqp::atpos($task,3) ) ), @@ -216,7 +221,11 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" nqp::bindattr_i(self, nqp::atpos($task,1), nqp::atpos($task,2), - (nqp::atpos($task,3)(self,$int)) + nqp::if( + nqp::istype(nqp::atpos($task,3),Block), + (nqp::atpos($task,3)(self,$int)), + nqp::atpos($task,3) + ) ) ), @@ -230,7 +239,11 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" nqp::bindattr_n(self, nqp::atpos($task,1), nqp::atpos($task,2), - (nqp::atpos($task,3)(self,$num)) + nqp::if( + nqp::istype(nqp::atpos($task,3),Block), + (nqp::atpos($task,3)(self,$num)), + nqp::atpos($task,3) + ) ) ), @@ -244,7 +257,11 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" nqp::bindattr_s(self, nqp::atpos($task,1), nqp::atpos($task,2), - (nqp::atpos($task,3)(self,$str)) + nqp::if( + nqp::istype(nqp::atpos($task,3),Block), + (nqp::atpos($task,3)(self,$str)), + nqp::atpos($task,3) + ) ) ), @@ -343,12 +360,17 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" nqp::atpos($task,1), nqp::atpos($task,2) ), - nqp::stmts( - (my \attr := nqp::getattr(self, - nqp::atpos($task,1), - nqp::atpos($task,2) - )), - (attr = nqp::atpos($task,3)(self,attr)) + nqp::if( + nqp::istype(nqp::atpos($task,3),Block), + nqp::stmts( + (my \attr := nqp::getattr(self, + nqp::atpos($task,1), + nqp::atpos($task,2) + )), + (attr = nqp::atpos($task,3)(self,attr)) + ), + nqp::getattr(self,nqp::atpos($task,1),nqp::atpos($task,2)) = + nqp::atpos($task,3) ) ), @@ -362,7 +384,11 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" nqp::bindattr_i(self, nqp::atpos($task,1), nqp::atpos($task,2), - (nqp::atpos($task,3)(self,$int)) + nqp::if( + nqp::istype(nqp::atpos($task,3),Block), + (nqp::atpos($task,3)(self,$int)), + nqp::atpos($task,3) + ) ) ), @@ -376,7 +402,11 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" nqp::bindattr_n(self, nqp::atpos($task,1), nqp::atpos($task,2), - (nqp::atpos($task,3)(self,$num)) + nqp::if( + nqp::istype(nqp::atpos($task,3),Block), + (nqp::atpos($task,3)(self,$num)), + nqp::atpos($task,3) + ) ) ), @@ -390,7 +420,11 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" nqp::bindattr_s(self, nqp::atpos($task,1), nqp::atpos($task,2), - (nqp::atpos($task,3)(self,$str)) + nqp::if( + nqp::istype(nqp::atpos($task,3),Block), + (nqp::atpos($task,3)(self,$str)), + nqp::atpos($task,3) + ) ) ), diff --git a/src/core/traits.pm b/src/core/traits.pm index c554da036e0..571a8cdce07 100644 --- a/src/core/traits.pm +++ b/src/core/traits.pm @@ -474,7 +474,7 @@ multi sub trait_mod:(Attribute:D $attr, |c ) { highexpect => , ).throw; } -multi sub trait_mod:(Attribute $attr, Block :$build!) { # internal usage +multi sub trait_mod:(Attribute $attr, Mu :$build!) { # internal usage $attr.set_build($build) } From 12774237a6eae858c61c26c8c34df7db06d696fd Mon Sep 17 00:00:00 2001 From: Daniel Green Date: Fri, 6 Oct 2017 20:56:10 -0400 Subject: [PATCH 293/692] Suggest enum values as types Implements RT #123926, e.g., `enum E ; sub x(Floo) {}` now says `Invalid typename 'Floo' in parameter declaration. Did you mean 'Foo'?` --- src/Perl6/World.nqp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index 4503a4c5fb7..3959ed388c8 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -3656,7 +3656,7 @@ class Perl6::World is HLL::World { # only care about type objects my $first := nqp::substr($name, 0, 1); return 1 if $first eq '$' || $first eq '%' || $first eq '@' || $first eq '&' || $first eq ':'; - return 1 if !$has_object || nqp::isconcrete($object); + return 1 if !$has_object || (nqp::isconcrete($object) && !($object.HOW.HOW.name($object.HOW) eq 'Perl6::Metamodel::EnumHOW')); return 1 if nqp::existskey(%seen, $name); %seen{$name} := 1; From 26bdc95c780c58ea9e851167ee66e5e0849d235a Mon Sep 17 00:00:00 2001 From: skids Date: Fri, 6 Oct 2017 22:20:08 -0400 Subject: [PATCH 294/692] Warn on typical precedence errors with infix:<..> (RT#127279) Alerts user to potential accidental use of prefix:<|> or prefix:<~> on a range start value, when they are usually intended to apply to the entire range, and encourages use of parens. --- src/Perl6/Actions.nqp | 19 +++++++++++++++++++ src/core/Exception.pm | 7 +++++++ 2 files changed, 26 insertions(+) diff --git a/src/Perl6/Actions.nqp b/src/Perl6/Actions.nqp index 626deeaade0..a486789ba79 100644 --- a/src/Perl6/Actions.nqp +++ b/src/Perl6/Actions.nqp @@ -6469,6 +6469,16 @@ class Perl6::Actions is HLL::Actions does STDActions { 'fff^', -> $/, $sym { flipflop($/[0].ast, $/[1].ast, 0, 1, 1) }, '^fff^',-> $/, $sym { flipflop($/[0].ast, $/[1].ast, 1, 1, 1) } ); + my %worrisome := nqp::hash( + '..', 1, + '^..', 1, + '..^', 1, + '^..^', 1, + 'R..', 1, + 'R^..', 1, + 'R..^', 1, + 'R^..^', 1 + ); method EXPR($/, $KEY?) { unless $KEY { return 0; } my $past := $/.ast // $.ast; @@ -6636,6 +6646,15 @@ class Perl6::Actions is HLL::Actions does STDActions { :op('hllize'), :returns($past.returns())); } } + if $key eq 'infix' && nqp::existskey(%worrisome, ~$/) { + if ~$/[0] eq '|' { + $/[0].typed_worry('X::Worry::Precedence::Range', action => "apply a Slip flattener to", precursor => 1); + } + elsif ~$/[0] eq '~' { + $/[0].typed_worry('X::Worry::Precedence::Range', action => "stringify", precursor => 1); + } + } + make $past; } diff --git a/src/core/Exception.pm b/src/core/Exception.pm index e87c06bed78..2ef0c26ec60 100644 --- a/src/core/Exception.pm +++ b/src/core/Exception.pm @@ -841,6 +841,13 @@ my class X::Worry::P5::LeadingZero is X::Worry::P5 { ) ~ '. If you meant to create a string, please add quotation marks.' } } +my class X::Worry::Precedence::Range is X::Worry { + has $.action; + method message { +"To $!action a range, parenthesize the whole range. +(Or parenthesize the whole endpoint expression, if you meant that.)" + } +} my class X::Trait::Invalid is Exception { has $.type; # is, will, of etc. From 279bae08a56338f82edac8edbfa2a762eb6f34c3 Mon Sep 17 00:00:00 2001 From: Aleks-Daniel Jakimenko-Aleksejev Date: Sat, 7 Oct 2017 05:25:16 +0300 Subject: [PATCH 295/692] =?UTF-8?q?Mention=20corresponding=20starter=20in?= =?UTF-8?q?=20<,=20<<,=20=C2=AB=20subscripts?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Resolves part of RT #125641. Wordy descriptions were substituted with actual symbols to make it more consistent with other error messages. Also, this way the error message is much shorter. --- src/Perl6/Grammar.nqp | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Perl6/Grammar.nqp b/src/Perl6/Grammar.nqp index 8a4a8da768e..689d147c7b2 100644 --- a/src/Perl6/Grammar.nqp +++ b/src/Perl6/Grammar.nqp @@ -4219,7 +4219,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD { || ", ['q', 'w', 'v']))> '>' || | ':' ] > { $/.panic("Whitespace required before < operator") } - || { $/.panic("Unable to parse quote-words subscript; couldn't find right angle quote") } + || { $/.panic("Unable to parse quote-words subscript; couldn't find '>' (corresponding '<' was at line {HLL::Compiler.lineof($/.orig(), $/.from())})") } ] } @@ -4229,7 +4229,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD { '<<' [ || >", ['qq', 'ww', 'v']))> '>>' - || { $/.panic("Unable to parse quote-words subscript; couldn't find right double-angle quote") } + || { $/.panic("Unable to parse quote-words subscript; couldn't find '>>' (corresponding '<<' was at line {HLL::Compiler.lineof($/.orig(), $/.from())})") } ] } @@ -4239,7 +4239,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD { '«' [ || '»' - || { $/.panic("Unable to parse quote-words subscript; couldn't find right double-angle quote") } + || { $/.panic("Unable to parse quote-words subscript; couldn't find '»' (corresponding '«' was at line {HLL::Compiler.lineof($/.orig(), $/.from())})") } ] } From 6542bb8032e7203b8736655075dbd3452856bc93 Mon Sep 17 00:00:00 2001 From: Aleks-Daniel Jakimenko-Aleksejev Date: Sat, 7 Oct 2017 05:28:48 +0300 Subject: [PATCH 296/692] Mention corresponding starter for most of the things This should handle quotes, parens, brackets, subscripts and many other things. Resolves part of RT #125641. Unfortunately I don't know how to print the actual starter, but as long as the line number is mentioned it's alright. --- src/Perl6/Grammar.nqp | 3 ++- src/core/Exception.pm | 4 +++- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/src/Perl6/Grammar.nqp b/src/Perl6/Grammar.nqp index 689d147c7b2..f233b50c3bc 100644 --- a/src/Perl6/Grammar.nqp +++ b/src/Perl6/Grammar.nqp @@ -255,7 +255,8 @@ role STD { $stopper := $stopper // $goal; $stopper := $stopper ~~ /(.*\S)\s*/; $stopper := ~$stopper[0]; - self.typed_panic('X::Comp::FailGoal', :$dba, :goal($stopper)); + self.typed_panic('X::Comp::FailGoal', :$dba, :goal($stopper), + :line-real(HLL::Compiler.lineof(self.orig(), self.from()))); } method panic(*@args) { diff --git a/src/core/Exception.pm b/src/core/Exception.pm index e87c06bed78..d6229774ac0 100644 --- a/src/core/Exception.pm +++ b/src/core/Exception.pm @@ -766,10 +766,12 @@ my class X::Comp::AdHoc is X::AdHoc does X::Comp { my class X::Comp::FailGoal does X::Comp { has $.dba; has $.goal; + has $.line-real; method is-compile-time(--> True) { } - method message { "Unable to parse expression in $.dba; couldn't find final $.goal" } + method message { "Unable to parse expression in $.dba; couldn't find final $.goal" + ~ " (corresponding starter was at line $.line-real)" } } my role X::Syntax does X::Comp { } From a462d0a26e1d72a494b89cd1a7c4aee9ae654526 Mon Sep 17 00:00:00 2001 From: Aleks-Daniel Jakimenko-Aleksejev Date: Sat, 7 Oct 2017 05:59:06 +0300 Subject: [PATCH 297/692] Cache some line numbers MasterDuke++ https://irclog.perlgeek.de/perl6-dev/2017-10-07#i_15269029 --- src/Perl6/Grammar.nqp | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/src/Perl6/Grammar.nqp b/src/Perl6/Grammar.nqp index f233b50c3bc..13c09feb9d2 100644 --- a/src/Perl6/Grammar.nqp +++ b/src/Perl6/Grammar.nqp @@ -222,7 +222,7 @@ role STD { { my $B := $.ast; $lang := $B[0]; $start := $B[1]; $stop := $B[2]; } - $start [ $stop || { $/.typed_panic('X::Comp::AdHoc', payload => "Couldn't find terminator $stop (corresponding $start was at line {HLL::Compiler.lineof($.orig(), $.from())})", expected => [$stop] ) } ] + $start [ $stop || { $/.typed_panic('X::Comp::AdHoc', payload => "Couldn't find terminator $stop (corresponding $start was at line {HLL::Compiler.lineof($.orig(), $.from(), :cache(1))})", expected => [$stop] ) } ] { nqp::can($lang, 'herelang') && self.queue_heredoc( @@ -256,7 +256,8 @@ role STD { $stopper := $stopper ~~ /(.*\S)\s*/; $stopper := ~$stopper[0]; self.typed_panic('X::Comp::FailGoal', :$dba, :goal($stopper), - :line-real(HLL::Compiler.lineof(self.orig(), self.from()))); + :line-real(HLL::Compiler.lineof(self.orig(), self.from(), + :cache(1)))); } method panic(*@args) { @@ -4220,7 +4221,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD { || ", ['q', 'w', 'v']))> '>' || | ':' ] > { $/.panic("Whitespace required before < operator") } - || { $/.panic("Unable to parse quote-words subscript; couldn't find '>' (corresponding '<' was at line {HLL::Compiler.lineof($/.orig(), $/.from())})") } + || { $/.panic("Unable to parse quote-words subscript; couldn't find '>' (corresponding '<' was at line {HLL::Compiler.lineof($/.orig(), $/.from(), :cache(1))})") } ] } @@ -4230,7 +4231,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD { '<<' [ || >", ['qq', 'ww', 'v']))> '>>' - || { $/.panic("Unable to parse quote-words subscript; couldn't find '>>' (corresponding '<<' was at line {HLL::Compiler.lineof($/.orig(), $/.from())})") } + || { $/.panic("Unable to parse quote-words subscript; couldn't find '>>' (corresponding '<<' was at line {HLL::Compiler.lineof($/.orig(), $/.from(), :cache(1))})") } ] } @@ -4240,7 +4241,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD { '«' [ || '»' - || { $/.panic("Unable to parse quote-words subscript; couldn't find '»' (corresponding '«' was at line {HLL::Compiler.lineof($/.orig(), $/.from())})") } + || { $/.panic("Unable to parse quote-words subscript; couldn't find '»' (corresponding '«' was at line {HLL::Compiler.lineof($/.orig(), $/.from(), :cache(1))})") } ] } From 16c2a157674c47291801ef30df5146f84e3029b8 Mon Sep 17 00:00:00 2001 From: Daniel Green Date: Fri, 6 Oct 2017 23:22:18 -0400 Subject: [PATCH 298/692] Use cached line numbers for token label --- src/Perl6/Grammar.nqp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Perl6/Grammar.nqp b/src/Perl6/Grammar.nqp index 8a4a8da768e..909f6ecdf76 100644 --- a/src/Perl6/Grammar.nqp +++ b/src/Perl6/Grammar.nqp @@ -1281,7 +1281,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD { my int $total := nqp::chars($orig); my int $from := self.MATCH.from(); my int $to := self.MATCH.to() + nqp::chars($*LABEL); - my int $line := HLL::Compiler.lineof($orig, self.from()); + my int $line := HLL::Compiler.lineof($orig, self.from(), :cache(1)); my str $prematch := nqp::substr($orig, $from > 20 ?? $from - 20 !! 0, $from > 20 ?? 20 !! $from); my str $postmatch := nqp::substr($orig, $to, 20); my $label := $*W.find_symbol(['Label']).new( :name($*LABEL), :$line, :$prematch, :$postmatch ); From 4868e9271a734785ba100f05c19f5c4ea808d6b5 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 7 Oct 2017 11:47:05 +0000 Subject: [PATCH 299/692] Remove dead code for `use v5` Dies while complaining about missing `Perl5` module. A thought occured to make it load Inline::Perl5, but felt like useless magic, so I removed the code entirely and just make it complain there's no compiler for v5, like it'd do for `use v6.z` Fixes RT#130834: https://rt.perl.org/Ticket/Display.html?id=130834 --- src/Perl6/Grammar.nqp | 5 ----- t/05-messages/01-errors.t | 3 +++ 2 files changed, 3 insertions(+), 5 deletions(-) diff --git a/src/Perl6/Grammar.nqp b/src/Perl6/Grammar.nqp index 8a4a8da768e..96a806d44ac 100644 --- a/src/Perl6/Grammar.nqp +++ b/src/Perl6/Grammar.nqp @@ -1607,11 +1607,6 @@ grammar Perl6::Grammar is HLL::Grammar does STD { # we parse out the numeral, since we could have "6c" :my $version := nqp::radix(10,$[0],0,0)[0]; [ - || { - my $module := $*W.load_module($/, 'Perl5', {}, $*GLOBALish); - $*W.do_import($/, $module, 'Perl5'); - $*W.import_EXPORTHOW($/, $module); - } || { my $version_parts := $; my $vwant := $.ast.compile_time_value; diff --git a/t/05-messages/01-errors.t b/t/05-messages/01-errors.t index 76af7bc421f..dda3c621878 100644 --- a/t/05-messages/01-errors.t +++ b/t/05-messages/01-errors.t @@ -225,6 +225,9 @@ subtest '`IO::Socket::INET.new: :listen` fails with useful error' => { like $res.exception.message, /'Invalid port'/, 'error mentions port'; } +throws-like 「use v5」, X::Language::Unsupported, + '`use v5` in code does not try to load non-existent modules'; + done-testing; # vim: ft=perl6 expandtab sw=4 From bc648184f60179210f4a1f2c1d5aedcc8e714d65 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sun, 1 Oct 2017 14:35:01 +0000 Subject: [PATCH 300/692] Make cmp-ok try harder to get useful description Merely stringifying the $got/$expected sometimes results in warnings/empty descriptions in the failed description output. Make descriptions via .perl//.gist --- lib/Test.pm6 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/lib/Test.pm6 b/lib/Test.pm6 index 6ba89e9f131..3b173657a94 100644 --- a/lib/Test.pm6 +++ b/lib/Test.pm6 @@ -248,9 +248,11 @@ multi sub cmp-ok(Mu $got, $op, Mu $expected, $desc = '') is export { if $matcher { $ok = proclaim($matcher($got,$expected), $desc); if !$ok { - _diag "expected: '" ~ ($expected // $expected.^name) ~ "'\n" + my $expected-desc = (try $expected.perl) // $expected.gist; + my $got-desc = (try $got .perl) // $got .gist; + _diag "expected: $expected-desc\n" ~ " matcher: '" ~ ($matcher.?name || $matcher.^name) ~ "'\n" - ~ " got: '$got'"; + ~ " got: $got-desc"; } } else { From 7b89a3f134bb73804dd049a7d2ba223728bca75f Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sun, 1 Oct 2017 14:36:54 +0000 Subject: [PATCH 301/692] Add S24-testing/13-cmp-ok.t to list of test files --- t/spectest.data | 1 + 1 file changed, 1 insertion(+) diff --git a/t/spectest.data b/t/spectest.data index 881972a3110..10f136542ad 100644 --- a/t/spectest.data +++ b/t/spectest.data @@ -911,6 +911,7 @@ S24-testing/10-is-approx.t S24-testing/11-plan-skip-all.t # stress S24-testing/11-plan-skip-all-subtests.t S24-testing/12-subtest-todo.t +S24-testing/13-cmp-ok.t S24-testing/line-numbers.t S26-documentation/01-delimited.t S26-documentation/02-paragraph.t From 50c116315c7ea3c7f1678766960b6767b6417416 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sun, 1 Oct 2017 14:58:31 +0000 Subject: [PATCH 302/692] Make List.ACCEPTS non-fatal for lazy iterables Since we tend to never die in our other ACCEPTS --- src/core/List.pm | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/core/List.pm b/src/core/List.pm index 8bedef1951b..f4472dbc13a 100644 --- a/src/core/List.pm +++ b/src/core/List.pm @@ -647,6 +647,9 @@ my class List does Iterable does Positional { # declared in BOOTSTRAP } multi method ACCEPTS(List:D: $topic) { + CATCH { default { return False } } # .elems on lazies throws + return True if nqp::eqaddr(self, nqp::decont($topic)); + unless nqp::istype($topic, Iterable) { return self unless self.elems; return self if nqp::istype(self[0], Match); From ac4e73cd08fedb5e8e36ceb1f919af6005fe22e5 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sun, 1 Oct 2017 16:18:32 +0000 Subject: [PATCH 303/692] =?UTF-8?q?Fix=20regex=20`**`=20with=20non-Int=20v?= =?UTF-8?q?alues=E2=80=A6?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit …leaving behind unhandled Failures --- src/core/Match.pm | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/src/core/Match.pm b/src/core/Match.pm index 86df68d3e61..a496e8c5ee7 100644 --- a/src/core/Match.pm +++ b/src/core/Match.pm @@ -447,13 +447,15 @@ my class Match is Capture is Cool does NQPMatchRole { nqp::list_i($min,$max))))))), nqp::if( nqp::istype((my $v := $mm.Int), Failure), - nqp::if( - nqp::istype($mm,Numeric) && nqp::isfalse($mm.isNaN), + nqp::stmts( + ($v.so), # handle Failure nqp::if( - $mm == Inf, - X::Syntax::Regex::QuantifierValue.new(:inf).throw, - nqp::list_i(0,0)), # if we got here, $mm is -Inf, treat as zero - X::Syntax::Regex::QuantifierValue.new(:non-numeric).throw), + nqp::istype($mm,Numeric) && nqp::isfalse($mm.isNaN), + nqp::if( + $mm == Inf, + X::Syntax::Regex::QuantifierValue.new(:inf).throw, + nqp::list_i(0,0)), # if we got here, $mm is -Inf, treat as zero + X::Syntax::Regex::QuantifierValue.new(:non-numeric).throw)), nqp::if( nqp::islt_i($v,0), nqp::list_i(0,0), From f254e359d79b5953a019802fcd956421731282dc Mon Sep 17 00:00:00 2001 From: skids Date: Sun, 1 Oct 2017 12:29:36 -0400 Subject: [PATCH 304/692] Fix some unspace parsing cases (RT#128462 and degenerate unspace) see RT for analysis/explanation --- src/Perl6/Grammar.nqp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Perl6/Grammar.nqp b/src/Perl6/Grammar.nqp index f4303361bdf..8a4a8da768e 100644 --- a/src/Perl6/Grammar.nqp +++ b/src/Perl6/Grammar.nqp @@ -3344,7 +3344,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD { token term:sym { :my $pos; - ]) }> |'('> + ]) }> [ ? '('> | \\ ] { $pos := $/.pos } { @@ -3422,7 +3422,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD { } } [ ]? - || + || [ \\ ]? { if !$ { my $name := ~$; From 4c49e7472265e3444c0366714b92284a1435fb1d Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sun, 1 Oct 2017 21:02:46 +0200 Subject: [PATCH 305/692] We actually don't need an nqp::stmts for accessors This probably doesn't mean much in the scale of things, but it *does* happen at compilation for every public attribute. --- src/Perl6/World.nqp | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index 563d9026627..5794de3271b 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -3006,7 +3006,7 @@ class Perl6::World is HLL::World { # Set up the actual statements, starting with "self" # nqp::attribute(self,$package_type,$attr_name) - my $stmts := QAST::Var.new( + my $accessor := QAST::Var.new( :scope($native && $rw ?? 'attributeref' !! 'attribute'), :name($attr_name), :returns($type), @@ -3016,7 +3016,7 @@ class Perl6::World is HLL::World { # Opaque and read-only accessors need a decont unless $native || $rw { - $stmts := QAST::Op.new( :op, $stmts ); + $accessor := QAST::Op.new( :op, $accessor ); } # Create the block @@ -3024,7 +3024,7 @@ class Perl6::World is HLL::World { :name($meth_name), :blocktype('declaration_static'), QAST::Stmts.new( $pself, $p_ ), - QAST::Stmts.new($stmts) + $accessor ); # Make sure the block has a SC From fe89d350492dbf0842a5c913de0d3b174d0d6447 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Mon, 2 Oct 2017 12:56:25 +0200 Subject: [PATCH 306/692] Attributes set from nqp land wind up unhllized - circumvent the issue by making the attributes natives - fixes failures in S32-str/sprintf.t that occurred since BUILDALL refactor --- src/core/Exception.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/Exception.pm b/src/core/Exception.pm index 67b021d6b66..3350e3d2ca0 100644 --- a/src/core/Exception.pm +++ b/src/core/Exception.pm @@ -2007,8 +2007,8 @@ my class X::Str::Trans::InvalidArg is Exception { } my class X::Str::Sprintf::Directives::Count is Exception { - has $.args-used; - has $.args-have; + has int $.args-used; + has num $.args-have; method message() { "Your printf-style directives specify " ~ ($.args-used == 1 ?? "1 argument, but " From e99fff7b774bb0063c06d0a0748d6aea42d999eb Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Mon, 2 Oct 2017 13:23:37 +0200 Subject: [PATCH 307/692] We shouldn't let BUILDALL installation fail silently We want to be able to remove the actual BUILDALLPLAN from memory once the method is installed. --- src/Perl6/Metamodel/ClassHOW.nqp | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/Perl6/Metamodel/ClassHOW.nqp b/src/Perl6/Metamodel/ClassHOW.nqp index df8f6dde372..15730b04386 100644 --- a/src/Perl6/Metamodel/ClassHOW.nqp +++ b/src/Perl6/Metamodel/ClassHOW.nqp @@ -163,9 +163,7 @@ class Perl6::Metamodel::ClassHOW $builder($compiler_services,$obj,$BUILDALLPLAN); unless $method =:= NQPMu { $method.set_name('BUILDALL'); - my $result := try { - self.add_method($obj,'BUILDALL',$method); - } + self.add_method($obj,'BUILDALL',$method); } } } From 2e2c0abd3648553a38391b589f77cd1a780dc5d4 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Mon, 2 Oct 2017 13:59:10 +0200 Subject: [PATCH 308/692] Make the use-case a native str If we get one passed from NQP land, e.g. with "BEGIN die", we can handle it. This is another ad-hoc fix for an apparent change in behaviour between autogenerated BUILDALL and Mu.BUILDALL. --- src/core/Exception.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/Exception.pm b/src/core/Exception.pm index 3350e3d2ca0..55e0eed7958 100644 --- a/src/core/Exception.pm +++ b/src/core/Exception.pm @@ -733,7 +733,7 @@ my class X::Comp::Group is Exception { my role X::MOP is Exception { } my class X::Comp::BeginTime does X::Comp { - has $.use-case; + has str $.use-case; has $.exception; method message() { From e9cf90e760eae582d64d751d071da505acd4db91 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Mon, 2 Oct 2017 14:15:31 +0200 Subject: [PATCH 309/692] Should check both (sub)method tables for BUILDALL - because a class could have a custom method BUILDALL - also fix typo in name, spotted by timotimo++ --- src/Perl6/Metamodel/ClassHOW.nqp | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/src/Perl6/Metamodel/ClassHOW.nqp b/src/Perl6/Metamodel/ClassHOW.nqp index 15730b04386..5c32f04dc82 100644 --- a/src/Perl6/Metamodel/ClassHOW.nqp +++ b/src/Perl6/Metamodel/ClassHOW.nqp @@ -153,14 +153,16 @@ class Perl6::Metamodel::ClassHOW # Mu will be used, which will iterate over the BUILDALLPLAN at # runtime). if nqp::isconcrete($compiler_services) { - if nqp::existskey($obj.HOW.method_table($obj),'BUILDPLAN') { - nqp::say($obj.HOW.name($obj) ~ ' already has a BUILDALL'); - } - else { + + # Class does not appear to have a BUILDALL yet + unless nqp::existskey($obj.HOW.submethod_table($obj),'BUILDALL') + || nqp::existskey($obj.HOW.method_table($obj),'BUILDALL') { my $builder := nqp::findmethod( $compiler_services,'generate_buildplan_executor'); my $method := $builder($compiler_services,$obj,$BUILDALLPLAN); + + # We have a generated BUILDALL submethod, so install! unless $method =:= NQPMu { $method.set_name('BUILDALL'); self.add_method($obj,'BUILDALL',$method); From 8ffe10d4e6ff15c1b543b0122a14988369b8a07c Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Mon, 2 Oct 2017 09:27:14 -0400 Subject: [PATCH 310/692] Fix &chdir failing to respect :CWD attribute The method simply uses Str() coercion, but .Str on IO::Paths ignores their :CWD attribute, which causes &chdir into such IO::Paths to chdir into the wrong dir. --- src/core/IO/Path.pm | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/core/IO/Path.pm b/src/core/IO/Path.pm index c1baace2df2..39cc963b6b1 100644 --- a/src/core/IO/Path.pm +++ b/src/core/IO/Path.pm @@ -408,6 +408,9 @@ my class IO::Path is Cool does IO { ); self.chdir: $path, |$test.words.map(* => True).Hash; } + multi method chdir(IO::Path:D: IO $path, |c) { + self.chdir: $path.absolute, |c + } multi method chdir( IO::Path:D: Str() $path is copy, :$d = True, :$r, :$w, :$x, ) { From b0a6cd9ed996acb04f56ee2ec21d0c241db4c37f Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Mon, 2 Oct 2017 17:13:12 +0200 Subject: [PATCH 311/692] Only fetch BUILDALLPLAN if we need it --- src/Perl6/Metamodel/ClassHOW.nqp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Perl6/Metamodel/ClassHOW.nqp b/src/Perl6/Metamodel/ClassHOW.nqp index 5c32f04dc82..a9ed54cf448 100644 --- a/src/Perl6/Metamodel/ClassHOW.nqp +++ b/src/Perl6/Metamodel/ClassHOW.nqp @@ -147,7 +147,7 @@ class Perl6::Metamodel::ClassHOW unless $was_composed { # Create BUILDPLAN. - my $BUILDALLPLAN := self.create_BUILDPLAN($obj); + self.create_BUILDPLAN($obj); # Create BUILDALL method if we can (if we can't, the one from # Mu will be used, which will iterate over the BUILDALLPLAN at @@ -160,7 +160,7 @@ class Perl6::Metamodel::ClassHOW my $builder := nqp::findmethod( $compiler_services,'generate_buildplan_executor'); my $method := - $builder($compiler_services,$obj,$BUILDALLPLAN); + $builder($compiler_services,$obj,self.BUILDALLPLAN($obj)); # We have a generated BUILDALL submethod, so install! unless $method =:= NQPMu { From 232b0852960148511e5483e2ab13cceab31f12e7 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Mon, 2 Oct 2017 18:24:58 +0200 Subject: [PATCH 312/692] Make only one CompilerServices instance per World We have to clean it up at the end of compilation; failing to do so can break precompilation. --- src/Perl6/World.nqp | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index 5794de3271b..afcf48614e0 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -3483,12 +3483,14 @@ class Perl6::World is HLL::World { } method get_compiler_services() { - try { - my $wtype := self.find_symbol(['Rakudo', 'Internals', 'CompilerServices']); - my $wrapped := CompilerServices.new(w => self); - my $wrapper := nqp::create($wtype); - nqp::bindattr($wrapper, $wtype, '$!compiler', $wrapped); - $!compiler_services := $wrapper; + unless nqp::isconcrete($!compiler_services) { + try { + my $wtype := self.find_symbol(['Rakudo', 'Internals', 'CompilerServices']); + my $wrapped := CompilerServices.new(w => self); + my $wrapper := nqp::create($wtype); + nqp::bindattr($wrapper, $wtype, '$!compiler', $wrapped); + $!compiler_services := $wrapper; + } } $!compiler_services } From 50538ad891dbfa7ffb2186eaab7a7d692dd5ef7b Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Tue, 3 Oct 2017 10:30:35 +0200 Subject: [PATCH 313/692] Make all classes with empty BUILDALLPLAN share BUILDALL - so they don't need to go to Mu.BUILDALL and run the plan --- src/Perl6/World.nqp | 373 ++++++++++++++++++++++++-------------------- 1 file changed, 203 insertions(+), 170 deletions(-) diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index afcf48614e0..20f1e26d1bb 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -2968,6 +2968,9 @@ class Perl6::World is HLL::World { has $!acc_sig_cache; has $!acc_sig_cache_type; + # The generic BUILDALL method for empty BUILDPLANs + has $!empty_buildplan_method; + # Parameters we always need my $pself := QAST::Var.new(:decl, :scope, :name); my $pauto := QAST::Var.new(:decl, :scope, :name<@auto>); @@ -3081,85 +3084,130 @@ class Perl6::World is HLL::World { '$!reified' ); - # No buildplan? we're done! - my int $count := nqp::elems($build_plan); - unless $count { - - # Indicate that we're not going to auto-generate a BUILDALL - # for this class, but let it be handled by Mu.BUILDALL. - return NQPMu; - } + if nqp::elems($build_plan) -> $count { - # The bare object - my $object := nqp::decont($in_object); + # The bare object + my $object := nqp::decont($in_object); - # Do we need to wrap an exception handler - my int $needs_wrapping; + # Do we need to wrap an exception handler + my int $needs_wrapping; - # The basic statements for object initialization, to be - # filled in later - my $stmts := QAST::Stmts.new(); + # The basic statements for object initialization, to be + # filled in later + my $stmts := QAST::Stmts.new(); - my $declarations := QAST::Stmts.new($pself, $pauto, $pinit, $dinit); + my $declarations := + QAST::Stmts.new($pself, $pauto, $pinit, $dinit); - # The block of the method - my $block := QAST::Block.new( - :name, :blocktype, - $declarations - ); + # The block of the method + my $block := QAST::Block.new( + :name, :blocktype, + $declarations + ); - # Register the block in its SC - $!w.cur_lexpad()[0].push($block); + # Register the block in its SC + $!w.cur_lexpad()[0].push($block); - # Create the invocant type we need - my $invocant_type := $!w.create_definite_type( - $!w.find_symbol(['Metamodel','DefiniteHOW']), - $object, - 1 - ); + # Create the invocant type we need + my $invocant_type := $!w.create_definite_type( + $!w.find_symbol(['Metamodel','DefiniteHOW']), + $object, + 1 + ); - # Debugging -# $stmts.push( -# QAST::Op.new( :op, -# QAST::SVal.new( :value( -# $object.HOW.name($object) ~ '.BUILDALL called' -# )) -# ), -# ); -# $stmts.push( -# QAST::Op.new( :op, -# QAST::Op.new( :op, :name, $hllinit ) -# ) -# ); + # Debugging +# $stmts.push( +# QAST::Op.new( :op, +# QAST::SVal.new( :value( +# $object.HOW.name($object) ~ '.BUILDALL called' +# )) +# ), +# ); +# $stmts.push( +# QAST::Op.new( :op, +# QAST::Op.new( :op, :name, $hllinit ) +# ) +# ); # my $init := nqp::getattr(%init,Map,'$!storage') - $stmts.push(QAST::Op.new( :op, - $init, - QAST::Op.new( :op, - $hllinit, - QAST::WVal.new( :value($!w.find_symbol(['Map'])) ), - $storage - ) - )); + $stmts.push(QAST::Op.new( :op, + $init, + QAST::Op.new( :op, + $hllinit, + QAST::WVal.new( :value($!w.find_symbol(['Map'])) ), + $storage + ) + )); + + # Do all of the actions in the BUILDPLAN + my int $i := -1; + while nqp::islt_i($i := nqp::add_i($i, 1), $count) { + + # We have some intricate action to do + if nqp::islist(my $task := nqp::atpos($build_plan,$i)) { + + # Register the class in the SC if needed + $!w.add_object_if_no_sc( nqp::atpos($task,1) ); + + # We always need the class object & full attribute name + my $class := + QAST::WVal.new( :value(nqp::atpos($task,1)) ); + my $attr := + QAST::SVal.new( :value(nqp::atpos($task,2)) ); + + my int $code := nqp::atpos($task,0); + # 0 = initialize opaque from %init + if $code == 0 { + +# 'a' + my $key := + QAST::SVal.new( :value(nqp::atpos($task,3)) ); + +# nqp::getattr(self,Foo,'$!a') + my $getattr := QAST::Op.new( :op, + $self, $class, $attr + ); + +# nqp::if( +# nqp::existskey($init,'a'), + my $if := QAST::Op.new( :op, + QAST::Op.new( :op, $init, $key) + ); - # Do all of the actions in the BUILDPLAN - my int $i := -1; - while nqp::islt_i($i := nqp::add_i($i, 1), $count) { +# %init.AT-KEY('a') + my $value := QAST::Op.new( :op, + :name, $hllinit, $key + ); - # We have some intricate action to do - if nqp::islist(my $task := nqp::atpos($build_plan,$i)) { + my $sigil := nqp::substr(nqp::atpos($task,2),0,1); - # Register the class in the SC if needed - $!w.add_object_if_no_sc( nqp::atpos($task,1) ); +# nqp::getattr(self,Foo,'$!a').STORE(%init.AT-KEY('a')) + if $sigil eq '@' || $sigil eq '%' { + $if.push( + QAST::Op.new( :op, :name, + $getattr, $value + ) + ); + } - # We always need the class object and full attribute name - my $class := QAST::WVal.new( :value(nqp::atpos($task,1)) ); - my $attr := QAST::SVal.new( :value(nqp::atpos($task,2)) ); +# nqp::getattr(self,Foo,'$!a') = %init.AT-KEY('a') + else { + $if.push( + QAST::Op.new( + :op( $sigil eq '$' || $sigil eq '&' + ?? 'assign' !! 'p6store' + ), + $getattr, $value + ) + ); + } - if nqp::atpos($task,0) -> $code { +# ), + $stmts.push($if); + } # 1,2,3 = initialize native from %init - if $code < 4 { + elsif $code < 4 { # nqp::if( # nqp::existskey($init,'a'), @@ -3345,66 +3393,16 @@ class Perl6::World is HLL::World { } } - # 0 = initialize opaque from %init + # BUILD/TWEAK else { -# 'a' - my $key := QAST::SVal.new(:value(nqp::atpos($task,3))); - -# nqp::getattr(self,Foo,'$!a') - my $getattr := QAST::Op.new( :op, - $self, $class, $attr - ); - -# nqp::if( -# nqp::existskey($init,'a'), - my $if := QAST::Op.new( :op, - QAST::Op.new( :op, $init, $key) - ); - -# %init.AT-KEY('a') - my $value := QAST::Op.new(:op,:name, - $hllinit, $key - ); - - my $sigil := nqp::substr(nqp::atpos($task,2),0,1); - -# nqp::getattr(self,Foo,'$!a').STORE(%init.AT-KEY('a')) - if $sigil eq '@' || $sigil eq '%' { - $if.push( - QAST::Op.new( :op, :name, - $getattr, $value - ) - ); - } - -# nqp::getattr(self,Foo,'$!a') = %init.AT-KEY('a') - else { - $if.push( - QAST::Op.new( - :op( $sigil eq '$' || $sigil eq '&' - ?? 'assign' !! 'p6store' - ), - $getattr, $value - ) - ); - } - -# ), - $stmts.push($if); - } - } - - # BUILD/TWEAK - else { - - # BUILD or TWEAK without BUILD (first seen) - unless $needs_wrapping { + # BUILD or TWEAK without BUILD (first seen) + unless $needs_wrapping { # (my $return), - $declarations.push($dreturn); - $needs_wrapping := 1 - }; + $declarations.push($dreturn); + $needs_wrapping := 1 + } # nqp::if( # nqp::istype( @@ -3417,75 +3415,110 @@ class Perl6::World is HLL::World { # ), # return $return # ), - $stmts.push( - QAST::Op.new( :op, - QAST::Op.new( :op, - QAST::Op.new( :op, - $return, - QAST::Op.new( :op, - QAST::Op.new( :op, $init ), - QAST::Op.new( :op, - QAST::WVal.new( :value($task) ), - $self, - QAST::Var.new( - :scope, - :name, # use nqp::hash directly - :flat(1), - :named(1) - ), + $stmts.push( + QAST::Op.new( :op, + QAST::Op.new( :op, + QAST::Op.new( :op, + $return, + QAST::Op.new( :op, + QAST::Op.new( :op, $init ), + QAST::Op.new( :op, + QAST::WVal.new( :value($task) ), + $self, + QAST::Var.new( + :scope, + :name, # use nqp::hash directly + :flat(1), + :named(1) + ), + ), + QAST::Op.new( :op, + QAST::WVal.new( :value($task) ), + $self, + ) + ) ), - QAST::Op.new( :op, - QAST::WVal.new( :value($task) ), - $self, - ) + QAST::WVal.new( + :value($!w.find_symbol(['Failure'])) + ), + ), + QAST::Op.new( :op, + QAST::WVal.new( + :value($!w.find_symbol(['&return'])) + ), + QAST::Var.new(:scope, :name) ) - ), - QAST::WVal.new( - :value($!w.find_symbol(['Failure'])) - ), - ), - QAST::Op.new( :op, - QAST::WVal.new( - :value($!w.find_symbol(['&return'])) - ), - QAST::Var.new(:scope, :name) - ) - ) - ); + ) + ); - $!w.add_object_if_no_sc($task); + $!w.add_object_if_no_sc($task); + } + } + + # Finally, add the return value + $stmts.push($self); + + # Need to wrap an exception handler around + if $needs_wrapping { + $stmts := QAST::Op.new( :op, + $stmts, + 'RETURN', + QAST::Op.new( :op ) + ); } - } - # Finally, add the return value - $stmts.push($self); + # Add the statements to the block + $block.push($stmts); - # Need to wrap an exception handler around - if $needs_wrapping { - $stmts := QAST::Op.new( :op, - $stmts, - 'RETURN', - QAST::Op.new( :op ) +# :(Foo:D: %init) + my $sig := $!w.create_signature_and_params( + NQPMu, %sig_init, $block, 'Any', :method, :$invocant_type ); + + # Create the code object and return it + $!w.create_code_object($block, 'Submethod', $sig) } - # Add the statements to the block - $block.push($stmts); + # Empty buildplan, and we already have an empty buildplan method + elsif $!empty_buildplan_method { + $!empty_buildplan_method + } -# :(Foo:D: %init) - my $sig := $!w.create_signature_and_params( - NQPMu, %sig_init, $block, 'Any', :method, :$invocant_type - ); + # Empty buildplan, still need to make an empty method + else { + +# submethod :: (Any:D:) { self } + my $block := QAST::Block.new( + :name, :blocktype, + QAST::Stmts.new($pself, $pauto, $pinit), + $self + ); + + # Register the block in its SC + $!w.cur_lexpad()[0].push($block); + + my $invocant_type := $!w.create_definite_type( + $!w.find_symbol(['Metamodel','DefiniteHOW']), + $!w.find_symbol(['Any']), + 1 + ); - # Create the code object and return it - $!w.create_code_object($block, 'Submethod', $sig) + my $sig := $!w.create_signature_and_params( + NQPMu, %sig_init, $block, 'Any', :method, :$invocant_type + ); + + # Create the code object, save and return it + $!empty_buildplan_method := + $!w.create_code_object($block, 'Submethod', $sig) + } } } method get_compiler_services() { unless nqp::isconcrete($!compiler_services) { try { - my $wtype := self.find_symbol(['Rakudo', 'Internals', 'CompilerServices']); + my $wtype := + self.find_symbol(['Rakudo','Internals','CompilerServices']); my $wrapped := CompilerServices.new(w => self); my $wrapper := nqp::create($wtype); nqp::bindattr($wrapper, $wtype, '$!compiler', $wrapped); From 01203bda3c650b351a40dcb0c16300b037481c6c Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Tue, 3 Oct 2017 12:31:08 +0200 Subject: [PATCH 314/692] Make sure all empty BUILDPLANs are shared - this should save a bit of memory for each class created --- src/Perl6/Metamodel/BUILDPLAN.nqp | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/src/Perl6/Metamodel/BUILDPLAN.nqp b/src/Perl6/Metamodel/BUILDPLAN.nqp index 19823bb331e..bd025509b1c 100644 --- a/src/Perl6/Metamodel/BUILDPLAN.nqp +++ b/src/Perl6/Metamodel/BUILDPLAN.nqp @@ -2,6 +2,9 @@ role Perl6::Metamodel::BUILDPLAN { has @!BUILDALLPLAN; has @!BUILDPLAN; + # Empty BUILDPLAN shared by all classes with empty BUILDPLANs + my @EMPTY := nqp::list; + # Creates the plan for building up the object. This works # out what we'll need to do up front, so we can just zip # through the "todo list" each time we need to make an object. @@ -101,7 +104,7 @@ role Perl6::Metamodel::BUILDPLAN { } # Install plan for this class. - @!BUILDPLAN := @plan; + @!BUILDPLAN := +@plan ?? @plan !! @EMPTY; # Now create the full plan by getting the MRO, and working from # least derived to most derived, copying the plans. @@ -123,7 +126,9 @@ role Perl6::Metamodel::BUILDPLAN { } # if same number of elems and no noops, identical, so just keep 1 copy - @!BUILDALLPLAN := $noops || +@all_plan != +@plan ?? @all_plan !! @plan; + @!BUILDALLPLAN := $noops || +@all_plan != +@plan + ?? @all_plan + !! @!BUILDPLAN; # if empty, shared across classes } method BUILDPLAN($obj) { From 16cb67980a7591a66d9259680b980c81067d3f8c Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Tue, 3 Oct 2017 13:06:35 +0200 Subject: [PATCH 315/692] Additional BUILDPLAN sharing - if a class has an empty BUILDPLAN, it will not add to the BUILDALLPLAN - therefore its BUILDALLPLAN is the same as its first parent in MRO This should save memory for all mixins that don't add any attributes. --- src/Perl6/Metamodel/BUILDPLAN.nqp | 61 ++++++++++++++++++++----------- 1 file changed, 39 insertions(+), 22 deletions(-) diff --git a/src/Perl6/Metamodel/BUILDPLAN.nqp b/src/Perl6/Metamodel/BUILDPLAN.nqp index bd025509b1c..2111ee56fcc 100644 --- a/src/Perl6/Metamodel/BUILDPLAN.nqp +++ b/src/Perl6/Metamodel/BUILDPLAN.nqp @@ -103,32 +103,49 @@ role Perl6::Metamodel::BUILDPLAN { nqp::push(@plan,$TWEAK); } - # Install plan for this class. - @!BUILDPLAN := +@plan ?? @plan !! @EMPTY; - - # Now create the full plan by getting the MRO, and working from - # least derived to most derived, copying the plans. - my @all_plan; - my @mro := self.mro($obj); - my $i := +@mro; - my $noops := 0; - while $i > 0 { - $i := $i - 1; - my $class := @mro[$i]; - for $class.HOW.BUILDPLAN($class) { - if nqp::islist($_) && $_[0] == 10 { # noop in BUILDALLPLAN - $noops := 1; - } - else { - nqp::push(@all_plan, $_); + # Something in the buildplan of this class + if @plan { + + # Install plan for this class. + @!BUILDPLAN := @plan; + + # Now create the full plan by getting the MRO, and working from + # least derived to most derived, copying the plans. + my @all_plan; + my @mro := self.mro($obj); + my $i := +@mro; + my $noops := 0; + while $i > 0 { + $i := $i - 1; + my $class := @mro[$i]; + for $class.HOW.BUILDPLAN($class) { + if nqp::islist($_) && $_[0] == 10 { # noop in BUILDALLPLAN + $noops := 1; + } + else { + nqp::push(@all_plan, $_); + } } } + + # Same number of elems and no noops, identical, so just keep 1 copy + @!BUILDALLPLAN := $noops || +@all_plan != +@plan + ?? @all_plan + !! @plan } - # if same number of elems and no noops, identical, so just keep 1 copy - @!BUILDALLPLAN := $noops || +@all_plan != +@plan - ?? @all_plan - !! @!BUILDPLAN; # if empty, shared across classes + # BUILDPLAN of class itself is empty + else { + + # Share the empty BUILDPLAN + @!BUILDPLAN := @EMPTY; + + # Take the first "super"class's BUILDALLPLAN if possible + my @mro := self.mro($obj); + @!BUILDALLPLAN := +@mro > 1 + ?? @mro[1].HOW.BUILDALLPLAN(@mro[1]) + !! @EMPTY + } } method BUILDPLAN($obj) { From 037a6cf8fae34c37eea1debac930ac45576b01bc Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Tue, 3 Oct 2017 13:42:40 +0200 Subject: [PATCH 316/692] Set up auto-generated signature correctly - the first array parameter was set up correctly in declarations - but not in the signature, so introspection showed you the wrong thing --- src/Perl6/World.nqp | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index 20f1e26d1bb..0ccab0f29f8 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -2994,7 +2994,10 @@ class Perl6::World is HLL::World { # signature configuration hashes my %sig_empty := nqp::hash('parameters', []); # :() my %sig_init := nqp::hash( - 'parameters', [nqp::hash('variable_name','%init')] + 'parameters', [ + nqp::hash('variable_name','@auto'), + nqp::hash('variable_name','%init') + ] ); # Generate an accessor method with the given method name, package, From 71dc01e72a6208e3cc878aa178fadd5b381e45a4 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Tue, 3 Oct 2017 14:52:31 +0200 Subject: [PATCH 317/692] Don't bother with BUILDALL if BUILDPLAN is empty - because the next class with a BUILDALL in ^mro will do the right thing --- src/Perl6/Metamodel/ClassHOW.nqp | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/src/Perl6/Metamodel/ClassHOW.nqp b/src/Perl6/Metamodel/ClassHOW.nqp index a9ed54cf448..e9e05f01783 100644 --- a/src/Perl6/Metamodel/ClassHOW.nqp +++ b/src/Perl6/Metamodel/ClassHOW.nqp @@ -149,10 +149,13 @@ class Perl6::Metamodel::ClassHOW # Create BUILDPLAN. self.create_BUILDPLAN($obj); - # Create BUILDALL method if we can (if we can't, the one from - # Mu will be used, which will iterate over the BUILDALLPLAN at - # runtime). - if nqp::isconcrete($compiler_services) { + # If the BUILDPLAN is not empty, we should attempt to auto- + # generate a BUILDALL method. If the BUILDPLAN is empty, then + # the BUILDALL of the parent is already good enough. We can + # only auto-generate a BUILDALL method if we have compiler + # services. If we don't, then BUILDALL will fall back to the + # one in Mu, which will iterate over the BUILDALLPLAN. + if self.BUILDPLAN($obj) && nqp::isconcrete($compiler_services) { # Class does not appear to have a BUILDALL yet unless nqp::existskey($obj.HOW.submethod_table($obj),'BUILDALL') From 3bf50cce877bb7f730528cfbfefb0af144639846 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Tue, 3 Oct 2017 18:14:27 +0200 Subject: [PATCH 318/692] Eliminate dupe and slightly optimize cue * Only do a closure clone if we really need it * Use implicit return --- src/core/ThreadPoolScheduler.pm | 41 +++++++++++---------------------- 1 file changed, 14 insertions(+), 27 deletions(-) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index b7835e19dcf..6d1b9d3e419 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -593,6 +593,9 @@ my class ThreadPoolScheduler does Scheduler { if $every.defined and $times > 1 and &stop; my $delay = $at ?? $at - now !! $in // 0; + # Wrap any catch handler around the code to run. + my &run := &catch ?? wrap-catch(&code, &catch) !! &code; + # need repeating if $every { # generate a stopper if needed @@ -610,58 +613,42 @@ my class ThreadPoolScheduler does Scheduler { Cancellation.new(async_handles => [$handle]); } $handle := nqp::timer(self!timer-queue(), - &catch - ?? -> { - stop() - ?? cancellation().cancel - !! code(); - CATCH { default { catch($_) } }; - } - !! -> { - stop() - ?? cancellation().cancel - !! code(); - }, + { stop() ?? cancellation().cancel !! run() }, to-millis($delay), to-millis($every), TimerCancellation); - return cancellation() + cancellation() } # no stopper else { - my $handle := nqp::timer(self!timer-queue(), - &catch - ?? -> { code(); CATCH { default { catch($_) } } } - !! &code, + my $handle := nqp::timer(self!timer-queue(), &run, to-millis($delay), to-millis($every), TimerCancellation); - return Cancellation.new(async_handles => [$handle]); + Cancellation.new(async_handles => [$handle]) } } # only after waiting a bit or more than once elsif $delay or $times > 1 { - my $todo := &catch - ?? -> { code(); CATCH { default { catch($_) } } } - !! &code; my @async_handles; $delay = to-millis($delay) if $delay; @async_handles.push( - nqp::timer(self!timer-queue(), $todo, $delay, 0, TimerCancellation) + nqp::timer(self!timer-queue(), &run, $delay, 0, TimerCancellation) ) for 1 .. $times; - return Cancellation.new(:@async_handles); + Cancellation.new(:@async_handles) } # just cue the code else { - my &run := &catch - ?? -> { code(); CATCH { default { catch($_) } } } - !! &code; nqp::push(self!general-queue(), &run); - return Nil; + Nil } } + sub wrap-catch(&code, &catch) { + -> { code(); CATCH { default { catch($_) } } } + } + multi to-millis(Int $value) { 1000 * $value } From b59804bc51b6a7f9941009fffd52957c3d408371 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Tue, 3 Oct 2017 17:59:11 +0000 Subject: [PATCH 319/692] Bump NQP --- tools/build/NQP_REVISION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/build/NQP_REVISION b/tools/build/NQP_REVISION index d74c176f98c..f2311bf4b5d 100644 --- a/tools/build/NQP_REVISION +++ b/tools/build/NQP_REVISION @@ -1 +1 @@ -2017.09-38-ga0618a6 +2017.09-40-ga6a1aa0 From 1e747e01f880ed9626b417d166361bf763759972 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Tue, 3 Oct 2017 21:15:02 +0200 Subject: [PATCH 320/692] Make dynamic variable debugging simpler --- src/core/Rakudo/Internals.pm | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/src/core/Rakudo/Internals.pm b/src/core/Rakudo/Internals.pm index 21190ad22af..1bbf38698e7 100644 --- a/src/core/Rakudo/Internals.pm +++ b/src/core/Rakudo/Internals.pm @@ -887,9 +887,7 @@ my class Rakudo::Internals { #method INITIALIZERS() { $initializers } method REGISTER-DYNAMIC(Str:D \name, &code, Str $version = '6.c' --> Nil) { -#nqp::print("Registering "); -#nqp::print(name); -#nqp::print("\n"); +#nqp::say('Registering ' ~ name); nqp::stmts( (my str $with = nqp::concat($version, nqp::concat("\0", name))), nqp::if( @@ -907,9 +905,7 @@ my class Rakudo::Internals { ) } method INITIALIZE-DYNAMIC(str \name) is raw { -#nqp::print("Initializing"); -#nqp::print(name); -#nqp::print("\n"); +#nqp::say('Initializing ' ~ name); nqp::stmts( (my str $with = nqp::concat( nqp::getcomp('perl6').language_version, nqp::concat("\0", name))), From 40cde2ceb95037f8abecd171a95c785deeeafd56 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Tue, 3 Oct 2017 23:18:57 +0200 Subject: [PATCH 321/692] Promise is already stubbed at this time --- src/core/HyperSeq.pm | 1 - 1 file changed, 1 deletion(-) diff --git a/src/core/HyperSeq.pm b/src/core/HyperSeq.pm index dc8bba12498..6d9c4949850 100644 --- a/src/core/HyperSeq.pm +++ b/src/core/HyperSeq.pm @@ -3,7 +3,6 @@ # does for its iterator. If you ask for its iterator, then you are ending the # declaration of a chain of parallelizable operations. That is, in fact, the # thing that will actually kick off the parallel work. -my class Promise { ... } my class HyperSeq does Iterable does HyperIterable does PositionalBindFailover { has HyperIterator $!hyper-iter; From a5e3cd543c2a7469826dd1a62c5d7cab42b663b6 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Tue, 3 Oct 2017 23:19:28 +0200 Subject: [PATCH 322/692] Move up initialization of %*ENV and $*SCHEDULER - these were being requested at each startup before being initialized - saves creation of 2 X::Dynamic::NotFounds and 2x Failure --- src/core/Env.pm | 2 -- src/core/ThreadPoolScheduler.pm | 3 --- src/core/core_prologue.pm | 7 +++++++ 3 files changed, 7 insertions(+), 5 deletions(-) diff --git a/src/core/Env.pm b/src/core/Env.pm index 9f14d15df2c..01d14c85675 100644 --- a/src/core/Env.pm +++ b/src/core/Env.pm @@ -1,5 +1,3 @@ -PROCESS::<%ENV> := Rakudo::Internals.createENV(0); - Rakudo::Internals.REGISTER-DYNAMIC: '$*CWD', { # PROCESS::<$CWD> = nqp::p6box_s(nqp::cwd()); my $CWD := nqp::p6box_s(nqp::cwd()); diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index 6d1b9d3e419..f054a8a69cc 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -671,7 +671,4 @@ my class ThreadPoolScheduler does Scheduler { } } -# This thread pool scheduler will be the default one. -PROCESS::<$SCHEDULER> = ThreadPoolScheduler.new(); - # vim: ft=perl6 expandtab sw=4 diff --git a/src/core/core_prologue.pm b/src/core/core_prologue.pm index ca50af6e114..e7fb1c76987 100644 --- a/src/core/core_prologue.pm +++ b/src/core/core_prologue.pm @@ -8,6 +8,7 @@ my class Failure { ... } my class Rakudo::Internals { ... } my class Rakudo::Internals::JSON { ... } my class Rakudo::Iterator { ... } +my class ThreadPoolScheduler { ... } my class X::Numeric::Overflow { ... } my class X::Numeric::Underflow { ... } @@ -35,4 +36,10 @@ my class Rakudo::Internals::IterationSet is repr('VMHash') { } # The value for \n. my constant $?NL = "\x0A"; +# Make sure we have an environment +PROCESS::<%ENV> := Rakudo::Internals.createENV(0); + +# This thread pool scheduler will be the default one. +PROCESS::<$SCHEDULER> = ThreadPoolScheduler.new(); + # vim: ft=perl6 expandtab sw=4 From a19fa494464e5a4b357eadad96a53cb5f5483683 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Wed, 4 Oct 2017 17:57:40 +0000 Subject: [PATCH 323/692] Improve error on Inf.base Fixes RT#125818: https://rt.perl.org/Ticket/Display.html?id=125818 --- src/core/Real.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/Real.pm b/src/core/Real.pm index ca5e6d2469c..f304a046730 100644 --- a/src/core/Real.pm +++ b/src/core/Real.pm @@ -89,7 +89,7 @@ my role Real does Numeric { :range<0..1073741824> ) if $digits.defined and $digits < 0; my $prec = $digits // 1e8.log($base.Num).Int; - my Int $int_part = self.Int; + my Int $int_part = self.Int.self; # .self blows up Failures my $frac = abs(self - $int_part); my @frac_digits; my @conversion := <0 1 2 3 4 5 6 7 8 9 From a2cc03af7d52c053a6857050d8080fc1d0c7887f Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Wed, 4 Oct 2017 19:00:58 +0000 Subject: [PATCH 324/692] Implement X::Numeric::CannotConvert exception It's a generic exception to throw when a numeric cannot be converted to something (gonna use it for Inf -> Int coercion). Ideally, X::Numeric::Real would be removed and this exception be used in its place, but there are 6.c-errata tests expecting X::Numeric::Real to exist, so I left it in as just an empty subclass of X::Numeric::CannotConvert --- src/core/Exception.pm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/core/Exception.pm b/src/core/Exception.pm index 55e0eed7958..868945b49a5 100644 --- a/src/core/Exception.pm +++ b/src/core/Exception.pm @@ -2404,7 +2404,7 @@ my class X::Import::Positional is Exception { } } -my class X::Numeric::Real is Exception { +my class X::Numeric::CannotConvert is Exception { has $.target; has $.reason; has $.source; @@ -2412,7 +2412,9 @@ my class X::Numeric::Real is Exception { method message() { "Cannot convert $.source to {$.target.^name}: $.reason"; } + } +my class X::Numeric::Real is X::Numeric::CannotConvert {} my class X::Numeric::DivideByZero is Exception { has $.using; From dd5bb72bed2bc2e54209dd8a24b31a56d66d3b3a Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Wed, 4 Oct 2017 19:03:19 +0000 Subject: [PATCH 325/692] Fail with a typed exception when failing Num.Int --- src/core/Num.pm | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/core/Num.pm b/src/core/Num.pm index a992d08f125..42fb0fc0d44 100644 --- a/src/core/Num.pm +++ b/src/core/Num.pm @@ -1,5 +1,6 @@ -my class X::Numeric::DivideByZero { ... }; -my role Rational { ... }; +my class X::Numeric::DivideByZero { ... } +my class X::Numeric::CannotConvert { ... } +my role Rational { ... } my class Num does Real { # declared in BOOTSTRAP # class Num is Cool @@ -24,7 +25,7 @@ my class Num does Real { # declared in BOOTSTRAP method Int(Num:D:) { nqp::isnanorinf(nqp::unbox_n(self)) - ?? Failure.new("Cannot coerce {self} to an Int") + ?? X::Numeric::CannotConvert.new(:source(self), :target(Int)).fail !! nqp::fromnum_I(nqp::unbox_n(self),Int) } From 9ca8fde5bd1fab4f784251f97320ae716bca1af7 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Wed, 4 Oct 2017 23:03:53 +0200 Subject: [PATCH 326/692] Take 2 on getting $/ info into auto-generated methods - make sure we null out current-match at end of compilation as well - --profile now shows the line of the class definition --- src/Perl6/World.nqp | 21 ++++++++++++++------- src/core/Rakudo/Internals.pm | 6 ++++-- 2 files changed, 18 insertions(+), 9 deletions(-) diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index 0ccab0f29f8..1cc73f0c9a7 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -645,6 +645,7 @@ class Perl6::World is HLL::World { if $!compiler_services { my $cs := $!compiler_services; nqp::bindattr($cs, $cs.WHAT, '$!compiler', nqp::null()); + nqp::bindattr($cs, $cs.WHAT, '$!current-match', nqp::null()); } } @@ -2950,7 +2951,7 @@ class Perl6::World is HLL::World { # Composes the package, and stores an event for this action. method pkg_compose($/, $obj) { - my $compiler_services := self.get_compiler_services; + my $compiler_services := self.get_compiler_services($/); if nqp::isconcrete($compiler_services) { self.ex-handle($/, { $obj.HOW.compose($obj, :$compiler_services) }) } @@ -3004,7 +3005,7 @@ class Perl6::World is HLL::World { # attribute name, type of attribute and rw flag. Returns a code # object that can be installed as a method. method generate_accessor( - str $meth_name, $package_type, str $attr_name, $type, int $rw + $/, str $meth_name, $package_type, str $attr_name, $type, int $rw ) { # Is it a native attribute? (primpspec != 0) @@ -3029,7 +3030,7 @@ class Perl6::World is HLL::World { my $block := QAST::Block.new( :name($meth_name), :blocktype('declaration_static'), - QAST::Stmts.new( $pself, $p_ ), + QAST::Stmts.new( $pself, $p_, :node(nqp::decont($/)) ), $accessor ); @@ -3078,7 +3079,7 @@ class Perl6::World is HLL::World { # attributes. Basically a flattened version of Mu.BUILDALL, which # iterates over the BUILDALLPLAN at runtime with fewer inlining # and JITting opportunities. - method generate_buildplan_executor($in_object, $in_build_plan) { + method generate_buildplan_executor($/, $in_object, $in_build_plan) { # low level hash access my $build_plan := nqp::getattr( @@ -3097,7 +3098,7 @@ class Perl6::World is HLL::World { # The basic statements for object initialization, to be # filled in later - my $stmts := QAST::Stmts.new(); + my $stmts := QAST::Stmts.new(:node(nqp::decont($/))); my $declarations := QAST::Stmts.new($pself, $pauto, $pinit, $dinit); @@ -3517,14 +3518,20 @@ class Perl6::World is HLL::World { } } - method get_compiler_services() { - unless nqp::isconcrete($!compiler_services) { + method get_compiler_services($/) { + if nqp::isconcrete($!compiler_services) { + nqp::bindattr( + $!compiler_services,$!compiler_services.WHAT,'$!current-match',$/ + ); + } + else { try { my $wtype := self.find_symbol(['Rakudo','Internals','CompilerServices']); my $wrapped := CompilerServices.new(w => self); my $wrapper := nqp::create($wtype); nqp::bindattr($wrapper, $wtype, '$!compiler', $wrapped); + nqp::bindattr($wrapper, $wtype, '$!current-match', $/); $!compiler_services := $wrapper; } } diff --git a/src/core/Rakudo/Internals.pm b/src/core/Rakudo/Internals.pm index 1bbf38698e7..ee13be1d589 100644 --- a/src/core/Rakudo/Internals.pm +++ b/src/core/Rakudo/Internals.pm @@ -19,13 +19,15 @@ my class Rakudo::Internals { our class CompilerServices { has Mu $!compiler; + has Mu $!current-match; method generate_accessor(str $name, Mu \package_type, str $attr_name, Mu \type, int $rw) { $!compiler.generate_accessor( - $name, package_type, $attr_name, type, $rw); + $!current-match, $name, package_type, $attr_name, type, $rw); } method generate_buildplan_executor(Mu \obj, Mu \buildplan) { - $!compiler.generate_buildplan_executor(obj, buildplan) + $!compiler.generate_buildplan_executor( + $!current-match, obj, buildplan) } } From a26613f6445d7d4ef78a7c92e256d745807b482c Mon Sep 17 00:00:00 2001 From: Patrick Spek Date: Wed, 4 Oct 2017 23:20:20 +0200 Subject: [PATCH 327/692] Check for the config file's existence before trying to open it --- tools/lib/NQP/Configure.pm | 3 +++ 1 file changed, 3 insertions(+) diff --git a/tools/lib/NQP/Configure.pm b/tools/lib/NQP/Configure.pm index 47975102f40..86de757f733 100644 --- a/tools/lib/NQP/Configure.pm +++ b/tools/lib/NQP/Configure.pm @@ -97,6 +97,9 @@ sub read_config { local $_; for my $file (@config_src) { no warnings; + if (! -f $file) { + next; + } if (open my $CONFIG, '-|', "\"$file\" --show-config") { while (<$CONFIG>) { if (/^([^\s=]+)=(.*)/) { $config{$1} = $2 } From da3a8770ccedbf0bfa87c7c8e83a4db9690a575f Mon Sep 17 00:00:00 2001 From: Patrick Spek Date: Wed, 4 Oct 2017 23:46:15 +0200 Subject: [PATCH 328/692] Add output line indicating a file is not found --- tools/lib/NQP/Configure.pm | 1 + 1 file changed, 1 insertion(+) diff --git a/tools/lib/NQP/Configure.pm b/tools/lib/NQP/Configure.pm index 86de757f733..80b6792fbf7 100644 --- a/tools/lib/NQP/Configure.pm +++ b/tools/lib/NQP/Configure.pm @@ -98,6 +98,7 @@ sub read_config { for my $file (@config_src) { no warnings; if (! -f $file) { + print "No pre-existing installed file found at $file\n"; next; } if (open my $CONFIG, '-|', "\"$file\" --show-config") { From 3dc8020ebc85482da14370866e0ad3c2f3fc3fc4 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Thu, 5 Oct 2017 12:54:49 +0200 Subject: [PATCH 329/692] Remove superfluous line The scope of 'self' is already set 3 lines earlier --- src/Perl6/Actions.nqp | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Perl6/Actions.nqp b/src/Perl6/Actions.nqp index a70e4b20a8e..7641ad72b10 100644 --- a/src/Perl6/Actions.nqp +++ b/src/Perl6/Actions.nqp @@ -9165,7 +9165,6 @@ class Perl6::Actions is HLL::Actions does STDActions { $block[0].push(QAST::Var.new( :name('self'), :scope('lexical'), :decl('var') )); $block[0].push(QAST::Var.new( :name('$_'), :scope('lexical'), :decl('var') )); $block.push(QAST::Stmts.new( WANTED($initializer, 'install_attr_init'), :node($/) )); - $block.symbol('self', :scope('lexical')); add_signature_binding_code($block, $sig, @params); $block.blocktype('declaration_static'); my $code := $*W.create_code_object($block, 'Method', $sig); From 0033ac854e36faa7e55b972bea2536721fc3a568 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Thu, 5 Oct 2017 15:49:07 +0000 Subject: [PATCH 330/692] Move &EVAL/&EVALFILE further down the setting I need it to know about `Blob` and adding stubs into src/core/control.pm is unweildy because all the role mixins and the stubs for the roles need to be added as well --- src/core/ForeignCode.pm | 81 +++++++++++++++++++++++++++++++++++++++++ src/core/control.pm | 81 ----------------------------------------- 2 files changed, 81 insertions(+), 81 deletions(-) diff --git a/src/core/ForeignCode.pm b/src/core/ForeignCode.pm index c10a1378bba..fb4f3b1b34a 100644 --- a/src/core/ForeignCode.pm +++ b/src/core/ForeignCode.pm @@ -18,4 +18,85 @@ my class ForeignCode does Callable { # declared in BOOTSTRAP multi method Str(ForeignCode:D:) { self.name } } +my class Rakudo::Internals::EvalIdSource { + my Int $count = 0; + my Lock $lock = Lock.new; + method next-id() { + $lock.protect: { $count++ } + } +} +proto sub EVAL(Cool $code, Str() :$lang = 'perl6', PseudoStash :$context, *%n) { + # First look in compiler registry. + my $compiler := nqp::getcomp($lang); + if nqp::isnull($compiler) { + # Try a multi-dispatch to another EVAL candidate. If that fails to + # dispatch, map it to a typed exception. + CATCH { + when X::Multi::NoMatch { + X::Eval::NoSuchLang.new(:$lang).throw + } + } + return {*}; + } + $context := CALLER:: unless nqp::defined($context); + my $eval_ctx := nqp::getattr(nqp::decont($context), PseudoStash, '$!ctx'); + my $?FILES := 'EVAL_' ~ Rakudo::Internals::EvalIdSource.next-id; + my \mast_frames := nqp::hash(); + my $*CTXSAVE; # make sure we don't use the EVAL's MAIN context for the currently compiling compilation unit + my $compiled; + my $LANG := $context<%?LANG>; + if !$LANG { + $LANG := CALLERS::<%?LANG>; + } + if $LANG { + # XXX + my $grammar := $LANG
; + my $actions := $LANG; + $compiled := $compiler.compile( + $code.Stringy, + :outer_ctx($eval_ctx), + :global(GLOBAL), + :mast_frames(mast_frames), + :grammar($grammar), + :actions($actions), + ); + } + else { + $compiled := $compiler.compile( + $code.Stringy, + :outer_ctx($eval_ctx), + :global(GLOBAL), + :mast_frames(mast_frames), + ); + } + if $*W and $*W.is_precompilation_mode() { # we are still compiling + $*W.add_additional_frames(mast_frames); + } + nqp::forceouterctx(nqp::getattr($compiled, ForeignCode, '$!do'), $eval_ctx); + $compiled(); +} + +multi sub EVAL(Cool $code, Str :$lang where { ($lang // '') eq 'Perl5' }, PseudoStash :$context) { + my $eval_ctx := nqp::getattr(nqp::decont($context // CALLER::), PseudoStash, '$!ctx'); + my $?FILES := 'EVAL_' ~ (state $no)++; + state $p5; + unless $p5 { + { + my $compunit := $*REPO.need(CompUnit::DependencySpecification.new(:short-name)); + GLOBAL.WHO.merge-symbols($compunit.handle.globalish-package); + CATCH { + #X::Eval::NoSuchLang.new(:$lang).throw; + note $_; + } + } + $p5 = ::("Inline::Perl5").default_perl5; + } + $p5.run($code); +} + +proto sub EVALFILE($, *%) {*} +multi sub EVALFILE($filename, :$lang = 'perl6') { + EVAL slurp($filename), :$lang, :context(CALLER::); +} + # vim: ft=perl6 expandtab sw=4 diff --git a/src/core/control.pm b/src/core/control.pm index f746fa4746b..79563f35375 100644 --- a/src/core/control.pm +++ b/src/core/control.pm @@ -192,87 +192,6 @@ multi sub warn(*@msg) { 0; } -my class Rakudo::Internals::EvalIdSource { - my Int $count = 0; - my Lock $lock = Lock.new; - method next-id() { - $lock.protect: { $count++ } - } -} -proto sub EVAL(Cool $code, Str() :$lang = 'perl6', PseudoStash :$context, *%n) { - # First look in compiler registry. - my $compiler := nqp::getcomp($lang); - if nqp::isnull($compiler) { - # Try a multi-dispatch to another EVAL candidate. If that fails to - # dispatch, map it to a typed exception. - CATCH { - when X::Multi::NoMatch { - X::Eval::NoSuchLang.new(:$lang).throw - } - } - return {*}; - } - $context := CALLER:: unless nqp::defined($context); - my $eval_ctx := nqp::getattr(nqp::decont($context), PseudoStash, '$!ctx'); - my $?FILES := 'EVAL_' ~ Rakudo::Internals::EvalIdSource.next-id; - my \mast_frames := nqp::hash(); - my $*CTXSAVE; # make sure we don't use the EVAL's MAIN context for the currently compiling compilation unit - my $compiled; - my $LANG := $context<%?LANG>; - if !$LANG { - $LANG := CALLERS::<%?LANG>; - } - if $LANG { - # XXX - my $grammar := $LANG
; - my $actions := $LANG; - $compiled := $compiler.compile( - $code.Stringy, - :outer_ctx($eval_ctx), - :global(GLOBAL), - :mast_frames(mast_frames), - :grammar($grammar), - :actions($actions), - ); - } - else { - $compiled := $compiler.compile( - $code.Stringy, - :outer_ctx($eval_ctx), - :global(GLOBAL), - :mast_frames(mast_frames), - ); - } - if $*W and $*W.is_precompilation_mode() { # we are still compiling - $*W.add_additional_frames(mast_frames); - } - nqp::forceouterctx(nqp::getattr($compiled, ForeignCode, '$!do'), $eval_ctx); - $compiled(); -} - -multi sub EVAL(Cool $code, Str :$lang where { ($lang // '') eq 'Perl5' }, PseudoStash :$context) { - my $eval_ctx := nqp::getattr(nqp::decont($context // CALLER::), PseudoStash, '$!ctx'); - my $?FILES := 'EVAL_' ~ (state $no)++; - state $p5; - unless $p5 { - { - my $compunit := $*REPO.need(CompUnit::DependencySpecification.new(:short-name)); - GLOBAL.WHO.merge-symbols($compunit.handle.globalish-package); - CATCH { - #X::Eval::NoSuchLang.new(:$lang).throw; - note $_; - } - } - $p5 = ::("Inline::Perl5").default_perl5; - } - $p5.run($code); -} - -proto sub EVALFILE($, *%) {*} -multi sub EVALFILE($filename, :$lang = 'perl6') { - EVAL slurp($filename), :$lang, :context(CALLER::); -} - constant Inf = nqp::p6box_n(nqp::inf()); constant NaN = nqp::p6box_n(nqp::nan()); From 331fcb0d88d19d754994483768c915c8bb51dee8 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Thu, 5 Oct 2017 17:38:58 +0000 Subject: [PATCH 331/692] Implement &EVAL/&EVALFILE with Bufs per S29; ilmari++ Closes RT#122256: https://rt.perl.org/Ticket/Display.html?id=122256 - Make EVALFILE slurp in binary and let EVAL handle encodings - Implement EVAL(Blob), decoding the same way source file would be read by $lang (per S29) - For Perl 6: use value of `--encoding` command line arg or utf8 - For Perl 5: decode in utf-c8 and let perl handle the rest. Appears to produce the same output as running the code with perl directly. ilmari++ for pointers on how perl does this --- src/core/ForeignCode.pm | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/src/core/ForeignCode.pm b/src/core/ForeignCode.pm index fb4f3b1b34a..d04ac3926f8 100644 --- a/src/core/ForeignCode.pm +++ b/src/core/ForeignCode.pm @@ -25,7 +25,7 @@ my class Rakudo::Internals::EvalIdSource { $lock.protect: { $count++ } } } -proto sub EVAL(Cool $code, Str() :$lang = 'perl6', PseudoStash :$context, *%n) { +proto sub EVAL($code is copy where Blob|Cool, Str() :$lang = 'perl6', PseudoStash :$context, *%n) { # First look in compiler registry. my $compiler := nqp::getcomp($lang); if nqp::isnull($compiler) { @@ -38,6 +38,10 @@ proto sub EVAL(Cool $code, Str() :$lang = 'perl6', PseudoStash :$context, *%n) { } return {*}; } + $code = nqp::istype($code,Blob) ?? $code.decode( + $compiler.cli-options // 'utf8' + ) !! $code.Str; + $context := CALLER:: unless nqp::defined($context); my $eval_ctx := nqp::getattr(nqp::decont($context), PseudoStash, '$!ctx'); my $?FILES := 'EVAL_' ~ Rakudo::Internals::EvalIdSource.next-id; @@ -53,7 +57,7 @@ proto sub EVAL(Cool $code, Str() :$lang = 'perl6', PseudoStash :$context, *%n) { my $grammar := $LANG
; my $actions := $LANG; $compiled := $compiler.compile( - $code.Stringy, + $code, :outer_ctx($eval_ctx), :global(GLOBAL), :mast_frames(mast_frames), @@ -63,7 +67,7 @@ proto sub EVAL(Cool $code, Str() :$lang = 'perl6', PseudoStash :$context, *%n) { } else { $compiled := $compiler.compile( - $code.Stringy, + $code, :outer_ctx($eval_ctx), :global(GLOBAL), :mast_frames(mast_frames), @@ -76,7 +80,7 @@ proto sub EVAL(Cool $code, Str() :$lang = 'perl6', PseudoStash :$context, *%n) { $compiled(); } -multi sub EVAL(Cool $code, Str :$lang where { ($lang // '') eq 'Perl5' }, PseudoStash :$context) { +multi sub EVAL($code, Str :$lang where { ($lang // '') eq 'Perl5' }, PseudoStash :$context) { my $eval_ctx := nqp::getattr(nqp::decont($context // CALLER::), PseudoStash, '$!ctx'); my $?FILES := 'EVAL_' ~ (state $no)++; state $p5; @@ -91,12 +95,14 @@ multi sub EVAL(Cool $code, Str :$lang where { ($lang // '') eq 'Perl5' }, Pseudo } $p5 = ::("Inline::Perl5").default_perl5; } - $p5.run($code); + $p5.run: nqp::istype($code,Blob) + ?? Blob.new($code).decode('utf8-c8') + !! $code.Str; } proto sub EVALFILE($, *%) {*} multi sub EVALFILE($filename, :$lang = 'perl6') { - EVAL slurp($filename), :$lang, :context(CALLER::); + EVAL slurp(:bin, $filename), :$lang, :context(CALLER::); } # vim: ft=perl6 expandtab sw=4 From 5a226f5f3f418fc0ed6cabe5b4883c282559497b Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Thu, 5 Oct 2017 18:37:37 -0400 Subject: [PATCH 332/692] Make Blob.gist trim its guts to 100 els Large blobs take ages to render and we already limit to 100 els for Lists and Maps. --- src/core/Buf.pm | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/src/core/Buf.pm b/src/core/Buf.pm index eca050ec603..f7db0c9ca42 100644 --- a/src/core/Buf.pm +++ b/src/core/Buf.pm @@ -136,7 +136,13 @@ my role Blob[::T = uint8] does Positional[T] does Stringy is repr('VMArray') is } multi method gist(Blob:D:) { - self.^name ~ ':0x<' ~ self.list.fmt('%02x', ' ') ~ '>' + self.^name ~ ':0x<' ~ self.map( -> $elem { + given ++$ { + when 101 { '...' } + when 102 { last } + default { $elem.fmt: '%02x' } + } + }) ~ '>' } multi method perl(Blob:D:) { self.^name ~ '.new(' ~ self.join(',') ~ ')'; From bd19a666f0fef6471b2ddb2d467399bdd7ef9763 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Thu, 5 Oct 2017 20:43:50 -0400 Subject: [PATCH 333/692] Implement IO::Handle.slurp(:bin) During IO::Grant, we removed :bin from .slurp-rest, because it mutated the handle's encoding. After the Deasyncing of IO, we clarified the spec in that it was allowed to use binary read methods on non-bin handles. With that in mind, re-adding a non-$!encoding-mutating :bin to .slurp aligns the interface with other methods and makes it easier to bin-slurp from Proc pipes too. --- src/core/IO/Handle.pm | 36 +++++++++++++++++++++--------------- 1 file changed, 21 insertions(+), 15 deletions(-) diff --git a/src/core/IO/Handle.pm b/src/core/IO/Handle.pm index debb60e8351..73a94796162 100644 --- a/src/core/IO/Handle.pm +++ b/src/core/IO/Handle.pm @@ -696,23 +696,29 @@ my class IO::Handle { self!slurp-all-chars() } - method slurp(IO::Handle:D: :$close) { - my $res; - nqp::if( - $!decoder, - ($res := self!slurp-all-chars()), - nqp::stmts( - ($res := buf8.new), + method slurp(IO::Handle:D: :$close, :$bin) { + nqp::stmts( + (my $res), + nqp::if( + $!decoder, + nqp::if( + $bin, + nqp::stmts( + ($res := buf8.new), + nqp::if( + $!decoder.bytes-available, + $res.append($!decoder.consume-exactly-bytes( + $!decoder.bytes-available)))), + ($res := self!slurp-all-chars())), + ($res := buf8.new)), + nqp::if( + nqp::isfalse($!decoder) || $bin, nqp::while( nqp::elems(my $buf := self.read-internal(0x100000)), - $res.append($buf) - ) - ) - ); - - # don't sink result of .close; it might be a failed Proc - $ = self.close if $close; - $res + $res.append($buf))), + # don't sink result of .close; it might be a failed Proc + nqp::if($close, $ = self.close), + $res) } method !slurp-all-chars() { From f1c6fc5855fa1709fbb7f1c559dff6bc6e9f090f Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Thu, 5 Oct 2017 21:36:23 -0400 Subject: [PATCH 334/692] Make Blob.gist 40x faster MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Not exactly a method that gotta be über fast, but the original takes 50ms per single call on a 100+ el buf (for comparison 100+ list takes 3ms) --- src/core/Buf.pm | 25 ++++++++++++++++++------- 1 file changed, 18 insertions(+), 7 deletions(-) diff --git a/src/core/Buf.pm b/src/core/Buf.pm index f7db0c9ca42..a8788fde12b 100644 --- a/src/core/Buf.pm +++ b/src/core/Buf.pm @@ -136,13 +136,24 @@ my role Blob[::T = uint8] does Positional[T] does Stringy is repr('VMArray') is } multi method gist(Blob:D:) { - self.^name ~ ':0x<' ~ self.map( -> $elem { - given ++$ { - when 101 { '...' } - when 102 { last } - default { $elem.fmt: '%02x' } - } - }) ~ '>' + nqp::stmts( + (my str $gist = self.^name ~ ':0x<'), + (my int $els = nqp::elems(self)), + (my int $max = nqp::isle_i($els,100) ?? $els !! 100), + (my int $i = -1), + nqp::while( + nqp::islt_i(($i = nqp::add_i($i,1)),$max), + ($gist = nqp::concat($gist, nqp::concat(nqp::if( + nqp::iseq_i( + nqp::chars(my str $s = nqp::lc( + (self.AT-POS: $i).base: 16)),1), + nqp::concat('0',$s),$s),' ')))), + nqp::if( # take care of ending, removing extra ' ' if needed + nqp::isge_i($els, 101), + ($gist = nqp::concat($gist,'...')), + $els && ($gist = nqp::substr( + $gist,0,nqp::sub_i(nqp::chars($gist),1)))), + nqp::concat($gist,'>')) } multi method perl(Blob:D:) { self.^name ~ '.new(' ~ self.join(',') ~ ')'; From 98900dfd255cf72466052556ebd3ff805d47e539 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Thu, 5 Oct 2017 21:44:51 -0400 Subject: [PATCH 335/692] Revert "Make Blob.gist 40x faster" This reverts commit be83cd4ec72c67c825d343057fa965e2086f0e47. I think I got carried away and it's too unreadable. Will make just the .fmt() call in nqp, as that's the main slowdown here. --- src/core/Buf.pm | 25 +++++++------------------ 1 file changed, 7 insertions(+), 18 deletions(-) diff --git a/src/core/Buf.pm b/src/core/Buf.pm index a8788fde12b..f7db0c9ca42 100644 --- a/src/core/Buf.pm +++ b/src/core/Buf.pm @@ -136,24 +136,13 @@ my role Blob[::T = uint8] does Positional[T] does Stringy is repr('VMArray') is } multi method gist(Blob:D:) { - nqp::stmts( - (my str $gist = self.^name ~ ':0x<'), - (my int $els = nqp::elems(self)), - (my int $max = nqp::isle_i($els,100) ?? $els !! 100), - (my int $i = -1), - nqp::while( - nqp::islt_i(($i = nqp::add_i($i,1)),$max), - ($gist = nqp::concat($gist, nqp::concat(nqp::if( - nqp::iseq_i( - nqp::chars(my str $s = nqp::lc( - (self.AT-POS: $i).base: 16)),1), - nqp::concat('0',$s),$s),' ')))), - nqp::if( # take care of ending, removing extra ' ' if needed - nqp::isge_i($els, 101), - ($gist = nqp::concat($gist,'...')), - $els && ($gist = nqp::substr( - $gist,0,nqp::sub_i(nqp::chars($gist),1)))), - nqp::concat($gist,'>')) + self.^name ~ ':0x<' ~ self.map( -> $elem { + given ++$ { + when 101 { '...' } + when 102 { last } + default { $elem.fmt: '%02x' } + } + }) ~ '>' } multi method perl(Blob:D:) { self.^name ~ '.new(' ~ self.join(',') ~ ')'; From 9869dea3cbc3621ad52bc18ed93ce22caacb2b06 Mon Sep 17 00:00:00 2001 From: Samantha McVey Date: Fri, 6 Oct 2017 02:23:47 -0700 Subject: [PATCH 336/692] Add S32-str/Collation.t to spectest.data --- t/spectest.data | 1 + 1 file changed, 1 insertion(+) diff --git a/t/spectest.data b/t/spectest.data index 10f136542ad..d9c9a3c7f97 100644 --- a/t/spectest.data +++ b/t/spectest.data @@ -1115,6 +1115,7 @@ S32-scalar/undef.t S32-str/append.t S32-str/bool.t S32-str/capitalize.t +S32-str/Collation.t # moar S32-str/chomp.t S32-str/chop.t S32-str/comb.t From cce0b94915b0ca4fc3d5b1dd66219fa2611adeda Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Fri, 6 Oct 2017 10:10:11 +0000 Subject: [PATCH 337/692] Make Blob.gist 26x faster --- src/core/Buf.pm | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/src/core/Buf.pm b/src/core/Buf.pm index f7db0c9ca42..1879ecbfc1b 100644 --- a/src/core/Buf.pm +++ b/src/core/Buf.pm @@ -136,12 +136,13 @@ my role Blob[::T = uint8] does Positional[T] does Stringy is repr('VMArray') is } multi method gist(Blob:D:) { - self.^name ~ ':0x<' ~ self.map( -> $elem { - given ++$ { - when 101 { '...' } - when 102 { last } - default { $elem.fmt: '%02x' } - } + self.^name ~ ':0x<' ~ self.map( -> \el { + state $i = 0; + ++$i == 101 ?? '...' + !! $i == 102 ?? last() + !! nqp::if(nqp::iseq_i( # el.fmt: '%02x' + nqp::chars(my str $v = nqp::lc(el.base: 16)),1), + nqp::concat('0',$v),$v) }) ~ '>' } multi method perl(Blob:D:) { From 9247045962ab8d41f7b74603cb2ae0c2d0555573 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Fri, 6 Oct 2017 10:13:18 +0000 Subject: [PATCH 338/692] Fix Map.perl losing cont / Make Map.gist trim to 100els Hash, List, and Buf trim .gist to 100 els, do the same for Map --- src/core/Map.pm | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/src/core/Map.pm b/src/core/Map.pm index 586f2cc9fec..26d7af8cf0b 100644 --- a/src/core/Map.pm +++ b/src/core/Map.pm @@ -120,11 +120,18 @@ my class Map does Iterable does Associative { # declared in BOOTSTRAP ) } - multi method perl(Map:D:) { - self.^name - ~ '.new((' - ~ self.sort.map({.perl}).join(',') - ~ '))'; + multi method gist(Map:D:) { + self.^name ~ '.new((' ~ self.sort.map({ + state $i = 0; + ++$i == 101 ?? '...' + !! $i == 102 ?? last() + !! .gist + }).join(',') ~ '))' + } + + multi method perl(Map:D \SELF:) { + my $p = self.^name ~ '.new((' ~ self.sort.map({.perl}).join(',') ~ '))'; + nqp::iscont(SELF) ?? '$(' ~ $p ~ ')' !! $p } method iterator(Map:D:) { From 413fa590f1c66239c4e42e162e5f58d972e066ac Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Fri, 6 Oct 2017 10:14:39 +0000 Subject: [PATCH 339/692] Make Hash.perl/.gist use proper object name in circularities --- src/core/Hash.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/Hash.pm b/src/core/Hash.pm index b6b03a86bd0..cfad3e179d9 100644 --- a/src/core/Hash.pm +++ b/src/core/Hash.pm @@ -204,14 +204,14 @@ my class Hash { # declared in BOOTSTRAP } multi method perl(Hash:D \SELF:) { - SELF.perlseen('Hash', { + SELF.perlseen(self.^name, { '$' x nqp::iscont(SELF) # self is always deconted ~ '{' ~ self.sort.map({.perl}).join(', ') ~ '}' }) } multi method gist(Hash:D:) { - self.gistseen('Hash', { + self.gistseen(self.^name, { '{' ~ self.sort.map( -> $elem { given ++$ { From d1324f1ce2abe8071b7e2d318bbcf27a9d7f0f2f Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Fri, 6 Oct 2017 10:15:13 +0000 Subject: [PATCH 340/692] Make Hash.gist 24% faster --- src/core/Hash.pm | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/src/core/Hash.pm b/src/core/Hash.pm index cfad3e179d9..ee2619255e5 100644 --- a/src/core/Hash.pm +++ b/src/core/Hash.pm @@ -213,13 +213,12 @@ my class Hash { # declared in BOOTSTRAP multi method gist(Hash:D:) { self.gistseen(self.^name, { '{' ~ - self.sort.map( -> $elem { - given ++$ { - when 101 { '...' } - when 102 { last } - default { $elem.gist } - } - } ).join(', ') + self.sort.map({ + state $i = 0; + ++$i == 101 ?? '...' + !! $i == 102 ?? last() + !! .gist + }).join(', ') ~ '}' }) } From d95ae9259be79aa34c2888818e3191c39a93d67f Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Thu, 5 Oct 2017 16:10:38 +0200 Subject: [PATCH 341/692] Make sure we have IO::Special before IO::Handle Needed for an optimization later --- src/core/IO/Handle.pm | 1 - src/core/IO/Path.pm | 2 -- src/core/IO/Special.pm | 2 ++ tools/build/jvm_core_sources | 2 +- tools/build/moar_core_sources | 2 +- 5 files changed, 4 insertions(+), 5 deletions(-) diff --git a/src/core/IO/Handle.pm b/src/core/IO/Handle.pm index 73a94796162..7ae4b480f09 100644 --- a/src/core/IO/Handle.pm +++ b/src/core/IO/Handle.pm @@ -1,5 +1,4 @@ my class IO::Path { ... } -my class IO::Special { ... } my class Proc { ... } my class IO::Handle { diff --git a/src/core/IO/Path.pm b/src/core/IO/Path.pm index 39cc963b6b1..51031a5eb99 100644 --- a/src/core/IO/Path.pm +++ b/src/core/IO/Path.pm @@ -1,5 +1,3 @@ -my class Instant { ... } - my class IO::Path is Cool does IO { has IO::Spec $.SPEC; has Str $.CWD; diff --git a/src/core/IO/Special.pm b/src/core/IO/Special.pm index a349210b1f5..44298170653 100644 --- a/src/core/IO/Special.pm +++ b/src/core/IO/Special.pm @@ -1,3 +1,5 @@ +my class Instant { ... } + class IO::Special does IO { has Str $.what; diff --git a/tools/build/jvm_core_sources b/tools/build/jvm_core_sources index 06b97f878ca..8423d23797f 100644 --- a/tools/build/jvm_core_sources +++ b/tools/build/jvm_core_sources @@ -101,10 +101,10 @@ src/core/IO/Spec/Win32.pm src/core/IO/Spec/Cygwin.pm src/core/IO/Spec/QNX.pm src/core/IO/Notification.pm +src/core/IO/Special.pm src/core/IO/Handle.pm src/core/IO/Pipe.pm src/core/IO/Path.pm -src/core/IO/Special.pm src/core/io_operators.pm src/core/IO/CatHandle.pm src/core/IO/ArgFiles.pm diff --git a/tools/build/moar_core_sources b/tools/build/moar_core_sources index b73e62816c4..87d148c9226 100644 --- a/tools/build/moar_core_sources +++ b/tools/build/moar_core_sources @@ -103,10 +103,10 @@ src/core/IO/Spec/Win32.pm src/core/IO/Spec/Cygwin.pm src/core/IO/Spec/QNX.pm src/core/IO/Notification.pm +src/core/IO/Special.pm src/core/IO/Handle.pm src/core/IO/Pipe.pm src/core/IO/Path.pm -src/core/IO/Special.pm src/core/io_operators.pm src/core/IO/CatHandle.pm src/core/IO/ArgFiles.pm From 4b78e8acd7e5b2788f9fa5bef9d4fc0ff11ab8ff Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Fri, 6 Oct 2017 12:23:13 +0000 Subject: [PATCH 342/692] Add space between els in Map.gist We add one in Hash, List, and Buf .gists (Noticing though that Buf and List gists separate els with spaces, but Hash/Map with commas + spaces) --- src/core/Map.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/Map.pm b/src/core/Map.pm index 26d7af8cf0b..1e4c304c501 100644 --- a/src/core/Map.pm +++ b/src/core/Map.pm @@ -126,7 +126,7 @@ my class Map does Iterable does Associative { # declared in BOOTSTRAP ++$i == 101 ?? '...' !! $i == 102 ?? last() !! .gist - }).join(',') ~ '))' + }).join(', ') ~ '))' } multi method perl(Map:D \SELF:) { From 00319594ced5e49f320c66112255ec5ad83c6c22 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Fri, 6 Oct 2017 13:00:29 +0000 Subject: [PATCH 343/692] Versatilize X::Numeric::CannotConvert a bit Make it stringify .defined $!targets as is, while .perl'ifying others. This maintains the old output for X::Numeric::Real, while leaving open the possibility of using more than just a type for $!target if we'll need to. --- src/core/Exception.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/Exception.pm b/src/core/Exception.pm index 868945b49a5..e87c06bed78 100644 --- a/src/core/Exception.pm +++ b/src/core/Exception.pm @@ -2410,7 +2410,7 @@ my class X::Numeric::CannotConvert is Exception { has $.source; method message() { - "Cannot convert $.source to {$.target.^name}: $.reason"; + "Cannot convert $!source to {$!target // $!target.perl}: $!reason"; } } From 722d8711b359a1e5b9f21c3d2a954f18074bffd8 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Fri, 6 Oct 2017 15:21:16 +0000 Subject: [PATCH 344/692] Bump NQP --- tools/build/NQP_REVISION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/build/NQP_REVISION b/tools/build/NQP_REVISION index f2311bf4b5d..46fb0479d8f 100644 --- a/tools/build/NQP_REVISION +++ b/tools/build/NQP_REVISION @@ -1 +1 @@ -2017.09-40-ga6a1aa0 +2017.09-59-g60f79d3 From f4a2840a520c4216e2b981cbc7a71ad64840c9dc Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Fri, 6 Oct 2017 18:33:02 +0200 Subject: [PATCH 345/692] Add some # vim: ft=perl6 expandtab sw=4 --- src/core/Awaitable.pm | 2 ++ src/core/Awaiter.pm | 2 ++ src/core/Collation.pm | 2 ++ src/core/Cursor.pm | 2 ++ src/core/Encoding.pm | 2 ++ src/core/Encoding/Decoder.pm | 2 ++ src/core/Encoding/Decoder/Builtin.pm | 2 ++ src/core/Encoding/Encoder.pm | 2 ++ src/core/Encoding/Encoder/Builtin.pm | 2 ++ src/core/Encoding/Encoder/TranslateNewlineWrapper.pm | 2 ++ src/core/Encoding/Registry.pm | 2 ++ src/core/IO/Notification.pm | 2 ++ src/core/IO/Socket/Async.pm | 2 ++ src/core/IO/Special.pm | 2 ++ src/core/IterationBuffer.pm | 2 ++ src/core/JSON/Pretty.pm | 2 ++ src/core/JVM/IOAsyncFile.pm | 2 ++ src/core/JVM/KeyReducer.pm | 2 ++ src/core/Lock/Async.pm | 2 ++ src/core/Metamodel/Primitives.pm | 2 ++ src/core/Proc/Async.pm | 2 ++ src/core/REPL.pm | 2 ++ src/core/Rakudo/Internals/JSON.pm | 2 ++ src/core/Slang.pm | 2 ++ src/core/Uni.pm | 2 ++ src/core/allomorphs.pm | 2 ++ src/core/atomicops.pm | 2 ++ 27 files changed, 54 insertions(+) diff --git a/src/core/Awaitable.pm b/src/core/Awaitable.pm index 10fdedb6894..724bd8e5c81 100644 --- a/src/core/Awaitable.pm +++ b/src/core/Awaitable.pm @@ -46,3 +46,5 @@ my role Awaitable::Handle { method subscribe-awaiter(&subscriber) { ... } } + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Awaiter.pm b/src/core/Awaiter.pm index 73355ce0272..8c6457fede9 100644 --- a/src/core/Awaiter.pm +++ b/src/core/Awaiter.pm @@ -111,3 +111,5 @@ my class Awaiter::Blocking does Awaiter { } PROCESS::<$AWAITER> := Awaiter::Blocking; + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Collation.pm b/src/core/Collation.pm index 4544b24e521..3a3f0e2a34a 100644 --- a/src/core/Collation.pm +++ b/src/core/Collation.pm @@ -48,3 +48,5 @@ class Collation { Rakudo::Internals.REGISTER-DYNAMIC: '$*COLLATION', { PROCESS::<$COLLATION> := Collation.new; } + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Cursor.pm b/src/core/Cursor.pm index 16d81256a06..1429f05f1df 100644 --- a/src/core/Cursor.pm +++ b/src/core/Cursor.pm @@ -1 +1,3 @@ my constant Cursor = Match; + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Encoding.pm b/src/core/Encoding.pm index 05c7ee47ff7..6bc38f86f31 100644 --- a/src/core/Encoding.pm +++ b/src/core/Encoding.pm @@ -4,3 +4,5 @@ role Encoding { method encoder(*%options --> Encoding::Encoder) { ... } method decoder(*%options --> Encoding::Decoder) { ... } } + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Encoding/Decoder.pm b/src/core/Encoding/Decoder.pm index a4ca00dea26..883073dfc31 100644 --- a/src/core/Encoding/Decoder.pm +++ b/src/core/Encoding/Decoder.pm @@ -9,3 +9,5 @@ role Encoding::Decoder { method bytes-available(--> Int:D) { ... } method consume-exactly-bytes(int $bytes --> Blob) { ... } } + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Encoding/Decoder/Builtin.pm b/src/core/Encoding/Decoder/Builtin.pm index 804dfd5d69c..82ed683a507 100644 --- a/src/core/Encoding/Decoder/Builtin.pm +++ b/src/core/Encoding/Decoder/Builtin.pm @@ -78,3 +78,5 @@ augment class Rakudo::Internals { } } } + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Encoding/Encoder.pm b/src/core/Encoding/Encoder.pm index 70f1e4aca84..bd18ff39249 100644 --- a/src/core/Encoding/Encoder.pm +++ b/src/core/Encoding/Encoder.pm @@ -1,3 +1,5 @@ role Encoding::Encoder { method encode-chars(Str:D --> Blob:D) { ... } } + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Encoding/Encoder/Builtin.pm b/src/core/Encoding/Encoder/Builtin.pm index abb98733634..4082fda6d47 100644 --- a/src/core/Encoding/Encoder/Builtin.pm +++ b/src/core/Encoding/Encoder/Builtin.pm @@ -42,3 +42,5 @@ my class Encoding::Encoder::Builtin::Replacement does Encoding::Encoder { #?endif } } + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Encoding/Encoder/TranslateNewlineWrapper.pm b/src/core/Encoding/Encoder/TranslateNewlineWrapper.pm index 15b9e6b52d4..fa70028a29e 100644 --- a/src/core/Encoding/Encoder/TranslateNewlineWrapper.pm +++ b/src/core/Encoding/Encoder/TranslateNewlineWrapper.pm @@ -14,3 +14,5 @@ my class Encoding::Encoder::TranslateNewlineWrapper does Encoding::Encoder { $!delegate.encode-chars(Rakudo::Internals.TRANSPOSE($str, "\n", "\r\n")) } } + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Encoding/Registry.pm b/src/core/Encoding/Registry.pm index d2b173d87d9..e71d5cfedef 100644 --- a/src/core/Encoding/Registry.pm +++ b/src/core/Encoding/Registry.pm @@ -39,3 +39,5 @@ my class Encoding::Registry { } } } + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/IO/Notification.pm b/src/core/IO/Notification.pm index be9a42805ba..719c9330a28 100644 --- a/src/core/IO/Notification.pm +++ b/src/core/IO/Notification.pm @@ -34,3 +34,5 @@ my class IO::Notification { $s.Supply } } + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/IO/Socket/Async.pm b/src/core/IO/Socket/Async.pm index 3c4128d6d4c..5edb2534e43 100644 --- a/src/core/IO/Socket/Async.pm +++ b/src/core/IO/Socket/Async.pm @@ -334,3 +334,5 @@ my class IO::Socket::Async { } #?endif } + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/IO/Special.pm b/src/core/IO/Special.pm index 44298170653..3424ab74c6c 100644 --- a/src/core/IO/Special.pm +++ b/src/core/IO/Special.pm @@ -25,3 +25,5 @@ class IO::Special does IO { method changed( IO::Special:D: --> Instant) { Instant } method mode(IO::Special:D: --> Nil) { } } + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/IterationBuffer.pm b/src/core/IterationBuffer.pm index cbac850a5b6..d066b1e05be 100644 --- a/src/core/IterationBuffer.pm +++ b/src/core/IterationBuffer.pm @@ -45,3 +45,5 @@ my class IterationBuffer { nqp::p6bindattrinvres(nqp::create(List),List,'$!reified',self).perl } } + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/JSON/Pretty.pm b/src/core/JSON/Pretty.pm index 82d2bb7e4b3..8c92d6eb1ed 100644 --- a/src/core/JSON/Pretty.pm +++ b/src/core/JSON/Pretty.pm @@ -7,3 +7,5 @@ sub from-json($text) { DEPRECATED('JSON::Fast, JSON::Tiny or JSON::Pretty from https://modules.perl6.org/'); Rakudo::Internals::JSON.from-json($text); } + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/JVM/IOAsyncFile.pm b/src/core/JVM/IOAsyncFile.pm index 97cd15d8355..72fd7ed6bb3 100644 --- a/src/core/JVM/IOAsyncFile.pm +++ b/src/core/JVM/IOAsyncFile.pm @@ -74,3 +74,5 @@ my class IO::Async::File { $c } } + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/JVM/KeyReducer.pm b/src/core/JVM/KeyReducer.pm index 455d8e79402..1974a9ef09d 100644 --- a/src/core/JVM/KeyReducer.pm +++ b/src/core/JVM/KeyReducer.pm @@ -86,3 +86,5 @@ my class KeyReducer { $!exception ?? $!exception.throw !! %!result } } + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Lock/Async.pm b/src/core/Lock/Async.pm index 681a9cb949a..a71513cbaff 100644 --- a/src/core/Lock/Async.pm +++ b/src/core/Lock/Async.pm @@ -203,3 +203,5 @@ my class Lock::Async { } } } + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Metamodel/Primitives.pm b/src/core/Metamodel/Primitives.pm index 98b4cb9091e..12a9268e167 100644 --- a/src/core/Metamodel/Primitives.pm +++ b/src/core/Metamodel/Primitives.pm @@ -64,3 +64,5 @@ my class Metamodel::Primitives { nqp::p6bool(nqp::istype(obj, type)) } } + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Proc/Async.pm b/src/core/Proc/Async.pm index 22518c66829..3ac31d87cf0 100644 --- a/src/core/Proc/Async.pm +++ b/src/core/Proc/Async.pm @@ -420,3 +420,5 @@ my class Proc::Async { nqp::killprocasync($!process_handle, $*KERNEL.signal: signal) } } + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/REPL.pm b/src/core/REPL.pm index 35a23781307..0fff6605f40 100644 --- a/src/core/REPL.pm +++ b/src/core/REPL.pm @@ -412,3 +412,5 @@ do { } } } + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Rakudo/Internals/JSON.pm b/src/core/Rakudo/Internals/JSON.pm index d8ae99972f0..917348c71d4 100644 --- a/src/core/Rakudo/Internals/JSON.pm +++ b/src/core/Rakudo/Internals/JSON.pm @@ -133,3 +133,5 @@ my class Rakudo::Internals::JSON { } method to-json(|c) { to-json(|c) } } + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Slang.pm b/src/core/Slang.pm index 3530b978ab7..de5d81ab4d9 100644 --- a/src/core/Slang.pm +++ b/src/core/Slang.pm @@ -12,3 +12,5 @@ class Slang { $!grammar.parse(:$!actions, |c); } } + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Uni.pm b/src/core/Uni.pm index 3aee3706c3a..d320cf6be7a 100644 --- a/src/core/Uni.pm +++ b/src/core/Uni.pm @@ -123,3 +123,5 @@ my class NFKC is Uni { die "Cannot create an NFKC directly"; # XXX typed, better message } } + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/allomorphs.pm b/src/core/allomorphs.pm index 8e3f6becbca..d7bb74aedb4 100644 --- a/src/core/allomorphs.pm +++ b/src/core/allomorphs.pm @@ -506,3 +506,5 @@ multi sub val(Str:D $MAYBEVAL, :$val-or-fail) { parse_win $result; } + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/atomicops.pm b/src/core/atomicops.pm index 764cc20f0ae..7f416554918 100644 --- a/src/core/atomicops.pm +++ b/src/core/atomicops.pm @@ -205,3 +205,5 @@ multi sub cas(atomicint $target is rw, &code) { } } #?endif + +# vim: ft=perl6 expandtab sw=4 From 3ac3eb96441f42f09fc0d9b847251f38f794428f Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Fri, 6 Oct 2017 23:19:04 +0200 Subject: [PATCH 346/692] Compile time defaults for attributes stored as value - store the compile-time value of a default if possible - makes object creation with concrete compile-time default values faster - about 40% faster for a single attribute, like "has $.foo = 42" - rather than generating a method to be installed and called during init - only supports concrete default values for now, type objects use old behaviour - this caused some test breakage and seemed obscure enough to not pursue now - abuses the Attribute.build_closure attribute for default value - so it's not always code in there: this may be a bad idea - maybe a rename of the attribute would be in order - Adapted BUILDPLAN accordingly - Adapted Mu.BUILDALL/BUILD_LEAST_DERIVED accordingly - Adapted class.BUILDALL auto-generating accordingly - breaks one attribute introspection test in roast - not sure that actually belongs in roast anyway - unbreaks two pod-tests - presumably because the "compile-time-value" doesn't eat the comment - whereas the code generation apparently does --- src/Perl6/Actions.nqp | 34 +++++++++++---- src/Perl6/Metamodel/BUILDPLAN.nqp | 2 +- src/Perl6/World.nqp | 47 +++++++++++++++------ src/core/Mu.pm | 70 +++++++++++++++++++++++-------- src/core/traits.pm | 2 +- 5 files changed, 115 insertions(+), 40 deletions(-) diff --git a/src/Perl6/Actions.nqp b/src/Perl6/Actions.nqp index 7641ad72b10..626deeaade0 100644 --- a/src/Perl6/Actions.nqp +++ b/src/Perl6/Actions.nqp @@ -9154,25 +9154,43 @@ class Perl6::Actions is HLL::Actions does STDActions { placeholder => $block.ann('placeholder_sig')[0], ); } + if $initializer.has_compile_time_value { + my $build := $initializer.compile_time_value; + if nqp::isconcrete($build) { # can't handle type values yet + return $*W.apply_trait($/, '&trait_mod:', $attr, :$build); + } + } + + # Need to construct and install an initializer method my @params := [ - hash( is_invocant => 1, nominal_type => $/.package), - hash( variable_name => '$_', nominal_type => $*W.find_symbol(['Mu'])) + hash( is_invocant => 1, nominal_type => $/.package), + hash( variable_name => '$_', nominal_type => $*W.find_symbol(['Mu'])) ]; my $sig := $*W.create_signature(nqp::hash('parameter_objects', [ - $*W.create_parameter($/, @params[0]), - $*W.create_parameter($/, @params[1]) + $*W.create_parameter($/, @params[0]), + $*W.create_parameter($/, @params[1]) ])); - $block[0].push(QAST::Var.new( :name('self'), :scope('lexical'), :decl('var') )); - $block[0].push(QAST::Var.new( :name('$_'), :scope('lexical'), :decl('var') )); - $block.push(QAST::Stmts.new( WANTED($initializer, 'install_attr_init'), :node($/) )); + + $block[0].push( + QAST::Var.new( :name('self'), :scope('lexical'), :decl('var') ) + ); + $block[0].push( + QAST::Var.new( :name('$_'), :scope('lexical'), :decl('var') ) + ); + $block.push( + QAST::Stmts.new( + WANTED($initializer, 'install_attr_init'), :node($/) + ) + ); + add_signature_binding_code($block, $sig, @params); $block.blocktype('declaration_static'); - my $code := $*W.create_code_object($block, 'Method', $sig); # Block should go in current lexpad, in correct lexical context. ($*W.cur_lexpad())[0].push($block); # Dispatch trait. + my $code := $*W.create_code_object($block, 'Method', $sig); $*W.apply_trait($/, '&trait_mod:', $attr, :build($code)); } diff --git a/src/Perl6/Metamodel/BUILDPLAN.nqp b/src/Perl6/Metamodel/BUILDPLAN.nqp index 2111ee56fcc..7452b3cde72 100644 --- a/src/Perl6/Metamodel/BUILDPLAN.nqp +++ b/src/Perl6/Metamodel/BUILDPLAN.nqp @@ -80,7 +80,7 @@ role Perl6::Metamodel::BUILDPLAN { for @attrs { if nqp::can($_, 'build') { my $default := $_.build; - if !nqp::isnull($default) && $default { + if nqp::isconcrete($default) { nqp::push(@plan,[ nqp::add_i(4,nqp::objprimspec($_.type)), $obj, diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index 1cc73f0c9a7..4503a4c5fb7 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -3250,11 +3250,16 @@ class Perl6::World is HLL::World { $self, $class, $attr ); + my $initializer := nqp::istype( + nqp::atpos($task,3), + $!w.find_symbol(['Block']) # $code(self,nqp::getattr(self,Foo,'$!a'))) - my $initializer := QAST::Op.new( :op, - QAST::WVal.new(:value(nqp::atpos($task,3))), - $self, $getattr - ); + ) ?? QAST::Op.new( :op, + QAST::WVal.new(:value(nqp::atpos($task,3))), + $self, $getattr + ) +# $value + !! QAST::WVal.new(:value(nqp::atpos($task,3))); my $sigil := nqp::substr(nqp::atpos($task,2),0,1); # nqp::getattr(self,Foo,'$!a').STORE($code(self,nqp::getattr(self,Foo,'$!a'))) @@ -3306,10 +3311,21 @@ class Perl6::World is HLL::World { ), QAST::Op.new( :op('bindattr' ~ @psp[$code - 4]), $self, $class, $attr, - QAST::Op.new( :op, - QAST::WVal.new(:value(nqp::atpos($task,3))), - $self, - $getattr + nqp::if( + nqp::istype( + nqp::atpos($task,3), + $!w.find_symbol(['Block']) + ), + QAST::Op.new( :op, + QAST::WVal.new(:value(nqp::atpos($task,3))), + $self, + $getattr + ), + nqp::if( + nqp::iseq_i($code,5), + QAST::IVal.new(:value(nqp::atpos($task,3))), + QAST::NVal.new(:value(nqp::atpos($task,3))) + ) ) ) ) @@ -3333,10 +3349,17 @@ class Perl6::World is HLL::World { QAST::Op.new( :op, $getattr), QAST::Op.new( :op, $self, $class, $attr, - QAST::Op.new( :op, - QAST::WVal.new(:value(nqp::atpos($task,3))), - $self, - $getattr + nqp::if( + nqp::istype( + nqp::atpos($task,3), + $!w.find_symbol(['Block']) + ), + QAST::Op.new( :op, + QAST::WVal.new(:value(nqp::atpos($task,3))), + $self, + $getattr + ), + QAST::SVal.new(:value(nqp::atpos($task,3))) ) ) ) diff --git a/src/core/Mu.pm b/src/core/Mu.pm index fe36179e9e0..369cfa03d9c 100644 --- a/src/core/Mu.pm +++ b/src/core/Mu.pm @@ -197,12 +197,17 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" nqp::atpos($task,1), nqp::atpos($task,2) ), - nqp::stmts( - (my \attr := nqp::getattr(self, - nqp::atpos($task,1), - nqp::atpos($task,2) - )), - (attr = nqp::atpos($task,3)(self,attr)) + nqp::if( + nqp::istype(nqp::atpos($task,3),Block), + nqp::stmts( + (my \attr := nqp::getattr(self, + nqp::atpos($task,1), + nqp::atpos($task,2) + )), + (attr = nqp::atpos($task,3)(self,attr)) + ), + nqp::getattr(self,nqp::atpos($task,1),nqp::atpos($task,2)) = + nqp::atpos($task,3) ) ), @@ -216,7 +221,11 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" nqp::bindattr_i(self, nqp::atpos($task,1), nqp::atpos($task,2), - (nqp::atpos($task,3)(self,$int)) + nqp::if( + nqp::istype(nqp::atpos($task,3),Block), + (nqp::atpos($task,3)(self,$int)), + nqp::atpos($task,3) + ) ) ), @@ -230,7 +239,11 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" nqp::bindattr_n(self, nqp::atpos($task,1), nqp::atpos($task,2), - (nqp::atpos($task,3)(self,$num)) + nqp::if( + nqp::istype(nqp::atpos($task,3),Block), + (nqp::atpos($task,3)(self,$num)), + nqp::atpos($task,3) + ) ) ), @@ -244,7 +257,11 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" nqp::bindattr_s(self, nqp::atpos($task,1), nqp::atpos($task,2), - (nqp::atpos($task,3)(self,$str)) + nqp::if( + nqp::istype(nqp::atpos($task,3),Block), + (nqp::atpos($task,3)(self,$str)), + nqp::atpos($task,3) + ) ) ), @@ -343,12 +360,17 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" nqp::atpos($task,1), nqp::atpos($task,2) ), - nqp::stmts( - (my \attr := nqp::getattr(self, - nqp::atpos($task,1), - nqp::atpos($task,2) - )), - (attr = nqp::atpos($task,3)(self,attr)) + nqp::if( + nqp::istype(nqp::atpos($task,3),Block), + nqp::stmts( + (my \attr := nqp::getattr(self, + nqp::atpos($task,1), + nqp::atpos($task,2) + )), + (attr = nqp::atpos($task,3)(self,attr)) + ), + nqp::getattr(self,nqp::atpos($task,1),nqp::atpos($task,2)) = + nqp::atpos($task,3) ) ), @@ -362,7 +384,11 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" nqp::bindattr_i(self, nqp::atpos($task,1), nqp::atpos($task,2), - (nqp::atpos($task,3)(self,$int)) + nqp::if( + nqp::istype(nqp::atpos($task,3),Block), + (nqp::atpos($task,3)(self,$int)), + nqp::atpos($task,3) + ) ) ), @@ -376,7 +402,11 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" nqp::bindattr_n(self, nqp::atpos($task,1), nqp::atpos($task,2), - (nqp::atpos($task,3)(self,$num)) + nqp::if( + nqp::istype(nqp::atpos($task,3),Block), + (nqp::atpos($task,3)(self,$num)), + nqp::atpos($task,3) + ) ) ), @@ -390,7 +420,11 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" nqp::bindattr_s(self, nqp::atpos($task,1), nqp::atpos($task,2), - (nqp::atpos($task,3)(self,$str)) + nqp::if( + nqp::istype(nqp::atpos($task,3),Block), + (nqp::atpos($task,3)(self,$str)), + nqp::atpos($task,3) + ) ) ), diff --git a/src/core/traits.pm b/src/core/traits.pm index c554da036e0..571a8cdce07 100644 --- a/src/core/traits.pm +++ b/src/core/traits.pm @@ -474,7 +474,7 @@ multi sub trait_mod:(Attribute:D $attr, |c ) { highexpect => , ).throw; } -multi sub trait_mod:(Attribute $attr, Block :$build!) { # internal usage +multi sub trait_mod:(Attribute $attr, Mu :$build!) { # internal usage $attr.set_build($build) } From 2e7cad4419a543449d9615a70bdaa9d261481c6f Mon Sep 17 00:00:00 2001 From: Daniel Green Date: Fri, 6 Oct 2017 20:56:10 -0400 Subject: [PATCH 347/692] Suggest enum values as types Implements RT #123926, e.g., `enum E ; sub x(Floo) {}` now says `Invalid typename 'Floo' in parameter declaration. Did you mean 'Foo'?` --- src/Perl6/World.nqp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index 4503a4c5fb7..3959ed388c8 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -3656,7 +3656,7 @@ class Perl6::World is HLL::World { # only care about type objects my $first := nqp::substr($name, 0, 1); return 1 if $first eq '$' || $first eq '%' || $first eq '@' || $first eq '&' || $first eq ':'; - return 1 if !$has_object || nqp::isconcrete($object); + return 1 if !$has_object || (nqp::isconcrete($object) && !($object.HOW.HOW.name($object.HOW) eq 'Perl6::Metamodel::EnumHOW')); return 1 if nqp::existskey(%seen, $name); %seen{$name} := 1; From f9432a82fb748b79c4c9be3c3310394dacbe9130 Mon Sep 17 00:00:00 2001 From: skids Date: Fri, 6 Oct 2017 22:20:08 -0400 Subject: [PATCH 348/692] Warn on typical precedence errors with infix:<..> (RT#127279) Alerts user to potential accidental use of prefix:<|> or prefix:<~> on a range start value, when they are usually intended to apply to the entire range, and encourages use of parens. --- src/Perl6/Actions.nqp | 19 +++++++++++++++++++ src/core/Exception.pm | 7 +++++++ 2 files changed, 26 insertions(+) diff --git a/src/Perl6/Actions.nqp b/src/Perl6/Actions.nqp index 626deeaade0..a486789ba79 100644 --- a/src/Perl6/Actions.nqp +++ b/src/Perl6/Actions.nqp @@ -6469,6 +6469,16 @@ class Perl6::Actions is HLL::Actions does STDActions { 'fff^', -> $/, $sym { flipflop($/[0].ast, $/[1].ast, 0, 1, 1) }, '^fff^',-> $/, $sym { flipflop($/[0].ast, $/[1].ast, 1, 1, 1) } ); + my %worrisome := nqp::hash( + '..', 1, + '^..', 1, + '..^', 1, + '^..^', 1, + 'R..', 1, + 'R^..', 1, + 'R..^', 1, + 'R^..^', 1 + ); method EXPR($/, $KEY?) { unless $KEY { return 0; } my $past := $/.ast // $.ast; @@ -6636,6 +6646,15 @@ class Perl6::Actions is HLL::Actions does STDActions { :op('hllize'), :returns($past.returns())); } } + if $key eq 'infix' && nqp::existskey(%worrisome, ~$/) { + if ~$/[0] eq '|' { + $/[0].typed_worry('X::Worry::Precedence::Range', action => "apply a Slip flattener to", precursor => 1); + } + elsif ~$/[0] eq '~' { + $/[0].typed_worry('X::Worry::Precedence::Range', action => "stringify", precursor => 1); + } + } + make $past; } diff --git a/src/core/Exception.pm b/src/core/Exception.pm index e87c06bed78..2ef0c26ec60 100644 --- a/src/core/Exception.pm +++ b/src/core/Exception.pm @@ -841,6 +841,13 @@ my class X::Worry::P5::LeadingZero is X::Worry::P5 { ) ~ '. If you meant to create a string, please add quotation marks.' } } +my class X::Worry::Precedence::Range is X::Worry { + has $.action; + method message { +"To $!action a range, parenthesize the whole range. +(Or parenthesize the whole endpoint expression, if you meant that.)" + } +} my class X::Trait::Invalid is Exception { has $.type; # is, will, of etc. From 54d50967325189ff4633fc806093ef91e650316f Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 7 Oct 2017 11:47:05 +0000 Subject: [PATCH 349/692] Remove dead code for `use v5` Dies while complaining about missing `Perl5` module. A thought occured to make it load Inline::Perl5, but felt like useless magic, so I removed the code entirely and just make it complain there's no compiler for v5, like it'd do for `use v6.z` Fixes RT#130834: https://rt.perl.org/Ticket/Display.html?id=130834 --- src/Perl6/Grammar.nqp | 5 ----- t/05-messages/01-errors.t | 3 +++ 2 files changed, 3 insertions(+), 5 deletions(-) diff --git a/src/Perl6/Grammar.nqp b/src/Perl6/Grammar.nqp index 8a4a8da768e..96a806d44ac 100644 --- a/src/Perl6/Grammar.nqp +++ b/src/Perl6/Grammar.nqp @@ -1607,11 +1607,6 @@ grammar Perl6::Grammar is HLL::Grammar does STD { # we parse out the numeral, since we could have "6c" :my $version := nqp::radix(10,$[0],0,0)[0]; [ - || { - my $module := $*W.load_module($/, 'Perl5', {}, $*GLOBALish); - $*W.do_import($/, $module, 'Perl5'); - $*W.import_EXPORTHOW($/, $module); - } || { my $version_parts := $; my $vwant := $.ast.compile_time_value; diff --git a/t/05-messages/01-errors.t b/t/05-messages/01-errors.t index 76af7bc421f..dda3c621878 100644 --- a/t/05-messages/01-errors.t +++ b/t/05-messages/01-errors.t @@ -225,6 +225,9 @@ subtest '`IO::Socket::INET.new: :listen` fails with useful error' => { like $res.exception.message, /'Invalid port'/, 'error mentions port'; } +throws-like 「use v5」, X::Language::Unsupported, + '`use v5` in code does not try to load non-existent modules'; + done-testing; # vim: ft=perl6 expandtab sw=4 From 6757f9347302e53ec7b8e97acfdd1d6cf9ed582f Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 7 Oct 2017 08:46:23 -0400 Subject: [PATCH 350/692] Fix up t/02-rakudo/01-is_approx.t tests The author of planck tests wrote them without any regard to `e-34` part of the number and adjusted the numbers in the decimal portion alone, expecting changes to be of 1e-5 magnitude when they were actually of 1e-39 magnitude. Fix by shifting the original value by expected differences instead. --- t/02-rakudo/01-is_approx.t | 28 +++++++++++++++------------- 1 file changed, 15 insertions(+), 13 deletions(-) diff --git a/t/02-rakudo/01-is_approx.t b/t/02-rakudo/01-is_approx.t index a687c5bfd0d..c16742f3938 100644 --- a/t/02-rakudo/01-is_approx.t +++ b/t/02-rakudo/01-is_approx.t @@ -4,13 +4,18 @@ use Test; plan 11; +# These tests are meant to test now-deprecated `is_approx`, not `is-approx` +# If `is_approx` is removed entirely, remove this test file. The `is-approx` +# routine is already tested in roast. +%*ENV = 1; + # "large" numbers { my $speed_of_light = 2.99792458e8; my $not_quite_sol = 2.997925e8; # expect to pass with current implementation - is-approx($not_quite_sol, $speed_of_light, + is_approx($not_quite_sol, $speed_of_light, "approx within 1e-5"); # however is not "within" 1e-5 but differ by 42 @@ -18,7 +23,7 @@ plan 11; $not_quite_sol = 2.99793e8; my $message = "should fail; approx *not* within 1e-5"; todo $message; - my $ok = is-approx($not_quite_sol, $speed_of_light, $message); + my $ok = is_approx($not_quite_sol, $speed_of_light, $message); # however is not "within" 1e-5 but differ by 542 nok($ok); } @@ -29,39 +34,36 @@ plan 11; my $not_quite_ec = 2.71828; # expect to pass with current implementation - is-approx($not_quite_ec, $eulers_constant, + is_approx($not_quite_ec, $eulers_constant, "approx within 1e-5"); # expect to fail with current implementation $not_quite_ec = 2.71829; my $message = "should fail; approx *not* within 1e-5"; todo $message; - my $ok = is-approx($not_quite_ec, $eulers_constant, $message); + my $ok = is_approx($not_quite_ec, $eulers_constant, $message); nok($ok, $message); } # "small" numbers { - my $plancks_constant = 6.62609657e-34; - my $not_quite_pc = 6.62609e-34; + my $exp = 6.62609657; # expect to pass with current implementation - is-approx($not_quite_pc, $plancks_constant, + is_approx($exp - 1e-6, $exp, "should pass; approx within 1e-5"); # expect to fail with current implementation - $not_quite_pc = 6.62608e-34; - my $message = "should fail; approx *not* within 1e-5"; + my $message = "should fail; approx *not* within 1e-5 (1)"; todo $message; - my $ok = is-approx($not_quite_pc, $plancks_constant, $message); + my $ok = is_approx($exp - 2e-5, $exp, $message); nok($ok, $message); # however passes, since numbers themselves are smaller than 1e-5 # *really* expect to fail with current implementation - $not_quite_pc = 16.62608e-34; - $message = "should fail; approx *not* within 1e-5"; + $message = "should fail; approx *not* within 1e-5 (2)"; todo $message; - $ok = is-approx($not_quite_pc, $plancks_constant, $message); + $ok = is_approx($exp + 42, $exp, $message); nok($ok, $message); # however passes, since numbers themselves are smaller than 1e-5 } From 0d5bb9097a6ee31bfbb4629614831ae8a9971106 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 7 Oct 2017 08:58:29 -0400 Subject: [PATCH 351/692] Fudge failing tests Not sure there's any point in fixing this, since it's not part of the language and we already got `dd` and language-wise we got `.perl` --- t/02-rakudo/dump.t | 2 ++ 1 file changed, 2 insertions(+) diff --git a/t/02-rakudo/dump.t b/t/02-rakudo/dump.t index d95517e9537..58dce496d9d 100644 --- a/t/02-rakudo/dump.t +++ b/t/02-rakudo/dump.t @@ -19,6 +19,7 @@ is DUMP(Duration), Duration.perl, 'DUMP(:U) is .perl (Duration)'; is DUMP(Instant), Instant.perl, 'DUMP(:U) is .perl (Instant)'; # Defined booleans DUMP as .Str +todo 'NYI', 2; is DUMP(False), False.Str, 'DUMP(Bool:D) is .Str (False)'; is DUMP(True), True.Str, 'DUMP(Bool:D) is .Str (True)'; @@ -59,6 +60,7 @@ my int $int = 42; my num $num = 12345e0; my str $str = 'a string'; +todo 'NYI (can it even?)', 3; is DUMP($int), DUMP(42), 'DUMP(int) dumps as a literal'; is DUMP($num), DUMP(12345e0), 'DUMP(num) dumps as a literal'; is DUMP($str), DUMP('a string'), 'DUMP(str) dumps as a literal'; From 93c4555db32cfca980ee9a183b3220d34b9e53f6 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 7 Oct 2017 09:00:44 -0400 Subject: [PATCH 352/692] Unfudge now-passing test --- t/02-rakudo/dump.t | 1 - 1 file changed, 1 deletion(-) diff --git a/t/02-rakudo/dump.t b/t/02-rakudo/dump.t index 58dce496d9d..5f88a8459dd 100644 --- a/t/02-rakudo/dump.t +++ b/t/02-rakudo/dump.t @@ -43,7 +43,6 @@ is DUMP(-1.1), (-1.1).perl, 'DUMP(Rat:D) is .perl (-1.1)'; is DUMP( 22/7), ( 22/7).perl, 'DUMP(Rat:D) is .perl (22/7)'; is DUMP(-22/7), (-22/7).perl, 'DUMP(Rat:D) is .perl (-22/7)'; -todo('0i literal gets wrapped in a container, unlike other numeric literals'); is DUMP( 0i), ( 0i).perl, 'DUMP(Complex:D) is .perl (0i)'; is DUMP( -0i), ( -0i).perl, 'DUMP(Complex:D) is .perl (-0i)'; is DUMP( 0+0i), ( 0+0i).perl, 'DUMP(Complex:D) is .perl (0+0i)'; From 78eca2141d300aeb18aebebe34d67ba7c18c2a5c Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 7 Oct 2017 09:24:55 -0400 Subject: [PATCH 353/692] Start making repl tests work --- t/02-rakudo/repl.t | 25 ++++++-------- t/packages/Test/Helpers.pm6 | 67 +++++++++++++++++++++++++++++++++++++ 2 files changed, 78 insertions(+), 14 deletions(-) diff --git a/t/02-rakudo/repl.t b/t/02-rakudo/repl.t index 2d556cc6521..a7c13c5c749 100644 --- a/t/02-rakudo/repl.t +++ b/t/02-rakudo/repl.t @@ -1,5 +1,7 @@ use v6; +use lib ; use Test; +use Test::Helpers; # Sanity check that the repl is working at all. my $cmd = $*DISTRO.is-win @@ -256,16 +258,12 @@ is feed_repl_with(['say "hi"'], :no-filter-messages).subst(:g, /\W+/, ''), 'prefix 0 on valid octal warns in REPL'; } -done-testing; - -=finish - # RT #70297 { my $proc = &CORE::run( $*EXECUTABLE, :in, :out, :err); $proc.in.close; - #?rakudo 2 skip 'Result differs on OSX' + skip 'Result differs on OSX'; subtest { plan 2; is $proc.err.slurp, '', 'stderr is correct'; @@ -279,7 +277,7 @@ done-testing; my $code-to-run = q/[1..99].map:{[$_%%5&&'fizz', $_%%3&&'buzz'].grep:Str}/ ~ "\nsay 'We are still alive';\n"; - is_run_repl $code-to-run, + is-run-repl $code-to-run, out => /'Cannot resolve caller grep' .* 'We are still alive'/, err => '', 'exceptions from lazy-evaluated things do not crash REPL'; @@ -292,15 +290,14 @@ done-testing; 'num32 $i, num64 $j,', ') = 1, 2, 3, 4, 5, 6, 7, 8, 9e0, 10e0;'; - #?rakudo.moar todo 'RT#127933' - is_run_repl "$code\nsay 'test is good';\n", + todo 'RT#127933'; + is-run-repl "$code\nsay 'test is good';\n", :err(''), :out(/'(1 2 3 4 5 6 7 8 9 10)' .* 'test is good'/), 'Using native numeric types does not break REPL'; } # RT #128595 -#?rakudo.jvm skip 'Proc::Async NYI RT #126524' { # REPL must not start, but if it does start and wait for input, it'll # "hang", from our point of view, which the test function will detect @@ -312,7 +309,7 @@ done-testing; # RT #128973 { - is_run_repl "my \$x = 42;\nsay qq/The value is \$x/;\n", + is-run-repl "my \$x = 42;\nsay qq/The value is \$x/;\n", :err(''), :out(/'The value is 42'/), 'variables persist across multiple lines of input'; @@ -323,7 +320,7 @@ done-testing; # entered line of code, then we'll have more than just two 'say' print # outs. So we check the output each output happens just once my $code = .map({ "say 'testing-repl-$_';"}).join("\n"); - is_run_repl "$code\n", + is-run-repl "$code\n", :err(''), :out({ $^o.comb('testing-repl-one') == 1 @@ -337,7 +334,7 @@ done-testing; my $code = 'sub x() returns Array of Int { return my @x of Int = 1,2,3 };' ~ "x().WHAT.say\n"; - is_run_repl $code x 10, + is-run-repl $code x 10, :err(''), :out({ not $^o.contains: '[Int][Int]' }), 'no bizzare types returned from redeclared "returns an `of` Array" sub'; @@ -346,7 +343,7 @@ done-testing; # RT #127631 { - is_run_repl join("\n", , 'say "rt127631-pass"', ''), + is-run-repl join("\n", , 'say "rt127631-pass"', ''), :err(''), :out(/'rt127631-pass'/), 'loop controls do not exit the REPL'; @@ -354,7 +351,7 @@ done-testing; # RT #130719 { - is_run_repl join("\n", 'Mu', ''), + is-run-repl join("\n", 'Mu', ''), :err(''), :out{.contains('failed').not}, 「REPL can handle `Mu` as line's return value」; diff --git a/t/packages/Test/Helpers.pm6 b/t/packages/Test/Helpers.pm6 index 44511b9ccc2..4419b944e6d 100644 --- a/t/packages/Test/Helpers.pm6 +++ b/t/packages/Test/Helpers.pm6 @@ -26,3 +26,70 @@ sub is-run ( } } } + +sub is-run-repl ($code, $desc, :$out, :$err) is export { + my $proc = &CORE::run( $*EXECUTABLE, :in, :out, :err ); + $proc.in.print: $code; + $proc.in.close; + subtest { + plan +($out, $err).grep: *.defined; + with $out { + my $output = $proc.out.slurp; + my $test-name = 'stdout is correct'; + when Str { is $output, $_, $test-name; } + when Regex { like $output, $_, $test-name; } + when Callable { ok $_($output), $test-name; } + + die "Don't know how to handle :out of type $_.^name()"; + } + + with $err { + my $output = $proc.err.slurp; + my $test-name = 'stderr is correct'; + when Str { is $output, $_, $test-name; } + when Regex { like $output, $_, $test-name; } + when Callable { ok $_($output), $test-name; } + + die "Don't know how to handle :err of type $_.^name()"; + } + }, $desc; +} + +multi doesn't-hang (Str $args, $desc, :$in, :$wait = 1.5, :$out, :$err) +is export { + doesn't-hang \($*EXECUTABLE, '-e', $args), $desc, + :$in, :$wait, :$out, :$err; +} + +multi doesn't-hang ( + Capture $args, $desc = 'code does not hang', + :$in, :$wait = 1.5, :$out, :$err, +) is export { + my $prog = Proc::Async.new: |$args; + my ($stdout, $stderr) = '', ''; + $prog.stdout.tap: { $stdout ~= $^a }; + $prog.stderr.tap: { $stderr ~= $^a }; + + # We start two Promises: the program to run and a Promise that waits for + # $wait seconds. We await any of them, so if the $wait seconds pass, + # await returns and we follow the path that assumes the code we ran hung. + my $promise = $prog.start; + await $prog.write: $in.encode if $in.defined; + await Promise.anyof: Promise.in($wait * (%*ENV//1)), + $promise; + + my $did-not-hang = False; + given $promise.status { + when Kept { $did-not-hang = True }; + $prog.kill; + } + + subtest $desc, { + plan 1 + ( $did-not-hang ?? ($out, $err).grep(*.defined) !! 0 ); + ok $did-not-hang, 'program did not hang'; + if $did-not-hang { + cmp-ok $stdout, '~~', $out, 'STDOUT' if $out.defined; + cmp-ok $stderr, '~~', $err, 'STDERR' if $err.defined; + } + }; +} From f59b2887adfc09d6885eda6ba43d2670bcc21a71 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 7 Oct 2017 10:14:06 -0400 Subject: [PATCH 354/692] Fix precedence error; RabidGravy++ --- lib/NativeCall.pm6 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/NativeCall.pm6 b/lib/NativeCall.pm6 index 6ccd6d2d905..ddbf7304f6f 100644 --- a/lib/NativeCall.pm6 +++ b/lib/NativeCall.pm6 @@ -334,7 +334,7 @@ our role Native[Routine $r, $libname where Str|Callable|List|IO::Path|Distributi my @deconts; my @params; for $r.signature.params { - next if nqp::istype($r, Method) && $_.name // '' eq '%_'; + next if nqp::istype($r, Method) && ($_.name // '') eq '%_'; my $name = $_.name || '__anonymous_param__' ~ $++; my $lowered_param_name = '__lowered_param__' ~ $locals; my $lowered_name = '__lowered__' ~ $locals++; From ba2d858fb259a036cdde19b789b33fda8d376abf Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 7 Oct 2017 10:52:42 -0400 Subject: [PATCH 355/692] Fix precedence error; RabidGravy++ --- lib/NativeCall.pm6 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/NativeCall.pm6 b/lib/NativeCall.pm6 index ddbf7304f6f..5497b5b71e9 100644 --- a/lib/NativeCall.pm6 +++ b/lib/NativeCall.pm6 @@ -397,7 +397,7 @@ our role Native[Routine $r, $libname where Str|Callable|List|IO::Path|Distributi my $arglist := QAST::Op.new(:op); my $locals = 0; for $r.signature.params { - next if nqp::istype($r, Method) && $_.name // '' eq '%_'; + next if nqp::istype($r, Method) && ($_.name // '') eq '%_'; my $name = $_.name || '__anonymous_param__' ~ $++; my $decont = self!decont-for-type($_.type); if $_.rw and nqp::objprimspec($_.type) > 0 { From 5f6896bde81d568c8d227d27420be38be480b310 Mon Sep 17 00:00:00 2001 From: Timo Paulssen Date: Sat, 7 Oct 2017 18:08:44 +0200 Subject: [PATCH 356/692] use nqp::codes op to speed up Int not a vast improvement, but having one allocation less is a nice bonus. --- src/core/Str.pm | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) diff --git a/src/core/Str.pm b/src/core/Str.pm index f7492739d32..3ef48f459ff 100644 --- a/src/core/Str.pm +++ b/src/core/Str.pm @@ -55,13 +55,7 @@ my class Str does Stringy { # declared in BOOTSTRAP # Compare Str.chars == Str.codes to filter out any combining characters && nqp::iseq_i( nqp::chars($!value), - nqp::elems( - nqp::strtocodes( - $!value, - nqp::const::NORMALIZE_NFC, - nqp::create(NFC), - ) - ), + nqp::codes($!value) ) #?endif #?if jvm From d8a20d11347d31d910669e42de62f20d2c85fbd2 Mon Sep 17 00:00:00 2001 From: Jonathan Stowe Date: Sat, 7 Oct 2017 17:18:44 +0100 Subject: [PATCH 357/692] Add tests to cover a common NC usage C functions that consistently take some struct or pointer as the first argument are declared as methods of that CStruct or CPointer --- t/04-nativecall/22-method.c | 25 +++++++++++++++++++++++++ t/04-nativecall/22-method.t | 29 +++++++++++++++++++++++++++++ 2 files changed, 54 insertions(+) create mode 100644 t/04-nativecall/22-method.c create mode 100644 t/04-nativecall/22-method.t diff --git a/t/04-nativecall/22-method.c b/t/04-nativecall/22-method.c new file mode 100644 index 00000000000..cf86e636f31 --- /dev/null +++ b/t/04-nativecall/22-method.c @@ -0,0 +1,25 @@ +#include +#include +#include + +#ifdef _WIN32 +#define DLLEXPORT __declspec(dllexport) +#else +#define DLLEXPORT extern +#endif + +typedef struct { + long intval; +} MyStruct; + +DLLEXPORT MyStruct *ReturnAStruct(long intval) +{ + MyStruct *obj = (MyStruct *) malloc(sizeof(MyStruct)); + obj->intval = intval; + return obj; +} + +DLLEXPORT long Add(MyStruct *obj, long intval) +{ + return obj->intval + intval; +} diff --git a/t/04-nativecall/22-method.t b/t/04-nativecall/22-method.t new file mode 100644 index 00000000000..68929256b9e --- /dev/null +++ b/t/04-nativecall/22-method.t @@ -0,0 +1,29 @@ +use v6; + +use lib ; +use CompileTestLib; +use NativeCall; +use Test; + +plan 2; + +compile_test_lib('22-method'); + +class MyStruct is repr('CStruct') { + has long $.long; + + sub ReturnAStruct(long $intval --> MyStruct) is native('./22-method') { * } + method new(Int :$intval) { + ReturnAStruct($intval) + } + method Add(long $intval --> long) is native('./22-method') { * } +} + +my $a = MyStruct.new(intval => 42); + +my $res; + +lives-ok { $res = $a.Add(2) }, "native sub as method"; +is $res, 44, "and got the result we expected"; + +# vim:ft=perl6 From 9ce896d8bf7886e8a87ead3f36b47d5b232568ba Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 7 Oct 2017 16:45:49 +0000 Subject: [PATCH 358/692] Bump NQP --- tools/build/NQP_REVISION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/build/NQP_REVISION b/tools/build/NQP_REVISION index 46fb0479d8f..4017ef5ea14 100644 --- a/tools/build/NQP_REVISION +++ b/tools/build/NQP_REVISION @@ -1 +1 @@ -2017.09-59-g60f79d3 +2017.09-65-gc38cfe8 From 20518454ef6b9e1d38abf01c04e6afea4e37548a Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 7 Oct 2017 16:54:31 +0000 Subject: [PATCH 359/692] Update compiler usage message for STDIN eval Since recently-ish, if STDIN is not a TTY, we've treated STDIN as simply a file with code to eval, without starting REPL. --- src/Perl6/Compiler.nqp | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Perl6/Compiler.nqp b/src/Perl6/Compiler.nqp index d75b03b2e4c..9b8c9c3d9da 100644 --- a/src/Perl6/Compiler.nqp +++ b/src/Perl6/Compiler.nqp @@ -86,9 +86,9 @@ class Perl6::Compiler is HLL::Compiler { my $print-func := $use-stderr ?? ¬e !! &say; # RT #130760 $print-func(($name ?? $name !! "") ~ " [switches] [--] [programfile] [arguments] -With no arguments, enters a REPL. With a \"[programfile]\" or the \"-e\" -option, compiles the given program and, by default, also executes the -compiled code. +With no arguments, enters a REPL on TTY displays or evals STDIN on non-TTY. +With a \"[programfile]\" or the \"-e\" option, compiles the given program +and, by default, also executes the compiled code. -c check syntax only (runs BEGIN and CHECK blocks) --doc extract documentation and print it as text From 5c7bbea0a920591afac02d1ee7d98255cc8e5191 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 7 Oct 2017 17:04:02 +0000 Subject: [PATCH 360/692] Add --force-stdin-eval-mode opt to usage msg --- src/Perl6/Compiler.nqp | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/Perl6/Compiler.nqp b/src/Perl6/Compiler.nqp index 9b8c9c3d9da..ab5ff2ab54e 100644 --- a/src/Perl6/Compiler.nqp +++ b/src/Perl6/Compiler.nqp @@ -117,6 +117,11 @@ and, by default, also executes the compiled code. any other extension outputs in HTML --doc=module use Pod::To::[module] to render inline documentation + --force-stdin-eval-mode=interactive|non-interactive + when running without -e or filename arguments, + do not rely on whether STDIN is a TTY and force the + eval of code from STDIN to be via REPL (interactive) + or without REPL (non-interactive) Note that only boolean single-letter options may be bundled. From 5747bc7121ba68bea210d1a75bb0e197377b287c Mon Sep 17 00:00:00 2001 From: TimToady Date: Sat, 7 Oct 2017 12:31:08 -0700 Subject: [PATCH 361/692] deconfuse statement modifier errors Catch missing expressions on statement modifiers earlier so that the tests eat_terminator are only for statement controls. Also, move the cursor to the front of the cursor controls to indicate where the semicolon is actually perceived to be missing if we report that. Additionally, we change the kok check to use .panic instead of .sorry to avoid multiple errors resulting from repeated terminator checks that use statement modifier keywords for terminators. Fixes #125596 and #125674. --- src/Perl6/Grammar.nqp | 31 ++++++++++++++++++------------- 1 file changed, 18 insertions(+), 13 deletions(-) diff --git a/src/Perl6/Grammar.nqp b/src/Perl6/Grammar.nqp index 8a1c851cbfd..1155ddd5f8f 100644 --- a/src/Perl6/Grammar.nqp +++ b/src/Perl6/Grammar.nqp @@ -604,7 +604,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD { my $n := nqp::substr(self.orig, self.from, self.pos - self.from); $*W.is_name([$n]) || $*W.is_name(['&' ~ $n]) ?? False - !! self.sorry("Whitespace required after keyword '$n'") + !! self.panic("Whitespace required after keyword '$n'") }> ] } @@ -1331,7 +1331,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD { || || $ || - || { self.typed_panic( 'X::Syntax::Confused', reason => "Missing semicolon" ) } + || { $/.'!clear_highwater'(); self.typed_panic( 'X::Syntax::Confused', reason => "Missing semicolon" ) } || { $/.typed_panic( 'X::Syntax::Confused', reason => "Confused" ) } } @@ -1773,21 +1773,26 @@ grammar Perl6::Grammar is HLL::Grammar does STD { proto rule statement_mod_cond { <...> } - token modifier_expr { } - token smexpr { } + method nomodexpr($k) { + self.'!clear_highwater'(); + self.typed_panic( 'X::Syntax::Confused', reason => "Missing expression for '$k' statement modifier" ); + self; + } + token modifier_expr($k) { || <.nomodexpr($k)> } + token smexpr($k) { || <.nomodexpr($k)> } - rule statement_mod_cond:sym { <.kok> } - rule statement_mod_cond:sym { <.kok> } - rule statement_mod_cond:sym { <.kok> } - rule statement_mod_cond:sym { <.kok> } - rule statement_mod_cond:sym{ <.kok> } + rule statement_mod_cond:sym { <.kok> } + rule statement_mod_cond:sym { <.kok> } + rule statement_mod_cond:sym { <.kok> } + rule statement_mod_cond:sym { <.kok> } + rule statement_mod_cond:sym{ <.kok> } proto rule statement_mod_loop { <...> } - rule statement_mod_loop:sym { <.kok> } - rule statement_mod_loop:sym { <.kok> } - rule statement_mod_loop:sym { <.kok> } - rule statement_mod_loop:sym { <.kok> } + rule statement_mod_loop:sym { <.kok> } + rule statement_mod_loop:sym { <.kok> } + rule statement_mod_loop:sym { <.kok> } + rule statement_mod_loop:sym { <.kok> } ## Terms From 5144216f6ea723747cb25fea51f99861c1ea213a Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sat, 7 Oct 2017 22:13:00 +0200 Subject: [PATCH 362/692] Cache types we always need in the CompilerServices - this appears to make the setting compilation a bit faster - but getting timings on that is always difficult :-( --- src/Perl6/World.nqp | 94 ++++++++++++++++++++------------------- src/core/core_prologue.pm | 10 +++-- 2 files changed, 56 insertions(+), 48 deletions(-) diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index 3959ed388c8..ca90337b688 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -2972,6 +2972,14 @@ class Perl6::World is HLL::World { # The generic BUILDALL method for empty BUILDPLANs has $!empty_buildplan_method; + # Types we always need + has $!Block; + has $!DefiniteHOW; + has $!Failure; + has $!List; + has $!Map; + has $!X-Attribute-Required; + # Parameters we always need my $pself := QAST::Var.new(:decl, :scope, :name); my $pauto := QAST::Var.new(:decl, :scope, :name<@auto>); @@ -3038,8 +3046,8 @@ class Perl6::World is HLL::World { $!w.cur_lexpad()[0].push($block); # Find/Create the type of the invocant - my $invocant_type := $!w.create_definite_type( - $!w.find_symbol(['Metamodel','DefiniteHOW']), $package_type, 1 ); + my $invocant_type := + $!w.create_definite_type($!DefiniteHOW, $package_type, 1); # Seen accessors of this class before, so use existing signature my $sig; @@ -3082,11 +3090,8 @@ class Perl6::World is HLL::World { method generate_buildplan_executor($/, $in_object, $in_build_plan) { # low level hash access - my $build_plan := nqp::getattr( - nqp::decont($in_build_plan), - $!w.find_symbol(['List']), - '$!reified' - ); + my $build_plan := + nqp::getattr(nqp::decont($in_build_plan), $!List, '$!reified'); if nqp::elems($build_plan) -> $count { @@ -3113,11 +3118,8 @@ class Perl6::World is HLL::World { $!w.cur_lexpad()[0].push($block); # Create the invocant type we need - my $invocant_type := $!w.create_definite_type( - $!w.find_symbol(['Metamodel','DefiniteHOW']), - $object, - 1 - ); + my $invocant_type := + $!w.create_definite_type($!DefiniteHOW, $object, 1); # Debugging # $stmts.push( @@ -3137,9 +3139,7 @@ class Perl6::World is HLL::World { $stmts.push(QAST::Op.new( :op, $init, QAST::Op.new( :op, - $hllinit, - QAST::WVal.new( :value($!w.find_symbol(['Map'])) ), - $storage + $hllinit, QAST::WVal.new( :value($!Map) ), $storage ) )); @@ -3251,9 +3251,8 @@ class Perl6::World is HLL::World { ); my $initializer := nqp::istype( - nqp::atpos($task,3), - $!w.find_symbol(['Block']) -# $code(self,nqp::getattr(self,Foo,'$!a'))) + nqp::atpos($task,3),$!Block +# $code(self,nqp::getattr(self,Foo,'$!a')) ) ?? QAST::Op.new( :op, QAST::WVal.new(:value(nqp::atpos($task,3))), $self, $getattr @@ -3312,10 +3311,7 @@ class Perl6::World is HLL::World { QAST::Op.new( :op('bindattr' ~ @psp[$code - 4]), $self, $class, $attr, nqp::if( - nqp::istype( - nqp::atpos($task,3), - $!w.find_symbol(['Block']) - ), + nqp::istype(nqp::atpos($task,3),$!Block), QAST::Op.new( :op, QAST::WVal.new(:value(nqp::atpos($task,3))), $self, @@ -3350,10 +3346,7 @@ class Perl6::World is HLL::World { QAST::Op.new( :op, $self, $class, $attr, nqp::if( - nqp::istype( - nqp::atpos($task,3), - $!w.find_symbol(['Block']) - ), + nqp::istype(nqp::atpos($task,3),$!Block), QAST::Op.new( :op, QAST::WVal.new(:value(nqp::atpos($task,3))), $self, @@ -3382,17 +3375,12 @@ class Perl6::World is HLL::World { ), QAST::Op.new( :op, :name, QAST::Op.new( :op, :name, - QAST::WVal.new( :value( - $!w.find_symbol( - ['X','Attribute','Required'] - ) - )), + QAST::WVal.new( + :value($!X-Attribute-Required)), QAST::SVal.new( :named('name'), - :value(nqp::atpos($task,2)) - ), + :value(nqp::atpos($task,2))), QAST::WVal.new( :named('why'), - :value(nqp::atpos($task,3)) - ) + :value(nqp::atpos($task,3))) ) ) ) @@ -3465,14 +3453,11 @@ class Perl6::World is HLL::World { ) ) ), - QAST::WVal.new( - :value($!w.find_symbol(['Failure'])) - ), + QAST::WVal.new(:value($!Failure)), ), QAST::Op.new( :op, QAST::WVal.new( - :value($!w.find_symbol(['&return'])) - ), + :value($!w.find_symbol(['&return']))), QAST::Var.new(:scope, :name) ) ) @@ -3525,10 +3510,7 @@ class Perl6::World is HLL::World { $!w.cur_lexpad()[0].push($block); my $invocant_type := $!w.create_definite_type( - $!w.find_symbol(['Metamodel','DefiniteHOW']), - $!w.find_symbol(['Any']), - 1 - ); + $!DefiniteHOW, $!w.find_symbol(['Any']), 1); my $sig := $!w.create_signature_and_params( NQPMu, %sig_init, $block, 'Any', :method, :$invocant_type @@ -3542,20 +3524,42 @@ class Perl6::World is HLL::World { } method get_compiler_services($/) { + + # Already have a CompilerServices object if nqp::isconcrete($!compiler_services) { + + # Update $/ for error reporting on generated methods nqp::bindattr( $!compiler_services,$!compiler_services.WHAT,'$!current-match',$/ ); } + + # Don't have a CompilerServices object yet else { try { + + # Find the HLL version, might fail early in setting compilation my $wtype := self.find_symbol(['Rakudo','Internals','CompilerServices']); - my $wrapped := CompilerServices.new(w => self); my $wrapper := nqp::create($wtype); + + # Set up the base object + my $wrapped := CompilerServices.new( + w => self, + Block => self.find_symbol(['Block']), + DefiniteHOW => self.find_symbol(['Metamodel','DefiniteHOW']), + Failure => self.find_symbol(['Failure']), + List => self.find_symbol(['List']), + Map => self.find_symbol(['Map']), + X-Attribute-Required => + self.find_symbol(['X','Attribute','Required']) + ); nqp::bindattr($wrapper, $wtype, '$!compiler', $wrapped); nqp::bindattr($wrapper, $wtype, '$!current-match', $/); + + # When we got here, we really got a full CompilerServices object $!compiler_services := $wrapper; + } } $!compiler_services diff --git a/src/core/core_prologue.pm b/src/core/core_prologue.pm index e7fb1c76987..f76abe09bed 100644 --- a/src/core/core_prologue.pm +++ b/src/core/core_prologue.pm @@ -1,14 +1,18 @@ # Stub a few things the compiler wants to have really early on. -my class Pair { ... } -my class Whatever { ... } +my class Pair { ... } # must be first for some reason +my class Block { ... } my class HyperWhatever { ... } -my class WhateverCode { ... } +my class List { ... } +my class Map { ... } my class Match { ... } my class Failure { ... } my class Rakudo::Internals { ... } my class Rakudo::Internals::JSON { ... } my class Rakudo::Iterator { ... } my class ThreadPoolScheduler { ... } +my class Whatever { ... } +my class WhateverCode { ... } +my class X::Attribute::Required { ... } my class X::Numeric::Overflow { ... } my class X::Numeric::Underflow { ... } From a09f5f219449f448b3aacd1233e12336cb4aac92 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sat, 7 Oct 2017 22:32:52 +0200 Subject: [PATCH 363/692] Set up Builtin encodings at setting compile time - so we don't need to do this each time on startup - only saves maybe 1 msec of startup - but it makes future optimizations opening STDIN/OUT/ERR easier --- src/core/Encoding/Builtin.pm | 47 +---------------------------------- src/core/Encoding/Registry.pm | 28 ++++++++++++++++++++- tools/build/jvm_core_sources | 2 +- tools/build/moar_core_sources | 2 +- 4 files changed, 30 insertions(+), 49 deletions(-) diff --git a/src/core/Encoding/Builtin.pm b/src/core/Encoding/Builtin.pm index 1bf52fac428..00008de1268 100644 --- a/src/core/Encoding/Builtin.pm +++ b/src/core/Encoding/Builtin.pm @@ -43,49 +43,4 @@ class Encoding::Builtin does Encoding { } } -Encoding::Registry.register( - BEGIN nqp::create(Encoding::Builtin).SET-SELF( - "utf8", nqp::list("utf-8") - ) -); -Encoding::Registry.register( - BEGIN nqp::create(Encoding::Builtin).SET-SELF( - "utf8-c8", nqp::list("utf-8-c8") - ) -); -Encoding::Registry.register( - BEGIN nqp::create(Encoding::Builtin).SET-SELF( - "ascii", nqp::list - ) -); -Encoding::Registry.register( - BEGIN nqp::create(Encoding::Builtin).SET-SELF( - "iso-8859-1", - nqp::list( - "iso_8859-1:1987", - "iso_8859-1", - "iso-ir-100", - "latin1", - "latin-1", - "csisolatin1:", - "l1", - "ibm819", - "cp819" - ) - ) -); -Encoding::Registry.register( - BEGIN nqp::create(Encoding::Builtin).SET-SELF( - "windows-1252", nqp::list - ) -); -Encoding::Registry.register( - BEGIN nqp::create(Encoding::Builtin).SET-SELF( - "utf16", nqp::list("utf-16") - ) -); -Encoding::Registry.register( - BEGIN nqp::create(Encoding::Builtin).SET-SELF( - "utf32", nqp::list("utf-32") - ) -); +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Encoding/Registry.pm b/src/core/Encoding/Registry.pm index e71d5cfedef..4ef21c22054 100644 --- a/src/core/Encoding/Registry.pm +++ b/src/core/Encoding/Registry.pm @@ -3,7 +3,33 @@ my class X::Encoding::AlreadyRegistered { ... } my class Encoding::Registry { my $lock := Lock.new; - my $lookup := nqp::hash; + my %lookup; # access for registering builtins at compile time + my $lookup := nqp::getattr(%lookup,Map,'$!storage'); # access for runtime + + BEGIN { + my $lookup := nqp::bindattr(%lookup,Map,'$!storage',nqp::hash); + my $encodings := nqp::list( + nqp::list("ascii"), + nqp::list("iso-8859-1","iso_8859-1:1987","iso_8859-1","iso-ir-100", + "latin1","latin-1","csisolatin1","l1","ibm819","cp819"), + nqp::list("utf8","utf-8"), + nqp::list("utf8-c8","utf-8-c8"), + nqp::list("utf16","utf-16"), + nqp::list("utf32","utf-32"), + nqp::list("windows-1252") + ); + my int $i = -1; + my int $elems = nqp::elems($encodings); + while nqp::islt_i(($i = nqp::add_i($i,1)),$elems) { + my $names := nqp::atpos($encodings,$i); + my $builtin := nqp::create(Encoding::Builtin).SET-SELF( + nqp::shift($names),nqp::clone($names)); + nqp::bindkey($lookup,$builtin.name,$builtin); + while nqp::elems($names) { + nqp::bindkey($lookup,nqp::shift($names),$builtin); + } + } + } method register(Encoding $enc --> Nil) { $lock.protect: { diff --git a/tools/build/jvm_core_sources b/tools/build/jvm_core_sources index 8423d23797f..36499c38d66 100644 --- a/tools/build/jvm_core_sources +++ b/tools/build/jvm_core_sources @@ -50,8 +50,8 @@ src/core/Encoding/Encoder.pm src/core/Encoding/Encoder/Builtin.pm src/core/Encoding/Encoder/TranslateNewlineWrapper.pm src/core/Encoding.pm -src/core/Encoding/Registry.pm src/core/Encoding/Builtin.pm +src/core/Encoding/Registry.pm src/core/Str.pm src/core/Capture.pm src/core/IterationBuffer.pm diff --git a/tools/build/moar_core_sources b/tools/build/moar_core_sources index 87d148c9226..693dbcaa0e0 100644 --- a/tools/build/moar_core_sources +++ b/tools/build/moar_core_sources @@ -52,8 +52,8 @@ src/core/Encoding/Encoder.pm src/core/Encoding/Encoder/Builtin.pm src/core/Encoding/Encoder/TranslateNewlineWrapper.pm src/core/Encoding.pm -src/core/Encoding/Registry.pm src/core/Encoding/Builtin.pm +src/core/Encoding/Registry.pm src/core/Str.pm src/core/Capture.pm src/core/IterationBuffer.pm From c7a82d451d6506bda9422813fe72974575e473df Mon Sep 17 00:00:00 2001 From: usev6 Date: Tue, 13 Dec 2016 22:30:19 +0100 Subject: [PATCH 364/692] Try harder to diagnose problem instead of reporting 'Malformed my' Fixes RT #125902 --- src/Perl6/Grammar.nqp | 18 ++++++++++++++++-- 1 file changed, 16 insertions(+), 2 deletions(-) diff --git a/src/Perl6/Grammar.nqp b/src/Perl6/Grammar.nqp index 1155ddd5f8f..c035e9e09f0 100644 --- a/src/Perl6/Grammar.nqp +++ b/src/Perl6/Grammar.nqp @@ -2618,8 +2618,22 @@ grammar Perl6::Grammar is HLL::Grammar does STD { | ] - || <.ws>[<.ws>]* [':'?':'?'=' | <.terminator> | $ ]> {} - <.malformed("$*SCOPE (did you mean to declare a sigilless \\{~$} or \${~$}?)")> + || <.ws>[<.ws>]* + + [ + | ':'?':'?'=' + | <.terminator> + | + | "where" <.ws> + | $ + ] + > {} <.malformed("$*SCOPE (did you mean to declare a sigilless \\{~$} or \${~$}?)")> + || <.ws><.ws> > {} + <.malformed("$*SCOPE (found type followed by constraint; did you forget a variable in between?)")> + || <.ws><.ws> > {} + <.malformed("$*SCOPE (found type followed by trait; did you forget a variable in between?)")> + || <.ws><.ws> | $ ]> {} + <.malformed("$*SCOPE (did you forget a variable after type?)")> || <.ws> || <.malformed($*SCOPE)> ] From ac97a4016196c1fb5c39365dfbe8980574fb929b Mon Sep 17 00:00:00 2001 From: Aleks-Daniel Jakimenko-Aleksejev Date: Sun, 8 Oct 2017 00:55:29 +0300 Subject: [PATCH 365/692] Fix complaints about existing types MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Call typo_typename only if or failed, not if something else went wrong. Resolves ½ of RT #127100. --- src/Perl6/Grammar.nqp | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Perl6/Grammar.nqp b/src/Perl6/Grammar.nqp index c035e9e09f0..0ea2c189736 100644 --- a/src/Perl6/Grammar.nqp +++ b/src/Perl6/Grammar.nqp @@ -2943,7 +2943,9 @@ grammar Perl6::Grammar is HLL::Grammar does STD { <.ws> [ ' | ')' | ']' | '{' | ':'\s | ';;' > || <.malformed('parameter')> ] { $*IN_DECL := ''; } - [ '-->' <.ws> [[|] <.ws> || || <.malformed('return value')>] ]? + [ '-->' <.ws> [ || [|||] <.ws> + || <.malformed('return value')> + ] ]? { $*LEFTSIGIL := '@'; } } From bb5583aeb780c6b778cbf3447a39305f88803061 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sun, 8 Oct 2017 00:08:41 +0200 Subject: [PATCH 366/692] Streamline initialization of $*IN/$*OUT/$*ERR - do as much as possible during setting compilation - only plug in the handle/encoder/decoder at runtime - shaves off about 1.5% from bare startup time --- src/core/io_operators.pm | 52 +++++++++++++++++++++++++++++++++++----- 1 file changed, 46 insertions(+), 6 deletions(-) diff --git a/src/core/io_operators.pm b/src/core/io_operators.pm index e1669f75d9d..c1d34e1ced4 100644 --- a/src/core/io_operators.pm +++ b/src/core/io_operators.pm @@ -164,12 +164,52 @@ multi sub indir(IO() $path, &what, :$d = True, :$r, :$w, :$x) { } } -PROCESS::<$IN> = - IO::Handle.new(:path(IO::Special.new(''))).open; -PROCESS::<$OUT> = - IO::Handle.new(:path(IO::Special.new(''))).open; -PROCESS::<$ERR> = - IO::Handle.new(:path(IO::Special.new(''))).open; +# Set up the standard STDIN/STDOUT/STDERR by first setting up the skeletons +# of the IO::Handle objects that can be setup at compile time. Then, when +# running the mainline of the setting at startup, plug in the low level +# handles and set up the encoder and decoders. This shaves off about 1.5% +# of bare startup. +{ + my constant NL-IN = ["\x0A", "\r\n"]; + my constant NL-OUT = "\n"; + my constant ENCODING = "utf8"; + + my sub setup-handle(str $what) { + my $handle := nqp::p6bindattrinvres( + nqp::create(IO::Handle),IO::Handle,'$!path',nqp::p6bindattrinvres( + nqp::create(IO::Special),IO::Special,'$!what',$what + ) + ); + nqp::getattr($handle,IO::Handle,'$!chomp') = True; + nqp::getattr($handle,IO::Handle,'$!nl-in') = NL-IN; + nqp::getattr($handle,IO::Handle,'$!nl-out') = NL-OUT; + nqp::getattr($handle,IO::Handle,'$!encoding') = ENCODING; + $handle + } + + # Set up the skeletons at compile time + my constant STDIN = setup-handle(''); + my constant STDOUT = setup-handle(''); + my constant STDERR = setup-handle(''); + + my sub activate-handle(Mu \HANDLE, Mu \PIO) { + nqp::setbuffersizefh(PIO,8192) unless nqp::isttyfh(PIO); + + my $encoding = Encoding::Registry.find(ENCODING); + nqp::bindattr( + HANDLE,IO::Handle,'$!decoder',$encoding.decoder(:translate-nl) + ).set-line-separators(NL-IN); + nqp::bindattr( + HANDLE,IO::Handle,'$!encoder',$encoding.encoder(:translate-nl) + ); + nqp::p6bindattrinvres(HANDLE,IO::Handle,'$!PIO',PIO) + } + + # Activate the skeletons at runtime + PROCESS::<$IN> = activate-handle(STDIN, nqp::getstdin); + PROCESS::<$OUT> = activate-handle(STDOUT, nqp::getstdout); + PROCESS::<$ERR> = activate-handle(STDERR, nqp::getstderr); +} sub chmod($mode, *@filenames) { my @ok; From 3ca6554fdd8ff91da5423e85d4a2b7d309949531 Mon Sep 17 00:00:00 2001 From: David Warring Date: Sun, 8 Oct 2017 11:32:05 +1300 Subject: [PATCH 367/692] implement typed pointer increment and array dereference This enables: use NativeCall; my CArray[uint16] $a .= new: 10, 20 ... 100; my $p = nativecast(Pointer[uint16], $a); ++$p; say $p.deref; # 20 say $p[2]; ; # 40 Addresses RT #128000. Based on NativeHelpers::Pointer implementation salortiz++ --- lib/NativeCall/Types.pm6 | 14 ++++++++++++++ t/04-nativecall/04-pointers.c | 6 ++++++ t/04-nativecall/04-pointers.t | 10 +++++++++- 3 files changed, 29 insertions(+), 1 deletion(-) diff --git a/lib/NativeCall/Types.pm6 b/lib/NativeCall/Types.pm6 index d2ada206c36..5c2c8139936 100644 --- a/lib/NativeCall/Types.pm6 +++ b/lib/NativeCall/Types.pm6 @@ -56,6 +56,20 @@ our class Pointer is repr('CPointer') { my role TypedPointer[::TValue] { method of() { TValue } method deref(::?CLASS:D \ptr:) { self ?? nativecast(TValue, ptr) !! fail("Can't dereference a Null Pointer"); } + method add(UInt $off) returns Pointer { + die "Can't do arithmetic with a void pointer" + if TValue.isa(void); + nqp::box_i(self.Int + nqp::nativecallsizeof(TValue) * $off, self.WHAT); + } + method succ { + self.add(1); + } + method pred { + self.add(-1); + } + method AT-POS(Int $pos) { + self.add($pos).deref; + } } method ^parameterize(Mu:U \p, Mu:U \t) { die "A typed pointer can only hold:\n" ~ diff --git a/t/04-nativecall/04-pointers.c b/t/04-nativecall/04-pointers.c index fd72f7c7c12..7ca46a30f6d 100644 --- a/t/04-nativecall/04-pointers.c +++ b/t/04-nativecall/04-pointers.c @@ -33,3 +33,9 @@ DLLEXPORT void * TakeTwoPointersToInt(int *ptr1, int *ptr2) DLLEXPORT void * TakeCArrayToInt8(int array[]) { return NULL; } + +static int array[3] = {10, 20, 30}; +DLLEXPORT int * ReturnPointerToIntArray() +{ + return array; +} diff --git a/t/04-nativecall/04-pointers.t b/t/04-nativecall/04-pointers.t index 56d35cf97c1..6f49f8ba594 100644 --- a/t/04-nativecall/04-pointers.t +++ b/t/04-nativecall/04-pointers.t @@ -6,13 +6,14 @@ use NativeCall; use NativeCall::Types; use Test; -plan 12; +plan 17; compile_test_lib('04-pointers'); sub ReturnSomePointer() returns Pointer is native("./04-pointers") { * } sub CompareSomePointer(Pointer) returns int32 is native("./04-pointers") { * } sub ReturnNullPointer() returns Pointer is native("./04-pointers") { * } +sub ReturnPointerToIntArray() returns Pointer[int32] is native("./04-pointers") { * } my $x = ReturnSomePointer(); my int $a = 4321; @@ -28,6 +29,13 @@ is +Pointer.new(1234), 1234, 'Pointer.new(1234) has numerical value 1234'; is +Pointer.new($a), $a, 'Pointer.new accepts a native int too'; ok ReturnNullPointer() === Pointer, 'A returned NULL pointer is the Pointer type object itself'; +my $p = ReturnPointerToIntArray(); +is $p.deref, 10, 'typed pointer deref method'; +is $p[1], 20, 'typed pointer array dereference'; +is (++$p).deref, 20, 'typed pointer increment'; +is $p[0], 20, 'typed pointer incremented'; +is $p[1], 30, 'typed pointer incremented'; + { eval-lives-ok q:to 'CODE', 'Signature matching with Pointer[int32] works (RT #124321)'; use NativeCall; From 64b001a1464bf618fa4c0eed984e240fcf8b772b Mon Sep 17 00:00:00 2001 From: Aleks-Daniel Jakimenko-Aleksejev Date: Sun, 8 Oct 2017 01:43:01 +0300 Subject: [PATCH 368/692] Awesome error message for RT #127100 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit If you can do this: sub foo($x, --> 42) {} Then why not this? sub foo(--> 42, $x) {} Now it explicitly states that we only allow return consntraints at the end of the signature. Previously it was giving a generic (“Confused”-like) “Malformed return value” error. --- src/Perl6/Grammar.nqp | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/Perl6/Grammar.nqp b/src/Perl6/Grammar.nqp index 0ea2c189736..b1337b82209 100644 --- a/src/Perl6/Grammar.nqp +++ b/src/Perl6/Grammar.nqp @@ -2943,7 +2943,11 @@ grammar Perl6::Grammar is HLL::Grammar does STD { <.ws> [ ' | ')' | ']' | '{' | ':'\s | ';;' > || <.malformed('parameter')> ] { $*IN_DECL := ''; } - [ '-->' <.ws> [ || [|||] <.ws> + [ '-->' <.ws> [ || [|||] <.ws> + [ || + || ? <.parameter>> + <.malformed('return value (return constraints only allowed at the end of the signature)')> + ] || <.malformed('return value')> ] ]? { $*LEFTSIGIL := '@'; } From 93e599dbf2f764bc1ab4b66e9f4a6738081d6fb2 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 7 Oct 2017 23:44:12 +0000 Subject: [PATCH 369/692] Bump NQP --- tools/build/NQP_REVISION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/build/NQP_REVISION b/tools/build/NQP_REVISION index 4017ef5ea14..78abb3f4cbd 100644 --- a/tools/build/NQP_REVISION +++ b/tools/build/NQP_REVISION @@ -1 +1 @@ -2017.09-65-gc38cfe8 +2017.09-66-g943f7f7 From de0533c4d4c9f425ce22432a8e4555ded27cba91 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 7 Oct 2017 23:44:23 +0000 Subject: [PATCH 370/692] Update compiler usage message To incorporate renaming of `--force-stdin-eval-mode` command line opt to `--repl-mode` --- src/Perl6/Compiler.nqp | 26 +++++++++++++++----------- 1 file changed, 15 insertions(+), 11 deletions(-) diff --git a/src/Perl6/Compiler.nqp b/src/Perl6/Compiler.nqp index ab5ff2ab54e..611cf072803 100644 --- a/src/Perl6/Compiler.nqp +++ b/src/Perl6/Compiler.nqp @@ -84,10 +84,10 @@ class Perl6::Compiler is HLL::Compiler { method usage($name?, :$use-stderr = False) { my $print-func := $use-stderr ?? ¬e !! &say; # RT #130760 - $print-func(($name ?? $name !! "") ~ " [switches] [--] [programfile] [arguments] + $print-func(($name ?? $name !! "") ~ q♥ [switches] [--] [programfile] [arguments] -With no arguments, enters a REPL on TTY displays or evals STDIN on non-TTY. -With a \"[programfile]\" or the \"-e\" option, compiles the given program +With no arguments, enters a REPL (see --repl-mode option). +With a "[programfile]" or the "-e" option, compiles the given program and, by default, also executes the compiled code. -c check syntax only (runs BEGIN and CHECK blocks) @@ -95,7 +95,7 @@ and, by default, also executes the compiled code. -e program one line of program, strict is enabled by default -h, --help display this help text -n run program once for each line of input - -p same as -n, but also print \$_ at the end of lines + -p same as -n, but also print $_ at the end of lines -I path adds the path to the module search path -M module loads the module prior to running the program --target=stage specify compilation stage to emit @@ -117,18 +117,22 @@ and, by default, also executes the compiled code. any other extension outputs in HTML --doc=module use Pod::To::[module] to render inline documentation - --force-stdin-eval-mode=interactive|non-interactive - when running without -e or filename arguments, - do not rely on whether STDIN is a TTY and force the - eval of code from STDIN to be via REPL (interactive) - or without REPL (non-interactive) + --repl-mode=interactive|non-interactive + when running without "-e" or filename arguments, + a REPL is started. By default, if STDIN is a TTY, + "interactive" REPL is started that shows extra messages and + prompts, otherwise a "non-interactive" mode is used where + STDIN is read entirely and evaluated as if it were a program, + without any extra output (in fact, no REPL machinery is even + loaded). This option allows to bypass TTY detection and + force one of the REPL modes. Note that only boolean single-letter options may be bundled. To modify the include path, you can set the PERL6LIB environment variable: -PERL6LIB=\"lib\" perl6 example.pl -"); # end of usage statement +PERL6LIB="lib" perl6 example.pl +♥); # end of usage statement nqp::exit(0); From e0714904996e3c9efa88d5e44a48711f7d85ea31 Mon Sep 17 00:00:00 2001 From: Aleks-Daniel Jakimenko-Aleksejev Date: Sat, 7 Oct 2017 05:25:16 +0300 Subject: [PATCH 371/692] =?UTF-8?q?Mention=20corresponding=20starter=20in?= =?UTF-8?q?=20<,=20<<,=20=C2=AB=20subscripts?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Resolves part of RT #125641. Wordy descriptions were substituted with actual symbols to make it more consistent with other error messages. Also, this way the error message is much shorter. --- src/Perl6/Grammar.nqp | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Perl6/Grammar.nqp b/src/Perl6/Grammar.nqp index 96a806d44ac..213bc170199 100644 --- a/src/Perl6/Grammar.nqp +++ b/src/Perl6/Grammar.nqp @@ -4214,7 +4214,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD { || ", ['q', 'w', 'v']))> '>' || | ':' ] > { $/.panic("Whitespace required before < operator") } - || { $/.panic("Unable to parse quote-words subscript; couldn't find right angle quote") } + || { $/.panic("Unable to parse quote-words subscript; couldn't find '>' (corresponding '<' was at line {HLL::Compiler.lineof($/.orig(), $/.from())})") } ] } @@ -4224,7 +4224,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD { '<<' [ || >", ['qq', 'ww', 'v']))> '>>' - || { $/.panic("Unable to parse quote-words subscript; couldn't find right double-angle quote") } + || { $/.panic("Unable to parse quote-words subscript; couldn't find '>>' (corresponding '<<' was at line {HLL::Compiler.lineof($/.orig(), $/.from())})") } ] } @@ -4234,7 +4234,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD { '«' [ || '»' - || { $/.panic("Unable to parse quote-words subscript; couldn't find right double-angle quote") } + || { $/.panic("Unable to parse quote-words subscript; couldn't find '»' (corresponding '«' was at line {HLL::Compiler.lineof($/.orig(), $/.from())})") } ] } From 3ede49cd7ab257a0f9dccebb24fa4f965336147c Mon Sep 17 00:00:00 2001 From: Aleks-Daniel Jakimenko-Aleksejev Date: Sat, 7 Oct 2017 05:28:48 +0300 Subject: [PATCH 372/692] Mention corresponding starter for most of the things This should handle quotes, parens, brackets, subscripts and many other things. Resolves part of RT #125641. Unfortunately I don't know how to print the actual starter, but as long as the line number is mentioned it's alright. --- src/Perl6/Grammar.nqp | 3 ++- src/core/Exception.pm | 4 +++- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/src/Perl6/Grammar.nqp b/src/Perl6/Grammar.nqp index 213bc170199..d2807a8d8cc 100644 --- a/src/Perl6/Grammar.nqp +++ b/src/Perl6/Grammar.nqp @@ -255,7 +255,8 @@ role STD { $stopper := $stopper // $goal; $stopper := $stopper ~~ /(.*\S)\s*/; $stopper := ~$stopper[0]; - self.typed_panic('X::Comp::FailGoal', :$dba, :goal($stopper)); + self.typed_panic('X::Comp::FailGoal', :$dba, :goal($stopper), + :line-real(HLL::Compiler.lineof(self.orig(), self.from()))); } method panic(*@args) { diff --git a/src/core/Exception.pm b/src/core/Exception.pm index 2ef0c26ec60..a0e1eea05d7 100644 --- a/src/core/Exception.pm +++ b/src/core/Exception.pm @@ -766,10 +766,12 @@ my class X::Comp::AdHoc is X::AdHoc does X::Comp { my class X::Comp::FailGoal does X::Comp { has $.dba; has $.goal; + has $.line-real; method is-compile-time(--> True) { } - method message { "Unable to parse expression in $.dba; couldn't find final $.goal" } + method message { "Unable to parse expression in $.dba; couldn't find final $.goal" + ~ " (corresponding starter was at line $.line-real)" } } my role X::Syntax does X::Comp { } From 640d38570d87b73315b97a9fc65c6150b470d7c5 Mon Sep 17 00:00:00 2001 From: Aleks-Daniel Jakimenko-Aleksejev Date: Sat, 7 Oct 2017 05:59:06 +0300 Subject: [PATCH 373/692] Cache some line numbers MasterDuke++ https://irclog.perlgeek.de/perl6-dev/2017-10-07#i_15269029 --- src/Perl6/Grammar.nqp | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/src/Perl6/Grammar.nqp b/src/Perl6/Grammar.nqp index d2807a8d8cc..8a1c851cbfd 100644 --- a/src/Perl6/Grammar.nqp +++ b/src/Perl6/Grammar.nqp @@ -222,7 +222,7 @@ role STD { { my $B := $.ast; $lang := $B[0]; $start := $B[1]; $stop := $B[2]; } - $start [ $stop || { $/.typed_panic('X::Comp::AdHoc', payload => "Couldn't find terminator $stop (corresponding $start was at line {HLL::Compiler.lineof($.orig(), $.from())})", expected => [$stop] ) } ] + $start [ $stop || { $/.typed_panic('X::Comp::AdHoc', payload => "Couldn't find terminator $stop (corresponding $start was at line {HLL::Compiler.lineof($.orig(), $.from(), :cache(1))})", expected => [$stop] ) } ] { nqp::can($lang, 'herelang') && self.queue_heredoc( @@ -256,7 +256,8 @@ role STD { $stopper := $stopper ~~ /(.*\S)\s*/; $stopper := ~$stopper[0]; self.typed_panic('X::Comp::FailGoal', :$dba, :goal($stopper), - :line-real(HLL::Compiler.lineof(self.orig(), self.from()))); + :line-real(HLL::Compiler.lineof(self.orig(), self.from(), + :cache(1)))); } method panic(*@args) { @@ -4215,7 +4216,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD { || ", ['q', 'w', 'v']))> '>' || | ':' ] > { $/.panic("Whitespace required before < operator") } - || { $/.panic("Unable to parse quote-words subscript; couldn't find '>' (corresponding '<' was at line {HLL::Compiler.lineof($/.orig(), $/.from())})") } + || { $/.panic("Unable to parse quote-words subscript; couldn't find '>' (corresponding '<' was at line {HLL::Compiler.lineof($/.orig(), $/.from(), :cache(1))})") } ] } @@ -4225,7 +4226,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD { '<<' [ || >", ['qq', 'ww', 'v']))> '>>' - || { $/.panic("Unable to parse quote-words subscript; couldn't find '>>' (corresponding '<<' was at line {HLL::Compiler.lineof($/.orig(), $/.from())})") } + || { $/.panic("Unable to parse quote-words subscript; couldn't find '>>' (corresponding '<<' was at line {HLL::Compiler.lineof($/.orig(), $/.from(), :cache(1))})") } ] } @@ -4235,7 +4236,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD { '«' [ || '»' - || { $/.panic("Unable to parse quote-words subscript; couldn't find '»' (corresponding '«' was at line {HLL::Compiler.lineof($/.orig(), $/.from())})") } + || { $/.panic("Unable to parse quote-words subscript; couldn't find '»' (corresponding '«' was at line {HLL::Compiler.lineof($/.orig(), $/.from(), :cache(1))})") } ] } From aa354ad774f4a0633fc8b1e364883570bf956d3d Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 7 Oct 2017 10:14:06 -0400 Subject: [PATCH 374/692] Fix precedence error; RabidGravy++ --- lib/NativeCall.pm6 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/NativeCall.pm6 b/lib/NativeCall.pm6 index 6ccd6d2d905..ddbf7304f6f 100644 --- a/lib/NativeCall.pm6 +++ b/lib/NativeCall.pm6 @@ -334,7 +334,7 @@ our role Native[Routine $r, $libname where Str|Callable|List|IO::Path|Distributi my @deconts; my @params; for $r.signature.params { - next if nqp::istype($r, Method) && $_.name // '' eq '%_'; + next if nqp::istype($r, Method) && ($_.name // '') eq '%_'; my $name = $_.name || '__anonymous_param__' ~ $++; my $lowered_param_name = '__lowered_param__' ~ $locals; my $lowered_name = '__lowered__' ~ $locals++; From 77bb7e2196b88897ed04847f7ded5abe503240ed Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 7 Oct 2017 10:52:42 -0400 Subject: [PATCH 375/692] Fix precedence error; RabidGravy++ --- lib/NativeCall.pm6 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/NativeCall.pm6 b/lib/NativeCall.pm6 index ddbf7304f6f..5497b5b71e9 100644 --- a/lib/NativeCall.pm6 +++ b/lib/NativeCall.pm6 @@ -397,7 +397,7 @@ our role Native[Routine $r, $libname where Str|Callable|List|IO::Path|Distributi my $arglist := QAST::Op.new(:op); my $locals = 0; for $r.signature.params { - next if nqp::istype($r, Method) && $_.name // '' eq '%_'; + next if nqp::istype($r, Method) && ($_.name // '') eq '%_'; my $name = $_.name || '__anonymous_param__' ~ $++; my $decont = self!decont-for-type($_.type); if $_.rw and nqp::objprimspec($_.type) > 0 { From 106531dd4a4d4cd3247b052c1215c50f9a869a9b Mon Sep 17 00:00:00 2001 From: Timo Paulssen Date: Sat, 7 Oct 2017 18:08:44 +0200 Subject: [PATCH 376/692] use nqp::codes op to speed up Int not a vast improvement, but having one allocation less is a nice bonus. --- src/core/Str.pm | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) diff --git a/src/core/Str.pm b/src/core/Str.pm index f7492739d32..3ef48f459ff 100644 --- a/src/core/Str.pm +++ b/src/core/Str.pm @@ -55,13 +55,7 @@ my class Str does Stringy { # declared in BOOTSTRAP # Compare Str.chars == Str.codes to filter out any combining characters && nqp::iseq_i( nqp::chars($!value), - nqp::elems( - nqp::strtocodes( - $!value, - nqp::const::NORMALIZE_NFC, - nqp::create(NFC), - ) - ), + nqp::codes($!value) ) #?endif #?if jvm From e93d75e58d6a8256c938f0444887d30d6f4d4d42 Mon Sep 17 00:00:00 2001 From: Jonathan Stowe Date: Sat, 7 Oct 2017 17:18:44 +0100 Subject: [PATCH 377/692] Add tests to cover a common NC usage C functions that consistently take some struct or pointer as the first argument are declared as methods of that CStruct or CPointer --- t/04-nativecall/22-method.c | 25 +++++++++++++++++++++++++ t/04-nativecall/22-method.t | 29 +++++++++++++++++++++++++++++ 2 files changed, 54 insertions(+) create mode 100644 t/04-nativecall/22-method.c create mode 100644 t/04-nativecall/22-method.t diff --git a/t/04-nativecall/22-method.c b/t/04-nativecall/22-method.c new file mode 100644 index 00000000000..cf86e636f31 --- /dev/null +++ b/t/04-nativecall/22-method.c @@ -0,0 +1,25 @@ +#include +#include +#include + +#ifdef _WIN32 +#define DLLEXPORT __declspec(dllexport) +#else +#define DLLEXPORT extern +#endif + +typedef struct { + long intval; +} MyStruct; + +DLLEXPORT MyStruct *ReturnAStruct(long intval) +{ + MyStruct *obj = (MyStruct *) malloc(sizeof(MyStruct)); + obj->intval = intval; + return obj; +} + +DLLEXPORT long Add(MyStruct *obj, long intval) +{ + return obj->intval + intval; +} diff --git a/t/04-nativecall/22-method.t b/t/04-nativecall/22-method.t new file mode 100644 index 00000000000..68929256b9e --- /dev/null +++ b/t/04-nativecall/22-method.t @@ -0,0 +1,29 @@ +use v6; + +use lib ; +use CompileTestLib; +use NativeCall; +use Test; + +plan 2; + +compile_test_lib('22-method'); + +class MyStruct is repr('CStruct') { + has long $.long; + + sub ReturnAStruct(long $intval --> MyStruct) is native('./22-method') { * } + method new(Int :$intval) { + ReturnAStruct($intval) + } + method Add(long $intval --> long) is native('./22-method') { * } +} + +my $a = MyStruct.new(intval => 42); + +my $res; + +lives-ok { $res = $a.Add(2) }, "native sub as method"; +is $res, 44, "and got the result we expected"; + +# vim:ft=perl6 From a1beb79b6c2b01aedddb2eb043db52063d0a2fc0 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 7 Oct 2017 16:45:49 +0000 Subject: [PATCH 378/692] Bump NQP --- tools/build/NQP_REVISION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/build/NQP_REVISION b/tools/build/NQP_REVISION index 46fb0479d8f..4017ef5ea14 100644 --- a/tools/build/NQP_REVISION +++ b/tools/build/NQP_REVISION @@ -1 +1 @@ -2017.09-59-g60f79d3 +2017.09-65-gc38cfe8 From 2b3fc84c8111bb563ab4dc6b5c8cca86d116d75e Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 7 Oct 2017 16:54:31 +0000 Subject: [PATCH 379/692] Update compiler usage message for STDIN eval Since recently-ish, if STDIN is not a TTY, we've treated STDIN as simply a file with code to eval, without starting REPL. --- src/Perl6/Compiler.nqp | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Perl6/Compiler.nqp b/src/Perl6/Compiler.nqp index d75b03b2e4c..9b8c9c3d9da 100644 --- a/src/Perl6/Compiler.nqp +++ b/src/Perl6/Compiler.nqp @@ -86,9 +86,9 @@ class Perl6::Compiler is HLL::Compiler { my $print-func := $use-stderr ?? ¬e !! &say; # RT #130760 $print-func(($name ?? $name !! "") ~ " [switches] [--] [programfile] [arguments] -With no arguments, enters a REPL. With a \"[programfile]\" or the \"-e\" -option, compiles the given program and, by default, also executes the -compiled code. +With no arguments, enters a REPL on TTY displays or evals STDIN on non-TTY. +With a \"[programfile]\" or the \"-e\" option, compiles the given program +and, by default, also executes the compiled code. -c check syntax only (runs BEGIN and CHECK blocks) --doc extract documentation and print it as text From c6b3ea96d94a939b1ac4b04349212c59eb6e1fd2 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 7 Oct 2017 17:04:02 +0000 Subject: [PATCH 380/692] Add --force-stdin-eval-mode opt to usage msg --- src/Perl6/Compiler.nqp | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/Perl6/Compiler.nqp b/src/Perl6/Compiler.nqp index 9b8c9c3d9da..ab5ff2ab54e 100644 --- a/src/Perl6/Compiler.nqp +++ b/src/Perl6/Compiler.nqp @@ -117,6 +117,11 @@ and, by default, also executes the compiled code. any other extension outputs in HTML --doc=module use Pod::To::[module] to render inline documentation + --force-stdin-eval-mode=interactive|non-interactive + when running without -e or filename arguments, + do not rely on whether STDIN is a TTY and force the + eval of code from STDIN to be via REPL (interactive) + or without REPL (non-interactive) Note that only boolean single-letter options may be bundled. From 2dd80c7b0e13b2c876e5a1b30143965f79466491 Mon Sep 17 00:00:00 2001 From: TimToady Date: Sat, 7 Oct 2017 12:31:08 -0700 Subject: [PATCH 381/692] deconfuse statement modifier errors Catch missing expressions on statement modifiers earlier so that the tests eat_terminator are only for statement controls. Also, move the cursor to the front of the cursor controls to indicate where the semicolon is actually perceived to be missing if we report that. Additionally, we change the kok check to use .panic instead of .sorry to avoid multiple errors resulting from repeated terminator checks that use statement modifier keywords for terminators. Fixes #125596 and #125674. --- src/Perl6/Grammar.nqp | 31 ++++++++++++++++++------------- 1 file changed, 18 insertions(+), 13 deletions(-) diff --git a/src/Perl6/Grammar.nqp b/src/Perl6/Grammar.nqp index 8a1c851cbfd..1155ddd5f8f 100644 --- a/src/Perl6/Grammar.nqp +++ b/src/Perl6/Grammar.nqp @@ -604,7 +604,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD { my $n := nqp::substr(self.orig, self.from, self.pos - self.from); $*W.is_name([$n]) || $*W.is_name(['&' ~ $n]) ?? False - !! self.sorry("Whitespace required after keyword '$n'") + !! self.panic("Whitespace required after keyword '$n'") }> ] } @@ -1331,7 +1331,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD { || || $ || - || { self.typed_panic( 'X::Syntax::Confused', reason => "Missing semicolon" ) } + || { $/.'!clear_highwater'(); self.typed_panic( 'X::Syntax::Confused', reason => "Missing semicolon" ) } || { $/.typed_panic( 'X::Syntax::Confused', reason => "Confused" ) } } @@ -1773,21 +1773,26 @@ grammar Perl6::Grammar is HLL::Grammar does STD { proto rule statement_mod_cond { <...> } - token modifier_expr { } - token smexpr { } + method nomodexpr($k) { + self.'!clear_highwater'(); + self.typed_panic( 'X::Syntax::Confused', reason => "Missing expression for '$k' statement modifier" ); + self; + } + token modifier_expr($k) { || <.nomodexpr($k)> } + token smexpr($k) { || <.nomodexpr($k)> } - rule statement_mod_cond:sym { <.kok> } - rule statement_mod_cond:sym { <.kok> } - rule statement_mod_cond:sym { <.kok> } - rule statement_mod_cond:sym { <.kok> } - rule statement_mod_cond:sym{ <.kok> } + rule statement_mod_cond:sym { <.kok> } + rule statement_mod_cond:sym { <.kok> } + rule statement_mod_cond:sym { <.kok> } + rule statement_mod_cond:sym { <.kok> } + rule statement_mod_cond:sym{ <.kok> } proto rule statement_mod_loop { <...> } - rule statement_mod_loop:sym { <.kok> } - rule statement_mod_loop:sym { <.kok> } - rule statement_mod_loop:sym { <.kok> } - rule statement_mod_loop:sym { <.kok> } + rule statement_mod_loop:sym { <.kok> } + rule statement_mod_loop:sym { <.kok> } + rule statement_mod_loop:sym { <.kok> } + rule statement_mod_loop:sym { <.kok> } ## Terms From 0f19e6f95d6ec67c0806f56929b48eb3f8e36918 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sat, 7 Oct 2017 22:13:00 +0200 Subject: [PATCH 382/692] Cache types we always need in the CompilerServices - this appears to make the setting compilation a bit faster - but getting timings on that is always difficult :-( --- src/Perl6/World.nqp | 94 ++++++++++++++++++++------------------- src/core/core_prologue.pm | 10 +++-- 2 files changed, 56 insertions(+), 48 deletions(-) diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index 3959ed388c8..ca90337b688 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -2972,6 +2972,14 @@ class Perl6::World is HLL::World { # The generic BUILDALL method for empty BUILDPLANs has $!empty_buildplan_method; + # Types we always need + has $!Block; + has $!DefiniteHOW; + has $!Failure; + has $!List; + has $!Map; + has $!X-Attribute-Required; + # Parameters we always need my $pself := QAST::Var.new(:decl, :scope, :name); my $pauto := QAST::Var.new(:decl, :scope, :name<@auto>); @@ -3038,8 +3046,8 @@ class Perl6::World is HLL::World { $!w.cur_lexpad()[0].push($block); # Find/Create the type of the invocant - my $invocant_type := $!w.create_definite_type( - $!w.find_symbol(['Metamodel','DefiniteHOW']), $package_type, 1 ); + my $invocant_type := + $!w.create_definite_type($!DefiniteHOW, $package_type, 1); # Seen accessors of this class before, so use existing signature my $sig; @@ -3082,11 +3090,8 @@ class Perl6::World is HLL::World { method generate_buildplan_executor($/, $in_object, $in_build_plan) { # low level hash access - my $build_plan := nqp::getattr( - nqp::decont($in_build_plan), - $!w.find_symbol(['List']), - '$!reified' - ); + my $build_plan := + nqp::getattr(nqp::decont($in_build_plan), $!List, '$!reified'); if nqp::elems($build_plan) -> $count { @@ -3113,11 +3118,8 @@ class Perl6::World is HLL::World { $!w.cur_lexpad()[0].push($block); # Create the invocant type we need - my $invocant_type := $!w.create_definite_type( - $!w.find_symbol(['Metamodel','DefiniteHOW']), - $object, - 1 - ); + my $invocant_type := + $!w.create_definite_type($!DefiniteHOW, $object, 1); # Debugging # $stmts.push( @@ -3137,9 +3139,7 @@ class Perl6::World is HLL::World { $stmts.push(QAST::Op.new( :op, $init, QAST::Op.new( :op, - $hllinit, - QAST::WVal.new( :value($!w.find_symbol(['Map'])) ), - $storage + $hllinit, QAST::WVal.new( :value($!Map) ), $storage ) )); @@ -3251,9 +3251,8 @@ class Perl6::World is HLL::World { ); my $initializer := nqp::istype( - nqp::atpos($task,3), - $!w.find_symbol(['Block']) -# $code(self,nqp::getattr(self,Foo,'$!a'))) + nqp::atpos($task,3),$!Block +# $code(self,nqp::getattr(self,Foo,'$!a')) ) ?? QAST::Op.new( :op, QAST::WVal.new(:value(nqp::atpos($task,3))), $self, $getattr @@ -3312,10 +3311,7 @@ class Perl6::World is HLL::World { QAST::Op.new( :op('bindattr' ~ @psp[$code - 4]), $self, $class, $attr, nqp::if( - nqp::istype( - nqp::atpos($task,3), - $!w.find_symbol(['Block']) - ), + nqp::istype(nqp::atpos($task,3),$!Block), QAST::Op.new( :op, QAST::WVal.new(:value(nqp::atpos($task,3))), $self, @@ -3350,10 +3346,7 @@ class Perl6::World is HLL::World { QAST::Op.new( :op, $self, $class, $attr, nqp::if( - nqp::istype( - nqp::atpos($task,3), - $!w.find_symbol(['Block']) - ), + nqp::istype(nqp::atpos($task,3),$!Block), QAST::Op.new( :op, QAST::WVal.new(:value(nqp::atpos($task,3))), $self, @@ -3382,17 +3375,12 @@ class Perl6::World is HLL::World { ), QAST::Op.new( :op, :name, QAST::Op.new( :op, :name, - QAST::WVal.new( :value( - $!w.find_symbol( - ['X','Attribute','Required'] - ) - )), + QAST::WVal.new( + :value($!X-Attribute-Required)), QAST::SVal.new( :named('name'), - :value(nqp::atpos($task,2)) - ), + :value(nqp::atpos($task,2))), QAST::WVal.new( :named('why'), - :value(nqp::atpos($task,3)) - ) + :value(nqp::atpos($task,3))) ) ) ) @@ -3465,14 +3453,11 @@ class Perl6::World is HLL::World { ) ) ), - QAST::WVal.new( - :value($!w.find_symbol(['Failure'])) - ), + QAST::WVal.new(:value($!Failure)), ), QAST::Op.new( :op, QAST::WVal.new( - :value($!w.find_symbol(['&return'])) - ), + :value($!w.find_symbol(['&return']))), QAST::Var.new(:scope, :name) ) ) @@ -3525,10 +3510,7 @@ class Perl6::World is HLL::World { $!w.cur_lexpad()[0].push($block); my $invocant_type := $!w.create_definite_type( - $!w.find_symbol(['Metamodel','DefiniteHOW']), - $!w.find_symbol(['Any']), - 1 - ); + $!DefiniteHOW, $!w.find_symbol(['Any']), 1); my $sig := $!w.create_signature_and_params( NQPMu, %sig_init, $block, 'Any', :method, :$invocant_type @@ -3542,20 +3524,42 @@ class Perl6::World is HLL::World { } method get_compiler_services($/) { + + # Already have a CompilerServices object if nqp::isconcrete($!compiler_services) { + + # Update $/ for error reporting on generated methods nqp::bindattr( $!compiler_services,$!compiler_services.WHAT,'$!current-match',$/ ); } + + # Don't have a CompilerServices object yet else { try { + + # Find the HLL version, might fail early in setting compilation my $wtype := self.find_symbol(['Rakudo','Internals','CompilerServices']); - my $wrapped := CompilerServices.new(w => self); my $wrapper := nqp::create($wtype); + + # Set up the base object + my $wrapped := CompilerServices.new( + w => self, + Block => self.find_symbol(['Block']), + DefiniteHOW => self.find_symbol(['Metamodel','DefiniteHOW']), + Failure => self.find_symbol(['Failure']), + List => self.find_symbol(['List']), + Map => self.find_symbol(['Map']), + X-Attribute-Required => + self.find_symbol(['X','Attribute','Required']) + ); nqp::bindattr($wrapper, $wtype, '$!compiler', $wrapped); nqp::bindattr($wrapper, $wtype, '$!current-match', $/); + + # When we got here, we really got a full CompilerServices object $!compiler_services := $wrapper; + } } $!compiler_services diff --git a/src/core/core_prologue.pm b/src/core/core_prologue.pm index e7fb1c76987..f76abe09bed 100644 --- a/src/core/core_prologue.pm +++ b/src/core/core_prologue.pm @@ -1,14 +1,18 @@ # Stub a few things the compiler wants to have really early on. -my class Pair { ... } -my class Whatever { ... } +my class Pair { ... } # must be first for some reason +my class Block { ... } my class HyperWhatever { ... } -my class WhateverCode { ... } +my class List { ... } +my class Map { ... } my class Match { ... } my class Failure { ... } my class Rakudo::Internals { ... } my class Rakudo::Internals::JSON { ... } my class Rakudo::Iterator { ... } my class ThreadPoolScheduler { ... } +my class Whatever { ... } +my class WhateverCode { ... } +my class X::Attribute::Required { ... } my class X::Numeric::Overflow { ... } my class X::Numeric::Underflow { ... } From 598fd9a763143b867c86471374e608f230d34caa Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sat, 7 Oct 2017 22:32:52 +0200 Subject: [PATCH 383/692] Set up Builtin encodings at setting compile time - so we don't need to do this each time on startup - only saves maybe 1 msec of startup - but it makes future optimizations opening STDIN/OUT/ERR easier --- src/core/Encoding/Builtin.pm | 47 +---------------------------------- src/core/Encoding/Registry.pm | 28 ++++++++++++++++++++- tools/build/jvm_core_sources | 2 +- tools/build/moar_core_sources | 2 +- 4 files changed, 30 insertions(+), 49 deletions(-) diff --git a/src/core/Encoding/Builtin.pm b/src/core/Encoding/Builtin.pm index 1bf52fac428..00008de1268 100644 --- a/src/core/Encoding/Builtin.pm +++ b/src/core/Encoding/Builtin.pm @@ -43,49 +43,4 @@ class Encoding::Builtin does Encoding { } } -Encoding::Registry.register( - BEGIN nqp::create(Encoding::Builtin).SET-SELF( - "utf8", nqp::list("utf-8") - ) -); -Encoding::Registry.register( - BEGIN nqp::create(Encoding::Builtin).SET-SELF( - "utf8-c8", nqp::list("utf-8-c8") - ) -); -Encoding::Registry.register( - BEGIN nqp::create(Encoding::Builtin).SET-SELF( - "ascii", nqp::list - ) -); -Encoding::Registry.register( - BEGIN nqp::create(Encoding::Builtin).SET-SELF( - "iso-8859-1", - nqp::list( - "iso_8859-1:1987", - "iso_8859-1", - "iso-ir-100", - "latin1", - "latin-1", - "csisolatin1:", - "l1", - "ibm819", - "cp819" - ) - ) -); -Encoding::Registry.register( - BEGIN nqp::create(Encoding::Builtin).SET-SELF( - "windows-1252", nqp::list - ) -); -Encoding::Registry.register( - BEGIN nqp::create(Encoding::Builtin).SET-SELF( - "utf16", nqp::list("utf-16") - ) -); -Encoding::Registry.register( - BEGIN nqp::create(Encoding::Builtin).SET-SELF( - "utf32", nqp::list("utf-32") - ) -); +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Encoding/Registry.pm b/src/core/Encoding/Registry.pm index e71d5cfedef..4ef21c22054 100644 --- a/src/core/Encoding/Registry.pm +++ b/src/core/Encoding/Registry.pm @@ -3,7 +3,33 @@ my class X::Encoding::AlreadyRegistered { ... } my class Encoding::Registry { my $lock := Lock.new; - my $lookup := nqp::hash; + my %lookup; # access for registering builtins at compile time + my $lookup := nqp::getattr(%lookup,Map,'$!storage'); # access for runtime + + BEGIN { + my $lookup := nqp::bindattr(%lookup,Map,'$!storage',nqp::hash); + my $encodings := nqp::list( + nqp::list("ascii"), + nqp::list("iso-8859-1","iso_8859-1:1987","iso_8859-1","iso-ir-100", + "latin1","latin-1","csisolatin1","l1","ibm819","cp819"), + nqp::list("utf8","utf-8"), + nqp::list("utf8-c8","utf-8-c8"), + nqp::list("utf16","utf-16"), + nqp::list("utf32","utf-32"), + nqp::list("windows-1252") + ); + my int $i = -1; + my int $elems = nqp::elems($encodings); + while nqp::islt_i(($i = nqp::add_i($i,1)),$elems) { + my $names := nqp::atpos($encodings,$i); + my $builtin := nqp::create(Encoding::Builtin).SET-SELF( + nqp::shift($names),nqp::clone($names)); + nqp::bindkey($lookup,$builtin.name,$builtin); + while nqp::elems($names) { + nqp::bindkey($lookup,nqp::shift($names),$builtin); + } + } + } method register(Encoding $enc --> Nil) { $lock.protect: { diff --git a/tools/build/jvm_core_sources b/tools/build/jvm_core_sources index 8423d23797f..36499c38d66 100644 --- a/tools/build/jvm_core_sources +++ b/tools/build/jvm_core_sources @@ -50,8 +50,8 @@ src/core/Encoding/Encoder.pm src/core/Encoding/Encoder/Builtin.pm src/core/Encoding/Encoder/TranslateNewlineWrapper.pm src/core/Encoding.pm -src/core/Encoding/Registry.pm src/core/Encoding/Builtin.pm +src/core/Encoding/Registry.pm src/core/Str.pm src/core/Capture.pm src/core/IterationBuffer.pm diff --git a/tools/build/moar_core_sources b/tools/build/moar_core_sources index 87d148c9226..693dbcaa0e0 100644 --- a/tools/build/moar_core_sources +++ b/tools/build/moar_core_sources @@ -52,8 +52,8 @@ src/core/Encoding/Encoder.pm src/core/Encoding/Encoder/Builtin.pm src/core/Encoding/Encoder/TranslateNewlineWrapper.pm src/core/Encoding.pm -src/core/Encoding/Registry.pm src/core/Encoding/Builtin.pm +src/core/Encoding/Registry.pm src/core/Str.pm src/core/Capture.pm src/core/IterationBuffer.pm From baf8561ed64119dd5f9cb7e3585d172079e9b48b Mon Sep 17 00:00:00 2001 From: usev6 Date: Tue, 13 Dec 2016 22:30:19 +0100 Subject: [PATCH 384/692] Try harder to diagnose problem instead of reporting 'Malformed my' Fixes RT #125902 --- src/Perl6/Grammar.nqp | 18 ++++++++++++++++-- 1 file changed, 16 insertions(+), 2 deletions(-) diff --git a/src/Perl6/Grammar.nqp b/src/Perl6/Grammar.nqp index 1155ddd5f8f..c035e9e09f0 100644 --- a/src/Perl6/Grammar.nqp +++ b/src/Perl6/Grammar.nqp @@ -2618,8 +2618,22 @@ grammar Perl6::Grammar is HLL::Grammar does STD { | ] - || <.ws>[<.ws>]* [':'?':'?'=' | <.terminator> | $ ]> {} - <.malformed("$*SCOPE (did you mean to declare a sigilless \\{~$} or \${~$}?)")> + || <.ws>[<.ws>]* + + [ + | ':'?':'?'=' + | <.terminator> + | + | "where" <.ws> + | $ + ] + > {} <.malformed("$*SCOPE (did you mean to declare a sigilless \\{~$} or \${~$}?)")> + || <.ws><.ws> > {} + <.malformed("$*SCOPE (found type followed by constraint; did you forget a variable in between?)")> + || <.ws><.ws> > {} + <.malformed("$*SCOPE (found type followed by trait; did you forget a variable in between?)")> + || <.ws><.ws> | $ ]> {} + <.malformed("$*SCOPE (did you forget a variable after type?)")> || <.ws> || <.malformed($*SCOPE)> ] From 1ed21c233cea9e9b87cef3a7b7c8e55ec98f4959 Mon Sep 17 00:00:00 2001 From: Aleks-Daniel Jakimenko-Aleksejev Date: Sun, 8 Oct 2017 00:55:29 +0300 Subject: [PATCH 385/692] Fix complaints about existing types MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Call typo_typename only if or failed, not if something else went wrong. Resolves ½ of RT #127100. --- src/Perl6/Grammar.nqp | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Perl6/Grammar.nqp b/src/Perl6/Grammar.nqp index c035e9e09f0..0ea2c189736 100644 --- a/src/Perl6/Grammar.nqp +++ b/src/Perl6/Grammar.nqp @@ -2943,7 +2943,9 @@ grammar Perl6::Grammar is HLL::Grammar does STD { <.ws> [ ' | ')' | ']' | '{' | ':'\s | ';;' > || <.malformed('parameter')> ] { $*IN_DECL := ''; } - [ '-->' <.ws> [[|] <.ws> || || <.malformed('return value')>] ]? + [ '-->' <.ws> [ || [|||] <.ws> + || <.malformed('return value')> + ] ]? { $*LEFTSIGIL := '@'; } } From ff5e9c604dcee104a048888605b4f31866ed2801 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sun, 8 Oct 2017 00:08:41 +0200 Subject: [PATCH 386/692] Streamline initialization of $*IN/$*OUT/$*ERR - do as much as possible during setting compilation - only plug in the handle/encoder/decoder at runtime - shaves off about 1.5% from bare startup time --- src/core/io_operators.pm | 52 +++++++++++++++++++++++++++++++++++----- 1 file changed, 46 insertions(+), 6 deletions(-) diff --git a/src/core/io_operators.pm b/src/core/io_operators.pm index e1669f75d9d..c1d34e1ced4 100644 --- a/src/core/io_operators.pm +++ b/src/core/io_operators.pm @@ -164,12 +164,52 @@ multi sub indir(IO() $path, &what, :$d = True, :$r, :$w, :$x) { } } -PROCESS::<$IN> = - IO::Handle.new(:path(IO::Special.new(''))).open; -PROCESS::<$OUT> = - IO::Handle.new(:path(IO::Special.new(''))).open; -PROCESS::<$ERR> = - IO::Handle.new(:path(IO::Special.new(''))).open; +# Set up the standard STDIN/STDOUT/STDERR by first setting up the skeletons +# of the IO::Handle objects that can be setup at compile time. Then, when +# running the mainline of the setting at startup, plug in the low level +# handles and set up the encoder and decoders. This shaves off about 1.5% +# of bare startup. +{ + my constant NL-IN = ["\x0A", "\r\n"]; + my constant NL-OUT = "\n"; + my constant ENCODING = "utf8"; + + my sub setup-handle(str $what) { + my $handle := nqp::p6bindattrinvres( + nqp::create(IO::Handle),IO::Handle,'$!path',nqp::p6bindattrinvres( + nqp::create(IO::Special),IO::Special,'$!what',$what + ) + ); + nqp::getattr($handle,IO::Handle,'$!chomp') = True; + nqp::getattr($handle,IO::Handle,'$!nl-in') = NL-IN; + nqp::getattr($handle,IO::Handle,'$!nl-out') = NL-OUT; + nqp::getattr($handle,IO::Handle,'$!encoding') = ENCODING; + $handle + } + + # Set up the skeletons at compile time + my constant STDIN = setup-handle(''); + my constant STDOUT = setup-handle(''); + my constant STDERR = setup-handle(''); + + my sub activate-handle(Mu \HANDLE, Mu \PIO) { + nqp::setbuffersizefh(PIO,8192) unless nqp::isttyfh(PIO); + + my $encoding = Encoding::Registry.find(ENCODING); + nqp::bindattr( + HANDLE,IO::Handle,'$!decoder',$encoding.decoder(:translate-nl) + ).set-line-separators(NL-IN); + nqp::bindattr( + HANDLE,IO::Handle,'$!encoder',$encoding.encoder(:translate-nl) + ); + nqp::p6bindattrinvres(HANDLE,IO::Handle,'$!PIO',PIO) + } + + # Activate the skeletons at runtime + PROCESS::<$IN> = activate-handle(STDIN, nqp::getstdin); + PROCESS::<$OUT> = activate-handle(STDOUT, nqp::getstdout); + PROCESS::<$ERR> = activate-handle(STDERR, nqp::getstderr); +} sub chmod($mode, *@filenames) { my @ok; From c8320e18a569aff9a04c8d26e5ffcbede8b080fc Mon Sep 17 00:00:00 2001 From: Aleks-Daniel Jakimenko-Aleksejev Date: Sun, 8 Oct 2017 01:43:01 +0300 Subject: [PATCH 387/692] Awesome error message for RT #127100 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit If you can do this: sub foo($x, --> 42) {} Then why not this? sub foo(--> 42, $x) {} Now it explicitly states that we only allow return consntraints at the end of the signature. Previously it was giving a generic (“Confused”-like) “Malformed return value” error. --- src/Perl6/Grammar.nqp | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/Perl6/Grammar.nqp b/src/Perl6/Grammar.nqp index 0ea2c189736..b1337b82209 100644 --- a/src/Perl6/Grammar.nqp +++ b/src/Perl6/Grammar.nqp @@ -2943,7 +2943,11 @@ grammar Perl6::Grammar is HLL::Grammar does STD { <.ws> [ ' | ')' | ']' | '{' | ':'\s | ';;' > || <.malformed('parameter')> ] { $*IN_DECL := ''; } - [ '-->' <.ws> [ || [|||] <.ws> + [ '-->' <.ws> [ || [|||] <.ws> + [ || + || ? <.parameter>> + <.malformed('return value (return constraints only allowed at the end of the signature)')> + ] || <.malformed('return value')> ] ]? { $*LEFTSIGIL := '@'; } From d3b1cdbf9ec67cd53cc2437a77e0c9ee988791d4 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 7 Oct 2017 23:44:12 +0000 Subject: [PATCH 388/692] Bump NQP --- tools/build/NQP_REVISION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/build/NQP_REVISION b/tools/build/NQP_REVISION index 4017ef5ea14..78abb3f4cbd 100644 --- a/tools/build/NQP_REVISION +++ b/tools/build/NQP_REVISION @@ -1 +1 @@ -2017.09-65-gc38cfe8 +2017.09-66-g943f7f7 From 87dc51f5147e9f9cf76fc46305d9490d91e022c6 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 7 Oct 2017 23:44:23 +0000 Subject: [PATCH 389/692] Update compiler usage message To incorporate renaming of `--force-stdin-eval-mode` command line opt to `--repl-mode` --- src/Perl6/Compiler.nqp | 26 +++++++++++++++----------- 1 file changed, 15 insertions(+), 11 deletions(-) diff --git a/src/Perl6/Compiler.nqp b/src/Perl6/Compiler.nqp index ab5ff2ab54e..611cf072803 100644 --- a/src/Perl6/Compiler.nqp +++ b/src/Perl6/Compiler.nqp @@ -84,10 +84,10 @@ class Perl6::Compiler is HLL::Compiler { method usage($name?, :$use-stderr = False) { my $print-func := $use-stderr ?? ¬e !! &say; # RT #130760 - $print-func(($name ?? $name !! "") ~ " [switches] [--] [programfile] [arguments] + $print-func(($name ?? $name !! "") ~ q♥ [switches] [--] [programfile] [arguments] -With no arguments, enters a REPL on TTY displays or evals STDIN on non-TTY. -With a \"[programfile]\" or the \"-e\" option, compiles the given program +With no arguments, enters a REPL (see --repl-mode option). +With a "[programfile]" or the "-e" option, compiles the given program and, by default, also executes the compiled code. -c check syntax only (runs BEGIN and CHECK blocks) @@ -95,7 +95,7 @@ and, by default, also executes the compiled code. -e program one line of program, strict is enabled by default -h, --help display this help text -n run program once for each line of input - -p same as -n, but also print \$_ at the end of lines + -p same as -n, but also print $_ at the end of lines -I path adds the path to the module search path -M module loads the module prior to running the program --target=stage specify compilation stage to emit @@ -117,18 +117,22 @@ and, by default, also executes the compiled code. any other extension outputs in HTML --doc=module use Pod::To::[module] to render inline documentation - --force-stdin-eval-mode=interactive|non-interactive - when running without -e or filename arguments, - do not rely on whether STDIN is a TTY and force the - eval of code from STDIN to be via REPL (interactive) - or without REPL (non-interactive) + --repl-mode=interactive|non-interactive + when running without "-e" or filename arguments, + a REPL is started. By default, if STDIN is a TTY, + "interactive" REPL is started that shows extra messages and + prompts, otherwise a "non-interactive" mode is used where + STDIN is read entirely and evaluated as if it were a program, + without any extra output (in fact, no REPL machinery is even + loaded). This option allows to bypass TTY detection and + force one of the REPL modes. Note that only boolean single-letter options may be bundled. To modify the include path, you can set the PERL6LIB environment variable: -PERL6LIB=\"lib\" perl6 example.pl -"); # end of usage statement +PERL6LIB="lib" perl6 example.pl +♥); # end of usage statement nqp::exit(0); From 6256ec8272134045a50cbb7685426036b15737e7 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 7 Oct 2017 20:07:57 -0400 Subject: [PATCH 390/692] Make repl tests force interactive repl mode --- t/02-rakudo/repl.t | 6 +++--- t/packages/Test/Helpers.pm6 | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/t/02-rakudo/repl.t b/t/02-rakudo/repl.t index a7c13c5c749..68dffa958bc 100644 --- a/t/02-rakudo/repl.t +++ b/t/02-rakudo/repl.t @@ -301,9 +301,9 @@ is feed_repl_with(['say "hi"'], :no-filter-messages).subst(:g, /\W+/, ''), { # REPL must not start, but if it does start and wait for input, it'll # "hang", from our point of view, which the test function will detect - doesn't-hang \(:w, $*EXECUTABLE, '-M', "NonExistentModuleRT128595"), - :out(/^$/), - :err(/'Could not find NonExistentModuleRT128595'/), + doesn't-hang \(:w, $*EXECUTABLE, + '--repl-mode=interactive', '-M', 'NonExistentModuleRT128595' + ), :out(/^$/), :err(/'Could not find NonExistentModuleRT128595'/), 'REPL with -M with non-existent module does not start'; } diff --git a/t/packages/Test/Helpers.pm6 b/t/packages/Test/Helpers.pm6 index 4419b944e6d..f65943d4eae 100644 --- a/t/packages/Test/Helpers.pm6 +++ b/t/packages/Test/Helpers.pm6 @@ -28,7 +28,7 @@ sub is-run ( } sub is-run-repl ($code, $desc, :$out, :$err) is export { - my $proc = &CORE::run( $*EXECUTABLE, :in, :out, :err ); + my $proc = run $*EXECUTABLE, '--repl-mode=interactive', :in, :out, :err; $proc.in.print: $code; $proc.in.close; subtest { From e72dedf5cbf97df5687992f099ad196e340ae0f7 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 7 Oct 2017 20:13:39 -0400 Subject: [PATCH 391/692] Simplify routine call --- t/02-rakudo/repl.t | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/t/02-rakudo/repl.t b/t/02-rakudo/repl.t index 68dffa958bc..e0a96592312 100644 --- a/t/02-rakudo/repl.t +++ b/t/02-rakudo/repl.t @@ -260,7 +260,7 @@ is feed_repl_with(['say "hi"'], :no-filter-messages).subst(:g, /\W+/, ''), # RT #70297 { - my $proc = &CORE::run( $*EXECUTABLE, :in, :out, :err); + my $proc = run $*EXECUTABLE, :in, :out, :err; $proc.in.close; skip 'Result differs on OSX'; From 4358871873c902b75a3dca059ecafa30196e279f Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 7 Oct 2017 20:22:37 -0400 Subject: [PATCH 392/692] Add scrubber routine to is-run-repl --- t/02-rakudo/repl.t | 20 ++++++++------------ t/packages/Test/Helpers.pm6 | 1 + 2 files changed, 9 insertions(+), 12 deletions(-) diff --git a/t/02-rakudo/repl.t b/t/02-rakudo/repl.t index e0a96592312..b05b8eab461 100644 --- a/t/02-rakudo/repl.t +++ b/t/02-rakudo/repl.t @@ -3,18 +3,14 @@ use lib ; use Test; use Test::Helpers; -# Sanity check that the repl is working at all. -my $cmd = $*DISTRO.is-win - ?? "echo exit(42) | $*EXECUTABLE 1>&2" - !! "echo 'exit(42)' | $*EXECUTABLE >/dev/null 2>&1"; -is shell($cmd).exitcode, 42, 'exit(42) in executed REPL got run'; - -# RT #104514 -{ - my $cmd = $*DISTRO.is-win - ?? q[echo my @a = -^^^> { say "foo" }; @a^^^>^^^>.() | ] ~ $*EXECUTABLE - !! q[echo 'my @a = -> { say "foo" }; @a>>.()' | ] ~ $*EXECUTABLE; - like qqx[$cmd].Str, /"foo" $$/, '>>.() does not crash in REPL'; +my $*REPL-SCRUBBER = -> $_ is copy { + s/^^ "You may want to `zef install Readline` or `zef install Linenoise`" + " or use rlwrap for a line editor\n\n"//; + s/^^ "To exit type 'exit' or '^D'\n"//; + s:g/ ^^ "> " //; # Strip out the prompts + s:g/ ">" $ //; # Strip out the final prompt + s:g/ ^^ "* "+ //; # Strip out the continuation-prompts + $_ } my $quote; diff --git a/t/packages/Test/Helpers.pm6 b/t/packages/Test/Helpers.pm6 index f65943d4eae..b2106d8768d 100644 --- a/t/packages/Test/Helpers.pm6 +++ b/t/packages/Test/Helpers.pm6 @@ -35,6 +35,7 @@ sub is-run-repl ($code, $desc, :$out, :$err) is export { plan +($out, $err).grep: *.defined; with $out { my $output = $proc.out.slurp; + $output = $*REPL-SCRUBBER($output) if $*REPL-SCRUBBER; my $test-name = 'stdout is correct'; when Str { is $output, $_, $test-name; } when Regex { like $output, $_, $test-name; } From 92bc011ab0c1588534df76e159ce92fba508b167 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 7 Oct 2017 20:24:02 -0400 Subject: [PATCH 393/692] Follow convention of core multi sub declarations --- t/packages/Test/Helpers.pm6 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/t/packages/Test/Helpers.pm6 b/t/packages/Test/Helpers.pm6 index b2106d8768d..28a69299eed 100644 --- a/t/packages/Test/Helpers.pm6 +++ b/t/packages/Test/Helpers.pm6 @@ -56,13 +56,13 @@ sub is-run-repl ($code, $desc, :$out, :$err) is export { }, $desc; } -multi doesn't-hang (Str $args, $desc, :$in, :$wait = 1.5, :$out, :$err) +multi sub doesn't-hang (Str $args, $desc, :$in, :$wait = 1.5, :$out, :$err) is export { doesn't-hang \($*EXECUTABLE, '-e', $args), $desc, :$in, :$wait, :$out, :$err; } -multi doesn't-hang ( +multi sub doesn't-hang ( Capture $args, $desc = 'code does not hang', :$in, :$wait = 1.5, :$out, :$err, ) is export { From 63643ad042f18abb359ac70344124d723d526bb9 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 7 Oct 2017 20:29:31 -0400 Subject: [PATCH 394/692] Friendlify is-run-repl() - If code is a Positional, assume its separate lines to feed REPL with - If out/err tests are Positionals, assume they're a bunch of lines --- t/packages/Test/Helpers.pm6 | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/t/packages/Test/Helpers.pm6 b/t/packages/Test/Helpers.pm6 index 28a69299eed..1077dd9b848 100644 --- a/t/packages/Test/Helpers.pm6 +++ b/t/packages/Test/Helpers.pm6 @@ -27,7 +27,10 @@ sub is-run ( } } -sub is-run-repl ($code, $desc, :$out, :$err) is export { +multi sub is-run-repl (@lines, |c) is export { + is-run-repl @lines.join("\n"), |c +} +multi sub is-run-repl ($code, $desc, :$out = '', :$err = '') is export { my $proc = run $*EXECUTABLE, '--repl-mode=interactive', :in, :out, :err; $proc.in.print: $code; $proc.in.close; @@ -37,9 +40,10 @@ sub is-run-repl ($code, $desc, :$out, :$err) is export { my $output = $proc.out.slurp; $output = $*REPL-SCRUBBER($output) if $*REPL-SCRUBBER; my $test-name = 'stdout is correct'; - when Str { is $output, $_, $test-name; } - when Regex { like $output, $_, $test-name; } - when Callable { ok $_($output), $test-name; } + when Str { is $output, $_, $test-name; } + when Regex { like $output, $_, $test-name; } + when Callable { ok $_($output), $test-name; } + when Positional { is $output, .join("\n")~"\n", $test-name; } die "Don't know how to handle :out of type $_.^name()"; } @@ -47,9 +51,10 @@ sub is-run-repl ($code, $desc, :$out, :$err) is export { with $err { my $output = $proc.err.slurp; my $test-name = 'stderr is correct'; - when Str { is $output, $_, $test-name; } - when Regex { like $output, $_, $test-name; } - when Callable { ok $_($output), $test-name; } + when Str { is $output, $_, $test-name; } + when Regex { like $output, $_, $test-name; } + when Callable { ok $_($output), $test-name; } + when Positional { is $output, .join("\n")~"\n", $test-name; } die "Don't know how to handle :err of type $_.^name()"; } From 9c4025f33f53b3155f2979dca1d7906bc24a1a54 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 7 Oct 2017 20:34:15 -0400 Subject: [PATCH 395/692] Improve is-run() Default to empty Str test for err/out and 0 exit code --- t/packages/Test/Helpers.pm6 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/t/packages/Test/Helpers.pm6 b/t/packages/Test/Helpers.pm6 index 1077dd9b848..6901f496bc3 100644 --- a/t/packages/Test/Helpers.pm6 +++ b/t/packages/Test/Helpers.pm6 @@ -3,7 +3,7 @@ use Test; sub is-run ( Str() $code, $desc = "$code runs", - Stringy :$in, :@compiler-args, :@args, :$out, :$err, :$status + Stringy :$in, :@compiler-args, :@args, :$out = '', :$err = '', :$status = 0 ) is export { with run :in, :out, :err, $*EXECUTABLE, @compiler-args, '-e', $code, @args From 71a0ad55286d99e7253cb8623744c95adb4d64a0 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 7 Oct 2017 21:04:49 -0400 Subject: [PATCH 396/692] Rewrite Positional $code handling The multi setup isn't working because non-Positional one takes precedence when desc is given --- t/packages/Test/Helpers.pm6 | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/t/packages/Test/Helpers.pm6 b/t/packages/Test/Helpers.pm6 index 6901f496bc3..443b7088899 100644 --- a/t/packages/Test/Helpers.pm6 +++ b/t/packages/Test/Helpers.pm6 @@ -27,10 +27,8 @@ sub is-run ( } } -multi sub is-run-repl (@lines, |c) is export { - is-run-repl @lines.join("\n"), |c -} -multi sub is-run-repl ($code, $desc, :$out = '', :$err = '') is export { +sub is-run-repl ($code is copy, $desc, :$out = '', :$err = '') is export { + $code .= join: "\n" if $code ~~ Positional|Seq; my $proc = run $*EXECUTABLE, '--repl-mode=interactive', :in, :out, :err; $proc.in.print: $code; $proc.in.close; From 2f0bb20e82ae62c290f8579bebd676603bc9814f Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 7 Oct 2017 21:06:54 -0400 Subject: [PATCH 397/692] diag() received output when Callable test fails Otherwise we can't see why exactly it failed --- t/packages/Test/Helpers.pm6 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/t/packages/Test/Helpers.pm6 b/t/packages/Test/Helpers.pm6 index 443b7088899..3c9c5c8ffc5 100644 --- a/t/packages/Test/Helpers.pm6 +++ b/t/packages/Test/Helpers.pm6 @@ -40,7 +40,7 @@ sub is-run-repl ($code is copy, $desc, :$out = '', :$err = '') is export { my $test-name = 'stdout is correct'; when Str { is $output, $_, $test-name; } when Regex { like $output, $_, $test-name; } - when Callable { ok $_($output), $test-name; } + when Callable { ok $_($output), $test-name or diag $output; } when Positional { is $output, .join("\n")~"\n", $test-name; } die "Don't know how to handle :out of type $_.^name()"; @@ -51,7 +51,7 @@ sub is-run-repl ($code is copy, $desc, :$out = '', :$err = '') is export { my $test-name = 'stderr is correct'; when Str { is $output, $_, $test-name; } when Regex { like $output, $_, $test-name; } - when Callable { ok $_($output), $test-name; } + when Callable { ok $_($output), $test-name or diag $output; } when Positional { is $output, .join("\n")~"\n", $test-name; } die "Don't know how to handle :err of type $_.^name()"; From 153f133bc2a159a85250479e3b83f0784a741df8 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 7 Oct 2017 21:59:03 -0400 Subject: [PATCH 398/692] Implement Map test to test specific lines - Keys are line numbers and values are expected lines - Key "t" is total expected line numbers --- t/packages/Test/Helpers.pm6 | 40 ++++++++++++++++++++++--------------- 1 file changed, 24 insertions(+), 16 deletions(-) diff --git a/t/packages/Test/Helpers.pm6 b/t/packages/Test/Helpers.pm6 index 3c9c5c8ffc5..fd2c80291af 100644 --- a/t/packages/Test/Helpers.pm6 +++ b/t/packages/Test/Helpers.pm6 @@ -32,30 +32,38 @@ sub is-run-repl ($code is copy, $desc, :$out = '', :$err = '') is export { my $proc = run $*EXECUTABLE, '--repl-mode=interactive', :in, :out, :err; $proc.in.print: $code; $proc.in.close; + subtest { plan +($out, $err).grep: *.defined; - with $out { - my $output = $proc.out.slurp; - $output = $*REPL-SCRUBBER($output) if $*REPL-SCRUBBER; - my $test-name = 'stdout is correct'; - when Str { is $output, $_, $test-name; } - when Regex { like $output, $_, $test-name; } - when Callable { ok $_($output), $test-name or diag $output; } - when Positional { is $output, .join("\n")~"\n", $test-name; } - die "Don't know how to handle :out of type $_.^name()"; - } - - with $err { - my $output = $proc.err.slurp; - my $test-name = 'stderr is correct'; + sub run-test ($_, $output, $test-name) { when Str { is $output, $_, $test-name; } when Regex { like $output, $_, $test-name; } when Callable { ok $_($output), $test-name or diag $output; } when Positional { is $output, .join("\n")~"\n", $test-name; } - - die "Don't know how to handle :err of type $_.^name()"; + when Map { + subtest "$test-name lines" => { + plan .elems; + my %lines = (1….elems) «=>» $_ with $output.lines; + with .:delete { + is +%lines, $_, "expected number of lines"; + } + for $_<> -> (:key($ln), :value($expected)) { + with %lines{$ln.substr: 1} { + is $_, $expected, "line #$ln"; + } + else { + flunk "No line #$ln (note: numebering starts at 1)"; + } + } + } + } + die "Don't know how to handle test of type $_.^name()"; } + + run-test $_, ($*REPL-SCRUBBER//{$_})($proc.out.slurp), + 'stdout is correct' with $out; + run-test $_, $proc.err.slurp, 'stderr is correct' with $err; }, $desc; } From be4d57deb5069e19eb797009f3b8786fafa9c8c6 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 7 Oct 2017 22:13:59 -0400 Subject: [PATCH 399/692] Start rewriting REPL tests using new test routine Tossed sanity tests (what's the point?) and two TODOed tests for postfix if/for on next lines. Such behaviour is undesirable, since we'll have to force users to use a semicolon at the end, having unhelpful behaviour of expecting further lines of input when it's missing. --- t/02-rakudo/repl.t | 171 ++++++++++++++++----------------------------- 1 file changed, 59 insertions(+), 112 deletions(-) diff --git a/t/02-rakudo/repl.t b/t/02-rakudo/repl.t index b05b8eab461..82fd0169a09 100644 --- a/t/02-rakudo/repl.t +++ b/t/02-rakudo/repl.t @@ -13,127 +13,74 @@ my $*REPL-SCRUBBER = -> $_ is copy { $_ } -my $quote; -my $separator; -if $*DISTRO.is-win { - $quote = ""; - $separator = "& "; -} -else { - $quote = "'"; - $separator = "; "; -} - -sub feed_repl_with ( @lines, Bool:D :$no-filter-messages = False ) { - ## warning: works only with simple input lines which don't need quoting for Windows - my $repl-input = '(' ~ (@lines.map: { 'echo ' ~ $quote ~ $_ ~ $quote }).join($separator) ~ ')'; - my $repl-output = qqx[$repl-input | $*EXECUTABLE].trim-trailing; - unless $no-filter-messages { - $repl-output ~~ s/^^ "You may want to `zef install Readline` or `zef install Linenoise` or use rlwrap for a line editor\n\n"//; - $repl-output ~~ s/^^ "To exit type 'exit' or '^D'\n"//; - } - $repl-output ~~ s:g/ ^^ "> " //; # Strip out the prompts - $repl-output ~~ s:g/ ">" $ //; # Strip out the final prompt - $repl-output ~~ s:g/ ^^ "* "+ //; # Strip out the continuation-prompts - $repl-output -} - -my @input-lines; # RT #123187 -{ - @input-lines[0] = 'my int $t=4; $t.say;'; - @input-lines[1] = '$t.say'; - is feed_repl_with( @input-lines ).lines, (4, 4), - 'can use native typed variable on subsequent lines (1)'; +is-run-repl «'my int $t=4; $t.say;' '$t.say'», :out<4 4>, + 'can use native typed variable on subsequent lines (1)'; + +subtest 'indented code parses correctly' => { + plan 4; + + todo "indent styles don't parse right", 3; + is-run-repl q:to/END/, + if False { + say ":("; + } + else { + say ":)"; + } + END + :out(":)\n"), 'uncuddled else is parsed correctly'; + + is-run-repl q:to/END/, + if False + { + say ":("; + } + else + { + say ":)"; + } + END + :out(":)\n"), 'open brace on next line is parsed correctly'; + + is-run-repl q:to/END/, + if False { say ":("; } + else { say ":)"; } + END + :out(":)\n"), 'partially-cuddled else is parsed correctly'; + + is-run-repl q:to/END/, + if False { + say ":("; + } else { + say ":)"; + } + END + :out(":)\n"), 'cuddled else'; } -{ - @input-lines = q:to/END/.split("\n"); - if False { - say ":("; - } - else { - say ":)"; - } - END +is-run-repl «'sub f {' 'say "works"' '}' 'f()'», :out{:t<2>, :l2 }, + 'multi-line sub decl'; +is-run-repl «'sub f { say "works" }' 'f()'», :out{:t<2>, :l2 }, + 'single-line sub declaration works'; - todo "indent styles don't parse right"; - is feed_repl_with( @input-lines ).lines, ":)", - "uncuddled else is parsed correctly"; - @input-lines = q:to/END/.split("\n"); - if False - { - say ":("; - } - else - { - say ":)"; - } - END - - todo "indent styles don't parse right"; - is feed_repl_with( @input-lines ).lines, ":)", - "open brace on next line is parsed correctly"; - - @input-lines = q:to/END/.split("\n"); - if False { say ":("; } - else { say ":)"; } - END - - todo "indent styles don't parse right"; - is feed_repl_with( @input-lines ).lines, ":)", - "cuddled else is parsed correctly"; - - @input-lines = q:to/END/.split("\n"); - if False { - say ":("; - } else { - say ":)"; - } - END - is feed_repl_with( @input-lines ).lines, ":)", - "cuddled else is parsed correctly"; -} - -{ - @input-lines = 'say "works"', 'if True;'; - todo "statement mod if on the next line"; - is feed_repl_with( @input-lines ).lines, "works", - "statement mod if on the next line works"; - - @input-lines = 'say "works"', 'for 1;'; - todo "statement mod for on the next line"; - is feed_repl_with( @input-lines ).lines, "works", - "statement mod for on the next line works"; - - @input-lines = 'sub f { 42 }', 'f()'; - todo "block parsing broken"; - is feed_repl_with( @input-lines ).lines, "42", - "single-line sub declaration works"; - - @input-lines = 'sub f {', '42', '}'; - todo "block parsing broken"; - is feed_repl_with( @input-lines ).lines, "42", - "single-line sub declaration works"; -} # RT #122914 -{ - @input-lines = 'my $a = 42; say 1', '$a.say'; - is feed_repl_with( @input-lines ).lines, (1, 42), - 'Assigning to a Scalar lasts to the next line'; - - @input-lines = 'my @a = 1, 2, 3; say 1', '@a.elems.say'; - is feed_repl_with( @input-lines ).lines, (1, 3), - 'Assigning to an Array lasts to the next line'; - - @input-lines = 'my \a = 100; say 1', 'a.say'; - is feed_repl_with( @input-lines ).lines, (1, 100), - 'Assigning to a sigilless lasts to the next line'; +subtest 'assignment maintains values on subsequent lines' => { + plan 4; + is-run-repl «'my $a = 42; say 1' '$a.say'», :out("1\n42\n"), + 'Scalar'; + is-run-repl «'my @a = 1, 2, 3; say 1' '@a.elems.say'», :out("1\n3\n"), + 'Array'; + is-run-repl «'my %h = 1..4; say 1' 'say +%h.keys'», :out("1\n2\n"), + 'Hash'; + is-run-repl «'my \a = 100; say 1' 'a.say'», :out("1\n100\n"), + 'sigilless value'; } - +done-testing; +=finish { @input-lines = ''; is feed_repl_with(@input-lines).lines, (), From c45d0cd1b5cf822e1c05ceaf29fb3c38f81cb959 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 7 Oct 2017 23:04:25 -0400 Subject: [PATCH 400/692] Disable error colouring --- t/packages/Test/Helpers.pm6 | 1 + 1 file changed, 1 insertion(+) diff --git a/t/packages/Test/Helpers.pm6 b/t/packages/Test/Helpers.pm6 index fd2c80291af..ddc1fb830d2 100644 --- a/t/packages/Test/Helpers.pm6 +++ b/t/packages/Test/Helpers.pm6 @@ -29,6 +29,7 @@ sub is-run ( sub is-run-repl ($code is copy, $desc, :$out = '', :$err = '') is export { $code .= join: "\n" if $code ~~ Positional|Seq; + (temp %*ENV) = 0; my $proc = run $*EXECUTABLE, '--repl-mode=interactive', :in, :out, :err; $proc.in.print: $code; $proc.in.close; From 338a097246f549d48de3ee9c7157ac9ca24921ef Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 7 Oct 2017 23:30:53 -0400 Subject: [PATCH 401/692] Allow :out test given as third positional --- t/packages/Test/Helpers.pm6 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/t/packages/Test/Helpers.pm6 b/t/packages/Test/Helpers.pm6 index ddc1fb830d2..e08369f72c3 100644 --- a/t/packages/Test/Helpers.pm6 +++ b/t/packages/Test/Helpers.pm6 @@ -27,7 +27,10 @@ sub is-run ( } } -sub is-run-repl ($code is copy, $desc, :$out = '', :$err = '') is export { +multi sub is-run-repl ($code, $out, $desc, |c) is export { + is-run-repl $code, $desc, :$out, |c; +} +multi sub is-run-repl ($code is copy, $desc, :$out = '', :$err = '') is export { $code .= join: "\n" if $code ~~ Positional|Seq; (temp %*ENV) = 0; my $proc = run $*EXECUTABLE, '--repl-mode=interactive', :in, :out, :err; From 7c8a2739a51950e8d6afc14f566c90f0c5daf015 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 7 Oct 2017 23:32:46 -0400 Subject: [PATCH 402/692] Rewrite remaining REPL tests using new routine --- t/02-rakudo/repl.t | 190 +++++++++++++++++++-------------------------- 1 file changed, 80 insertions(+), 110 deletions(-) diff --git a/t/02-rakudo/repl.t b/t/02-rakudo/repl.t index 82fd0169a09..dba6517ec4f 100644 --- a/t/02-rakudo/repl.t +++ b/t/02-rakudo/repl.t @@ -3,6 +3,8 @@ use lib ; use Test; use Test::Helpers; +plan 39; + my $*REPL-SCRUBBER = -> $_ is copy { s/^^ "You may want to `zef install Readline` or `zef install Linenoise`" " or use rlwrap for a line editor\n\n"//; @@ -14,7 +16,7 @@ my $*REPL-SCRUBBER = -> $_ is copy { } # RT #123187 -is-run-repl «'my int $t=4; $t.say;' '$t.say'», :out<4 4>, +is-run-repl «'my int $t=4; $t.say;' '$t.say'», <4 4>, 'can use native typed variable on subsequent lines (1)'; subtest 'indented code parses correctly' => { @@ -29,7 +31,7 @@ subtest 'indented code parses correctly' => { say ":)"; } END - :out(":)\n"), 'uncuddled else is parsed correctly'; + ":)\n", 'uncuddled else is parsed correctly'; is-run-repl q:to/END/, if False @@ -41,13 +43,13 @@ subtest 'indented code parses correctly' => { say ":)"; } END - :out(":)\n"), 'open brace on next line is parsed correctly'; + ":)\n", 'open brace on next line is parsed correctly'; is-run-repl q:to/END/, if False { say ":("; } else { say ":)"; } END - :out(":)\n"), 'partially-cuddled else is parsed correctly'; + ":)\n", 'partially-cuddled else is parsed correctly'; is-run-repl q:to/END/, if False { @@ -56,149 +58,117 @@ subtest 'indented code parses correctly' => { say ":)"; } END - :out(":)\n"), 'cuddled else'; + ":)\n", 'cuddled else'; } -is-run-repl «'sub f {' 'say "works"' '}' 'f()'», :out{:t<2>, :l2 }, - 'multi-line sub decl'; -is-run-repl «'sub f { say "works" }' 'f()'», :out{:t<2>, :l2 }, - 'single-line sub declaration works'; - - - +is-run-repl «'sub f {' 'say "works"' '}' 'f()'», { + .lines == 2 and .lines.tail eq 'works' +}, 'multi-line sub decl'; +is-run-repl «'sub f { say "works" }' 'f()'», { + .lines == 2 and .lines.tail eq 'works' +}, 'single-line sub declaration works'; # RT #122914 subtest 'assignment maintains values on subsequent lines' => { plan 4; - is-run-repl «'my $a = 42; say 1' '$a.say'», :out("1\n42\n"), + is-run-repl «'my $a = 42; say 1' '$a.say'», "1\n42\n", 'Scalar'; - is-run-repl «'my @a = 1, 2, 3; say 1' '@a.elems.say'», :out("1\n3\n"), + is-run-repl «'my @a = 1, 2, 3; say 1' '@a.elems.say'», "1\n3\n", 'Array'; - is-run-repl «'my %h = 1..4; say 1' 'say +%h.keys'», :out("1\n2\n"), + is-run-repl «'my %h = 1..4; say 1' 'say +%h.keys'», "1\n2\n", 'Hash'; - is-run-repl «'my \a = 100; say 1' 'a.say'», :out("1\n100\n"), + is-run-repl «'my \a = 100; say 1' 'a.say'», "1\n100\n", 'sigilless value'; } -done-testing; -=finish -{ - @input-lines = ''; - is feed_repl_with(@input-lines).lines, (), - 'Entering a blank line gives back the prompt'; - @input-lines = '""'; - is feed_repl_with(@input-lines).lines, (''), - 'An empty string gives back one blank line'; -} +is-run-repl "\n", '> ', 'entering a blank line gives back the prompt'; +is-run-repl "''\n", "\n", 'an empty string gives back one blank line'; -{ - @input-lines = '}'; - like feed_repl_with(@input-lines), / "===" "\e[0m"? "SORRY!" "\e[31m"? "===" /, - 'Syntax error gives a compile-time error'; - like feed_repl_with(@input-lines), / "Unexpected closing bracket" /, - 'Syntax error gives the expected error'; - - @input-lines = 'sub }', 'say 1+1'; - like feed_repl_with(@input-lines), - / "===" "\e[0m"? "SORRY!" "\e[31m"? "===" /, - 'Syntax error gives a compile-time error'; - like feed_repl_with(@input-lines), / "Missing block" /, - 'Syntax error gives the expected error'; - is feed_repl_with(@input-lines).comb('Error while compiling').elems, 1, - 'Syntax error clears on further input'; - - @input-lines = 'this-function-does-not-exist()'; - like feed_repl_with(@input-lines), / "===" "\e[0m"? "SORRY!" "\e[31m"? "===" /, - 'EVAL-time compile error gives a compile-time error'; - like feed_repl_with(@input-lines), / "Undeclared routine" /, - 'EVAL-time compile error error gives the expected error'; - - @input-lines = 'sub f { this-function-does-not-exist() } ; f()'; - like feed_repl_with(@input-lines), / "Undeclared routine" /, - 'EVAL-time compile error error gives the expected error'; - - @input-lines = '[1].map:{[].grep:Str}'; - like feed_repl_with(@input-lines), / "Cannot resolve caller" /, - 'Print-time error error gives the expected error'; -} +is-run-repl "}\n", /'===SORRY!===' .* 'Unexpected closing bracket'/, + 'syntax error gives a compile-time error'; -{ - for -> $cmd { - @input-lines = $cmd; - like feed_repl_with(@input-lines), / "Control flow commands not allowed in topleve" /, - "Raises error when you run control flow command '$cmd'"; - } +is-run-repl "}\nsay 42", { + .match: /'===SORRY!===' .* 'Unexpected closing bracket' .* '42'/ + and 1 == .comb: 'Error while compiling' +}, 'syntax error clears on further input'; - like feed_repl_with(['emit 42']), /'emit without'/, - '`emit` prints useful message'; +is-run-repl ['meow-meow()'], /'===SORRY!===' .* 'Undeclared routine'/, + 'undeclared routines give compile time errors'; +is-run-repl ['sub f { meow-meow() }; f()'], + /'===SORRY!===' .* 'Undeclared routine'/, + 'undeclared routines inside another routine give compile time errors'; +is-run-repl ['[1].map:{[].grep:Str}'], /'Cannot resolve caller'/, + 'run-time error error gives the expected error'; - like feed_repl_with(['take 42']), /'take without'/, - '`take` prints useful message'; - like feed_repl_with(['warn "foo"']), /'foo'/, - 'Warnings print their message'; +for -> $cmd { + is-run-repl [$cmd], /'Control flow commands not allowed in toplevel'/, + "raises error when you run control flow command '$cmd' in top level"; } +is-run-repl ['emit 42' ], /'emit without'/, '`emit` errors usefully'; +is-run-repl ['take 42' ], /'take without'/, '`take` errors usefully'; +is-run-repl ['warn "foo"'], /'foo' /, 'warn() shows warnings'; + # RT#130876 { - like feed_repl_with(['say "hi"; die "meows";']), /meows/, + is-run-repl ['say "hi"; die "meows";'], :out(/meows/), 'previous output does not silence exceptions'; - my $out = feed_repl_with - ['say "hi"; my $f = Failure.new: "meows"; $f.Bool; $f']; - ok $out.contains('meows').not, + is-run-repl ['say "hi"; my $f = Failure.new: "meows"; $f.Bool; $f'], + *.contains('meows').not, 'previous output prevents output of handled failures'; - $out = feed_repl_with ['say "hi"; X::AdHoc.new(:payload)']; - ok $out.contains('meows').not, + is-run-repl ['say "hi"; X::AdHoc.new(:payload)'], + *.contains('meows').not, 'previous output prevents output of unthrown exceptions'; - $out = feed_repl_with ['say "hi"; try +"a"; $!']; - ok $out.contains('meows').not, + is-run-repl ['say "hi"; try +"a"; $!'], + *.contains('meows').not, 'previous output does not prevent output of unthrown exceptions'; - $out = feed_repl_with([ + is-run-repl [ 「say "hi"; use nqp; my $x = REPL.new(nqp::getcomp("perl6"), %)」 ~ 「.repl-eval(q|die "meows"|, $);」 - ]); - ok $out.contains('meows').not, + ], *.contains('meows').not, 「can't trick REPL into thinking an exception was thrown (RT#130876)」; } -# RT#130874 -like feed_repl_with(['Nil']), /Nil/, 'REPL outputs Nil as a Nil'; +# RT#130874 +is-run-repl ['Nil'], /Nil/, 'REPL outputs Nil as a Nil'; + # Since there might be some differences in REPL sessions in whitespace # or what not, strip all \W and then check what we have left over is what # a normal session should have. This lets us catch any unexpected error # messages and stuff. -is feed_repl_with(['say "hi"'], :no-filter-messages).subst(:g, /\W+/, ''), - 'YoumaywanttozefinstallReadlineorzefinstallLinenoise' - ~ 'oruserlwrapforalineeditor' ~ 'ToexittypeexitorD' ~ 'hi', -'REPL session does not have unexpected stuff'; - -## XXX TODO: need to write tests that exercise the REPL with Linenoise -# and Readline installed. Particular things to check: -# 1. History file can be made on all OSes: -# https://github.com/rakudo/rakudo/commit/b4fa6d6792dd02424d2182b73c31a071cddc0b8e -# 2. Test REPL does not show errors when $*HOME is not set: -# https://rt.perl.org/Ticket/Display.html?id=130456 +{ + my $*REPL-SCRUBBER := Nil; + is-run-repl ['say "hi"'], { + .subst(:g, /\W+/, '') eq + 'YoumaywanttozefinstallReadlineorzefinstallLinenoise' + ~ 'oruserlwrapforalineeditor' ~ 'ToexittypeexitorD' ~ 'hi' + }, 'REPL session does not have unexpected stuff'; + + ## XXX TODO: need to write tests that exercise the REPL with Linenoise + # and Readline installed. Particular things to check: + # 1. History file can be made on all OSes: + # https://github.com/rakudo/rakudo/commit/b4fa6d6792dd02424d2182b73c31a071cddc0b8e + # 2. Test REPL does not show errors when $*HOME is not set: + # https://rt.perl.org/Ticket/Display.html?id=130456 +} # RT #119339 { - todo 'make the function check STDERR', 2; - like feed_repl_with(['say 069']), - /'Potential difficulties:' - .* 'Leading 0' .+ "use '0o' prefix," - .* '69 is not a valid octal number'/, - 'prefix 0 on invalid octal warns in REPL'; - - like feed_repl_with(['say 069']), - /'Potential difficulties:' - .* 'Leading 0' .+ "use '0o' prefix," - .* '0o67 is not a valid octal number'/, - 'prefix 0 on valid octal warns in REPL'; + is-run-repl ['say 069'], :out("69\n"), :err(/'Potential difficulties:' + .* 'Leading 0' .+ "use '0o' prefix," + .* '69 is not a valid octal number' + /), 'prefix 0 on invalid octal warns in REPL'; + + is-run-repl ['say 067'], :out("67\n"), :err(/'Potential difficulties:' + .* 'Leading 0' .+ "use '0o' prefix" .* "like, '0o67'" + /), 'prefix 0 on valid octal warns in REPL'; } # RT #70297 @@ -207,12 +177,12 @@ is feed_repl_with(['say "hi"'], :no-filter-messages).subst(:g, /\W+/, ''), $proc.in.close; skip 'Result differs on OSX'; - subtest { - plan 2; - is $proc.err.slurp, '', 'stderr is correct'; - like $proc.out.slurp, /"To exit type 'exit' or '^D'\n> "/, - 'stdout is correct'; - }, 'Pressing CTRL+D in REPL produces correct output on exit'; + # subtest { + # plan 2; + # is $proc.err.slurp, '', 'stderr is correct'; + # like $proc.out.slurp, /"To exit type 'exit' or '^D'\n> "/, + # 'stdout is correct'; + # }, 'Pressing CTRL+D in REPL produces correct output on exit'; } # RT #128470 From d82c09b35143e27f41c7d9890523611c0e5f33f8 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 7 Oct 2017 23:33:03 -0400 Subject: [PATCH 403/692] Toss `Map` test option Too convoluted and turned out to be rather useless afterall. --- t/packages/Test/Helpers.pm6 | 17 ----------------- 1 file changed, 17 deletions(-) diff --git a/t/packages/Test/Helpers.pm6 b/t/packages/Test/Helpers.pm6 index e08369f72c3..3b874513d99 100644 --- a/t/packages/Test/Helpers.pm6 +++ b/t/packages/Test/Helpers.pm6 @@ -45,23 +45,6 @@ multi sub is-run-repl ($code is copy, $desc, :$out = '', :$err = '') is export { when Regex { like $output, $_, $test-name; } when Callable { ok $_($output), $test-name or diag $output; } when Positional { is $output, .join("\n")~"\n", $test-name; } - when Map { - subtest "$test-name lines" => { - plan .elems; - my %lines = (1….elems) «=>» $_ with $output.lines; - with .:delete { - is +%lines, $_, "expected number of lines"; - } - for $_<> -> (:key($ln), :value($expected)) { - with %lines{$ln.substr: 1} { - is $_, $expected, "line #$ln"; - } - else { - flunk "No line #$ln (note: numebering starts at 1)"; - } - } - } - } die "Don't know how to handle test of type $_.^name()"; } From c9913277c9da6c302d4a953fb75a25640278a901 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 7 Oct 2017 23:47:08 -0400 Subject: [PATCH 404/692] Consistify interface By allowing Seq :out/:err tests, since we allow Seqs for $code --- t/packages/Test/Helpers.pm6 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/t/packages/Test/Helpers.pm6 b/t/packages/Test/Helpers.pm6 index 3b874513d99..7d37613074f 100644 --- a/t/packages/Test/Helpers.pm6 +++ b/t/packages/Test/Helpers.pm6 @@ -44,7 +44,9 @@ multi sub is-run-repl ($code is copy, $desc, :$out = '', :$err = '') is export { when Str { is $output, $_, $test-name; } when Regex { like $output, $_, $test-name; } when Callable { ok $_($output), $test-name or diag $output; } - when Positional { is $output, .join("\n")~"\n", $test-name; } + when Positional|Seq { + is $output, .join("\n")~"\n", $test-name; + } die "Don't know how to handle test of type $_.^name()"; } From f8edb8295773acd41432e4f85424f5eb7245dbd7 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 7 Oct 2017 23:47:44 -0400 Subject: [PATCH 405/692] Document test helpers --- t/packages/Test/Helpers.pm6 | 88 +++++++++++++++++++++++++++++++++++++ 1 file changed, 88 insertions(+) diff --git a/t/packages/Test/Helpers.pm6 b/t/packages/Test/Helpers.pm6 index 7d37613074f..c6f11af57a0 100644 --- a/t/packages/Test/Helpers.pm6 +++ b/t/packages/Test/Helpers.pm6 @@ -94,3 +94,91 @@ multi sub doesn't-hang ( } }; } + +=begin pod + +=head2 is-run + + sub is-run ( + Str() $code, $desc = "$code runs", + Stringy :$in, :@compiler-args, :@args, :$out = '', :$err = '', :$status = 0 + ) + +Runs code with C, smartmatching STDOUT with C<$out>, +STDERR with C<$err> and exit code with C<$status>. C<$in> can be a C +or a C. C<@args> are arguments to the program, while C<@compiler-args> +are arguments to the compiler. + +=head2 is-run-repl + + multi sub is-run-repl ($code, $out, $desc, |c) + multi sub is-run-repl ($code, $desc, :$out = '', :$err = '') + +Fires up the REPL and feeds it with C<$code>. If C<$code> is a C +or a C, will join each element with a C<"\n">. The C<$out> and C<$err> +test STDOUT and STDERR respectively and can be of the following types: + + Str: uses `is` test + Regex: uses `like` test + Callable: executes, giving string to test as argument, truthy value means pass + Positional or Seq: assumes to be a list of lines. Joins with "\n", appends + another "\n" to the end and uses `is` test + +It's possible to scrub STDOUT of unwanted strings before testing by setting +C<$*REPL-SCRUBBER> to a C that takes original STDOUT as argument and +returns the scrubbed version. + +=head2 doesn't-hang + + doesn't-hang 'say "some code"' :out(/'some code'/), + 'some code does not hang'; + doesn't-hang \(:w, $*EXECUTABLE, '-M', "SomeNonExistentMod"), + :in("say 'output works'\nexit\n"), + :out(/'output works'/), + 'REPL with -M with non-existent module'; + +Uses C to execute a potentially-hanging program and kills it after +a specified timeout, if it doesn't surrender peacefully. Collects STDERR +and STDOUT, optional taking regex matchers for additional testing. Takes +the following arguments: + +=head3 First positional argument + + 'say "some code"' + \(:w, $*EXECUTABLE, '-M', "SomeNonExistentMod") + +B Can be a C or a C. A C represents +arguments to pass to C. If C is passed, it is treated +as if a capture with C<\($*EXECUTABLE, '-e', $code-to-run)> passed, where +C<$code-to-run> is the code contained in the passed C. + +=head3 Second positional argument + +B Takes a C for test description. B +C<'code does not hang'> + +=head3 C<:wait> + +B Specifies the amount of time in seconds to wait for the +executed program to finish. B C<1.5> + +=head3 C<:in> + +B. Takes a C that will be sent to executed program's STDIN. +B not specified. + +=head3 C<:out> + +B. Takes a C<.defined> object that will be smartmatched against +C containing program's STDOUT. If the program doesn't finish before +C<:wait> seconds, no attempt to check STDOUT will be made. B +not specified. + +=head3 C<:err> + +B. Takes a C<.defined> object that will be smartmatched against +C containing program's STDERR. If the program doesn't finish before +C<:wait> seconds, no attempt to check STDERR will be made. B +not specified. + +=end pod From 456358e3c380eeeb5fe5bc6260ba6f51c42a52ff Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sun, 8 Oct 2017 06:04:47 +0000 Subject: [PATCH 406/692] Make @a[42..*] 4.2x faster; AlexDaniel++ for persistence - Faster with any Inf .max Range - Faster only with non-lazy @a (we can't .elems lazies) - Fixes RT#125344: https://rt.perl.org/Ticket/Display.html?id=125344 --- src/core/array_slice.pm | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/src/core/array_slice.pm b/src/core/array_slice.pm index e6ead2471dc..8523cd3cc2a 100644 --- a/src/core/array_slice.pm +++ b/src/core/array_slice.pm @@ -54,7 +54,16 @@ multi sub POSITIONS( } } - my \pos-iter = pos.iterator; + # we can optimize `42..*` Ranges; as long as they're from core, unmodified + my \pos-iter = nqp::eqaddr(pos.WHAT,Range) + && nqp::eqaddr(pos.max,Inf) + && nqp::isfalse(SELF.is-lazy) + ?? Range.new(pos.min, SELF.elems-1, + :excludes-min(pos.excludes-min), + :excludes-max(pos.excludes-max) + ).iterator + !! pos.iterator; + my \pos-list = nqp::create(List); my \eager-indices = nqp::create(IterationBuffer); my \target = IndicesReificationTarget.new(eager-indices, $eagerize); From 830084430330cd4c740b10353742a3eada46b7c9 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sun, 8 Oct 2017 08:18:41 +0000 Subject: [PATCH 407/692] Do not explode in IO::CatHandle.nl-out Doing so breaks .Capture, which is more important than throwing in a feature clearly documented as NYI --- src/core/IO/CatHandle.pm | 8 ++++++-- t/02-rakudo/07-io-cathandle.t | 2 +- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/src/core/IO/CatHandle.pm b/src/core/IO/CatHandle.pm index 8ce82895a04..ecf872e5756 100644 --- a/src/core/IO/CatHandle.pm +++ b/src/core/IO/CatHandle.pm @@ -354,8 +354,6 @@ my class IO::CatHandle is IO::Handle { # (⛣) proto method flush (|) { * } multi method flush (|) { die X::NYI.new: :feature } - proto method nl-out (|) { * } - multi method nl-out (|) { die X::NYI.new: :feature } proto method print (|) { * } multi method print (|) { die X::NYI.new: :feature } proto method printf (|) { * } @@ -369,6 +367,12 @@ my class IO::CatHandle is IO::Handle { proto method write (|) { * } multi method write (|) { die X::NYI.new: :feature } # /|\ + + # Don't die on this one, as doing so breaks .Capture + # proto method nl-out (|) { * } + # multi method nl-out (|) { + # die X::NYI.new: :feature + # } } # vim: ft=perl6 expandtab sw=4 diff --git a/t/02-rakudo/07-io-cathandle.t b/t/02-rakudo/07-io-cathandle.t index abf143fd705..4cd3392253e 100644 --- a/t/02-rakudo/07-io-cathandle.t +++ b/t/02-rakudo/07-io-cathandle.t @@ -3,7 +3,7 @@ use Test; # Tests that NYI methods of IO::CatHandle throw -my @meths = ; +my @meths = ; # nl-out plan 2 + @meths; throws-like { IO::CatHandle.new."$_"() }, X::NYI, $_ for @meths; From 775c367f34fd7858b74de219f79c15ee29654552 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sun, 8 Oct 2017 11:27:13 -0400 Subject: [PATCH 408/692] Fudge OSX-failing tests REPL output differred slightly on OSX for ages and we already had fudged tests for that reason. Fudging a couple more of these new ones. --- t/02-rakudo/repl.t | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/t/02-rakudo/repl.t b/t/02-rakudo/repl.t index dba6517ec4f..0b908ca944a 100644 --- a/t/02-rakudo/repl.t +++ b/t/02-rakudo/repl.t @@ -81,7 +81,8 @@ subtest 'assignment maintains values on subsequent lines' => { 'sigilless value'; } -is-run-repl "\n", '> ', 'entering a blank line gives back the prompt'; +skip 'Different result on OSX'; +#is-run-repl "\n", '> ', 'entering a blank line gives back the prompt'; is-run-repl "''\n", "\n", 'an empty string gives back one blank line'; is-run-repl "}\n", /'===SORRY!===' .* 'Unexpected closing bracket'/, @@ -145,11 +146,12 @@ is-run-repl ['Nil'], /Nil/, 'REPL outputs Nil as a Nil'; # messages and stuff. { my $*REPL-SCRUBBER := Nil; - is-run-repl ['say "hi"'], { - .subst(:g, /\W+/, '') eq - 'YoumaywanttozefinstallReadlineorzefinstallLinenoise' - ~ 'oruserlwrapforalineeditor' ~ 'ToexittypeexitorD' ~ 'hi' - }, 'REPL session does not have unexpected stuff'; + skip 'Result differs on OSX'; + # is-run-repl ['say "hi"'], { + # .subst(:g, /\W+/, '') eq + # 'YoumaywanttozefinstallReadlineorzefinstallLinenoise' + # ~ 'oruserlwrapforalineeditor' ~ 'ToexittypeexitorD' ~ 'hi' + # }, 'REPL session does not have unexpected stuff'; ## XXX TODO: need to write tests that exercise the REPL with Linenoise # and Readline installed. Particular things to check: From 12fcece494e12b02ee9e7e169f0c811870d56702 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sun, 8 Oct 2017 18:20:33 +0200 Subject: [PATCH 409/692] Fix for RT #132246 --- src/core/Hash.pm | 60 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 60 insertions(+) diff --git a/src/core/Hash.pm b/src/core/Hash.pm index ee2619255e5..3d4114334e5 100644 --- a/src/core/Hash.pm +++ b/src/core/Hash.pm @@ -740,6 +740,66 @@ my class Hash { # declared in BOOTSTRAP } }.new(self)) } + multi method roll(::?CLASS:D:) { + nqp::if( + (my $raw := nqp::getattr(self,Map,'$!storage')) && nqp::elems($raw), + nqp::stmts( + (my int $i = nqp::add_i(nqp::elems($raw).rand.floor,1)), + (my $iter := nqp::iterator($raw)), + nqp::while( + nqp::shift($iter) && ($i = nqp::sub_i($i,1)), + nqp::null + ), + nqp::iterval($iter) + ), + Nil + ) + } + multi method roll(::?CLASS:D: Callable:D $calculate) { + self.roll( $calculate(self.elems) ) + } + multi method roll(::?CLASS:D: Whatever $) { self.roll(Inf) } + multi method roll(::?CLASS:D: $count) { + Seq.new(nqp::if( + (my $raw := nqp::getattr(self,Map,'$!storage')) + && nqp::elems($raw) && $count > 0, + class :: does Iterator { + has $!storage; + has $!keys; + has $!count; + + method !SET-SELF(\hash,\count) { + nqp::stmts( + ($!storage := nqp::getattr(hash,Map,'$!storage')), + ($!count = $count), + (my $iter := nqp::iterator($!storage)), + ($!keys := nqp::list_s), + nqp::while( + $iter, + nqp::push_s($!keys,nqp::iterkey_s(nqp::shift($iter))) + ), + self + ) + } + method new(\h,\c) { nqp::create(self)!SET-SELF(h,c) } + method pull-one() { + nqp::if( + $!count, + nqp::stmts( + --$!count, # must be HLL to handle Inf + nqp::atkey( + $!storage, + nqp::atpos_s($!keys,nqp::elems($!keys).rand.floor) + ) + ), + IterationEnd + ) + } + method is-lazy() { $!count == Inf } + }.new(self,$count), + Rakudo::Iterator.Empty + )) + } multi method perl(::?CLASS:D \SELF:) { SELF.perlseen('Hash', { my $TKey-perl := TKey.perl; From 4ba12ff17c810f8afda35bce3ef8c9a208c83f29 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Mon, 9 Oct 2017 02:51:38 -0400 Subject: [PATCH 410/692] Implement X::Cannot::Capture To be thrown from .Capture methods of certain types per https://irclog.perlgeek.de/perl6/2017-03-07#i_14221839 --- src/core/Exception.pm | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/src/core/Exception.pm b/src/core/Exception.pm index a0e1eea05d7..70c6ae3e6d9 100644 --- a/src/core/Exception.pm +++ b/src/core/Exception.pm @@ -2098,6 +2098,15 @@ my class X::Cannot::New is Exception { "Cannot make a {$.class.^name} object using .new"; } } +my class X::Cannot::Capture is Exception { + has $.what; + method message() { + "Cannot unpack or Capture `$!what.gist()`.\n" + ~ "To create a Capture, add parentheses: \\(...)\n" + ~ 'If unpacking in a signature, perhaps you needlessly used' + ~ ' parentheses? -> ($x) {} vs. -> $x {}'; + } +} my class X::Backslash::UnrecognizedSequence does X::Syntax { has $.sequence; From bad9fefdd7e5e569eced85072bb019eef3997c32 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Mon, 9 Oct 2017 02:52:31 -0400 Subject: [PATCH 411/692] Make .Capture of certain core types throw To avoid supersticious, performance-reducing parens; e.g. -> ($x) {} where -> $x {} was meant. Discussion: https://irclog.perlgeek.de/perl6/2017-03-07#i_14221839 --- src/core/Callable.pm | 3 +++ src/core/Failure.pm | 5 +++++ src/core/Int.pm | 3 +++ src/core/Num.pm | 2 ++ src/core/Signature.pm | 4 ++++ src/core/Str.pm | 2 ++ src/core/Version.pm | 2 ++ src/core/Whatever.pm | 5 ++++- 8 files changed, 25 insertions(+), 1 deletion(-) diff --git a/src/core/Callable.pm b/src/core/Callable.pm index 68c0291a26d..9a2acc4c0ea 100644 --- a/src/core/Callable.pm +++ b/src/core/Callable.pm @@ -1,6 +1,9 @@ +my class X::Cannot::Capture { ... } + my role Callable[::T = Mu] { method of() { T } method returns() { T } + method Capture() { die X::Cannot::Capture.new: :what(self) } } # vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Failure.pm b/src/core/Failure.pm index 0a1a587d3a5..c340f87f9ec 100644 --- a/src/core/Failure.pm +++ b/src/core/Failure.pm @@ -71,6 +71,11 @@ my class Failure is Nil { ) } + method Capture() { + self.DEFINITE.not || $!handled + ?? X::Cannot::Capture.new(what => self).throw + !! self!throw + } method Int(Failure:D:) { $!handled ?? Int !! self!throw(); } method Num(Failure:D:) { $!handled ?? NaN !! self!throw(); } method Numeric(Failure:D:) { $!handled ?? NaN !! self!throw(); } diff --git a/src/core/Int.pm b/src/core/Int.pm index e08a093146f..6b2e087a1bf 100644 --- a/src/core/Int.pm +++ b/src/core/Int.pm @@ -1,4 +1,5 @@ my class Rat { ... } +my class X::Cannot::Capture { ... } my class X::Numeric::DivideByZero { ... } my class X::NYI::BigInt { ... } @@ -38,6 +39,8 @@ my class Int does Real { # declared in BOOTSTRAP nqp::p6bool(nqp::bool_I(self)); } + method Capture() { die X::Cannot::Capture.new: :what(self) } + method Int() { self } multi method Str(Int:D:) { diff --git a/src/core/Num.pm b/src/core/Num.pm index 42fb0fc0d44..455346a75e9 100644 --- a/src/core/Num.pm +++ b/src/core/Num.pm @@ -1,3 +1,4 @@ +my class X::Cannot::Capture { ... } my class X::Numeric::DivideByZero { ... } my class X::Numeric::CannotConvert { ... } my role Rational { ... } @@ -19,6 +20,7 @@ my class Num does Real { # declared in BOOTSTRAP ObjAt ) } + method Capture() { die X::Cannot::Capture.new: :what(self) } method Num() { self } method Bridge(Num:D:) { self } method Range(Num:U:) { Range.new(-Inf,Inf) } diff --git a/src/core/Signature.pm b/src/core/Signature.pm index bd92ea3fc2a..cecc067177b 100644 --- a/src/core/Signature.pm +++ b/src/core/Signature.pm @@ -1,3 +1,5 @@ +my class X::Cannot::Capture { ... } + my class Signature { # declared in BOOTSTRAP # class Signature is Any # has @!params; # VM's array of parameters @@ -79,6 +81,8 @@ my class Signature { # declared in BOOTSTRAP True; } + method Capture() { die X::Cannot::Capture.new: :what(self) } + method arity() { $!arity } diff --git a/src/core/Str.pm b/src/core/Str.pm index 3ef48f459ff..852466b9437 100644 --- a/src/core/Str.pm +++ b/src/core/Str.pm @@ -1,5 +1,6 @@ my class Range { ... } my class Match { ... } +my class X::Cannot::Capture { ... } my class X::Str::InvalidCharName { ... } my class X::Str::Numeric { ... } my class X::Str::Match::x { ... } @@ -39,6 +40,7 @@ my class Str does Stringy { # declared in BOOTSTRAP multi method Bool(Str:D:) { nqp::p6bool(nqp::chars($!value)); } + method Capture() { die X::Cannot::Capture.new: :what(self) } multi method Str(Str:D:) { self } multi method Stringy(Str:D:) { self } diff --git a/src/core/Version.pm b/src/core/Version.pm index 0895311385c..3db78c941a6 100644 --- a/src/core/Version.pm +++ b/src/core/Version.pm @@ -103,6 +103,8 @@ class Version { True; } + method Capture() { die X::Cannot::Capture.new: :what(self) } + multi method WHICH(Version:D:) { nqp::box_s( nqp::concat( diff --git a/src/core/Whatever.pm b/src/core/Whatever.pm index 916ad5c8807..d05628f8bc7 100644 --- a/src/core/Whatever.pm +++ b/src/core/Whatever.pm @@ -1,15 +1,18 @@ -class X::Cannot::New { ... } +my class X::Cannot::Capture { ... } +my class X::Cannot::New { ... } my class Whatever { multi method ACCEPTS(Whatever:D: $ --> True) { } multi method perl(Whatever:D: --> '*') { } multi method Str(Whatever:D: --> '*') { } + method Capture() { die X::Cannot::Capture.new: :what(self) } } my class HyperWhatever { multi method new(HyperWhatever:) { X::Cannot::New.new(class => self).throw } multi method ACCEPTS(HyperWhatever:D: $ --> True) { } multi method perl(HyperWhatever:D:) { '**' } + method Capture() { die X::Cannot::Capture.new: :what(self) } } sub HYPERWHATEVER (&c) { sub (*@_) { map &c, @_ } } From 1ea3297b214403eb5b584ffe9b0f2b38a6f05ea7 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Mon, 9 Oct 2017 07:03:56 +0000 Subject: [PATCH 412/692] Block out Mu.new from Range To avoid throwing incorrect error that Range.new takes only named args --- src/core/Range.pm | 1 + 1 file changed, 1 insertion(+) diff --git a/src/core/Range.pm b/src/core/Range.pm index 1a03c826ec3..5e34bf0ef1d 100644 --- a/src/core/Range.pm +++ b/src/core/Range.pm @@ -21,6 +21,7 @@ my class Range is Cool does Iterable does Positional { # The order of "method new" declarations matters here, to ensure # appropriate candidate tiebreaking when mixed type arguments # are present (e.g., Range,Whatever or Real,Range). + proto method new(|) {*} multi method new(Range $min, \max, :$excludes-min, :$excludes-max) { X::Range::InvalidArg.new(:got($min)).throw; } From cd5864cfc1ec11425706019f8eb727974b73b83e Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Mon, 9 Oct 2017 09:17:49 +0000 Subject: [PATCH 413/692] Implement .Capture on types per spec Spec: https://github.com/perl6/roast/commit/ca273503b6 Discussions: https://irclog.perlgeek.de/perl6/2017-03-07#i_14221839 https://irclog.perlgeek.de/perl6-dev/2017-10-08#i_15275349 https://irclog.perlgeek.de/perl6-dev/2017-10-08#i_15274676 https://irclog.perlgeek.de/perl6-dev/2017-05-24#i_14629113 --- src/core/Buf.pm | 1 + src/core/Channel.pm | 1 + src/core/Range.pm | 8 ++++++++ src/core/Supply.pm | 2 ++ src/core/allomorphs.pm | 2 ++ 5 files changed, 14 insertions(+) diff --git a/src/core/Buf.pm b/src/core/Buf.pm index 1879ecbfc1b..782880f20fb 100644 --- a/src/core/Buf.pm +++ b/src/core/Buf.pm @@ -102,6 +102,7 @@ my role Blob[::T = uint8] does Positional[T] does Stringy is repr('VMArray') is } multi method Bool(Blob:D:) { nqp::p6bool(nqp::elems(self)) } + method Capture(Blob:D:) { self.List.Capture } multi method elems(Blob:D:) { nqp::p6box_i(nqp::elems(self)) } multi method elems(Blob:U: --> 1) { } diff --git a/src/core/Channel.pm b/src/core/Channel.pm index 461d322278b..4df9cb6ec9f 100644 --- a/src/core/Channel.pm +++ b/src/core/Channel.pm @@ -106,6 +106,7 @@ my class Channel does Awaitable { } } + method Capture(Channel:D:) { self.List.Capture } multi method Supply(Channel:D:) { supply { # Tap the async notification for new values supply. diff --git a/src/core/Range.pm b/src/core/Range.pm index 5e34bf0ef1d..603a1360057 100644 --- a/src/core/Range.pm +++ b/src/core/Range.pm @@ -600,6 +600,14 @@ my class Range is Cool does Iterable does Positional { } } + method Capture(Range:D:) { + \( :$!min, :$!max, + excludes-min => self.excludes-min, + excludes-max => self.excludes-max, + infinite => self.infinite, + is-int => self.is-int) + } + multi method Numeric(Range:D:) { $!is-int ?? self.elems diff --git a/src/core/Supply.pm b/src/core/Supply.pm index 3e71e027ada..f13ab1ae705 100644 --- a/src/core/Supply.pm +++ b/src/core/Supply.pm @@ -68,6 +68,8 @@ my class Supply does Awaitable { } submethod BUILD(:$!tappable! --> Nil) { } + method Capture(Supply:D:) { self.List.Capture } + method live(Supply:D:) { $!tappable.live } method serial(Supply:D:) { $!tappable.serial } method Tappable(--> Tappable) { $!tappable } diff --git a/src/core/allomorphs.pm b/src/core/allomorphs.pm index d7bb74aedb4..b1f5bf82611 100644 --- a/src/core/allomorphs.pm +++ b/src/core/allomorphs.pm @@ -61,6 +61,7 @@ my class RatStr is Rat is Str { self.Str.ACCEPTS(a), self.Str.ACCEPTS(a) && self.Rat.ACCEPTS(a))) } + method Capture(RatStr:D:) { self.Mu::Capture } multi method Numeric(RatStr:D:) { self.Rat } method Rat(RatStr:D:) { Rat.new(nqp::getattr(self, Rat, '$!numerator'), nqp::getattr(self, Rat, '$!denominator')) } multi method Str(RatStr:D:) { nqp::getattr_s(self, Str, '$!value') } @@ -85,6 +86,7 @@ my class ComplexStr is Complex is Str { self.Str.ACCEPTS(a), self.Str.ACCEPTS(a) && self.Complex.ACCEPTS(a))) } + method Capture(ComplexStr:D:) { self.Mu::Capture } multi method Numeric(ComplexStr:D:) { self.Complex } method Complex(ComplexStr:D:) { Complex.new(nqp::getattr_n(self, Complex, '$!re'), nqp::getattr_n(self, Complex, '$!im')) } multi method Str(ComplexStr:D:) { nqp::getattr_s(self, Str, '$!value') } From 27131ed8d15cc1e629e2e76e56787970f4c5f84e Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Mon, 9 Oct 2017 10:23:04 +0000 Subject: [PATCH 414/692] Make Signature.ACCEPTS coerce args to Capture - Instead of relying to Any.ACCEPTS to always give False - We already did do this for Positional and Associative arguments --- src/core/Signature.pm | 12 +++--------- 1 file changed, 3 insertions(+), 9 deletions(-) diff --git a/src/core/Signature.pm b/src/core/Signature.pm index cecc067177b..18fa4441369 100644 --- a/src/core/Signature.pm +++ b/src/core/Signature.pm @@ -8,18 +8,12 @@ my class Signature { # declared in BOOTSTRAP # has Num $!count; # count # has Code $!code; + multi method ACCEPTS(Signature:D: Mu \topic) { + nqp::p6bool(try self.ACCEPTS: topic.Capture) + } multi method ACCEPTS(Signature:D: Capture $topic) { nqp::p6bool(nqp::p6isbindable(self, nqp::decont($topic))); } - - multi method ACCEPTS(Signature:D: @topic) { - self.ACCEPTS(@topic.Capture) - } - - multi method ACCEPTS(Signature:D: %topic) { - self.ACCEPTS(%topic.Capture) - } - multi method ACCEPTS(Signature:D: Signature:D $topic) { my $sclass = self.params.classify({.named}); my $tclass = $topic.params.classify({.named}); From 56eef6967b54b16c2ebdb639a48b9023ca3efaba Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Mon, 9 Oct 2017 14:00:22 +0200 Subject: [PATCH 415/692] Fix for RT #132249 --- src/Perl6/World.nqp | 11 ++++++++--- src/core/Exception.pm | 3 +++ 2 files changed, 11 insertions(+), 3 deletions(-) diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index ca90337b688..18e55e77fda 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -1041,9 +1041,14 @@ class Perl6::World is HLL::World { my $registry := self.find_symbol(['CompUnit', 'RepositoryRegistry']); my $io-path := self.find_symbol(['IO', 'Path']); for $arglist -> $arg { - $registry.use-repository($registry.repository-for-spec( - nqp::istype($arg, $io-path) ?? $arg.absolute !! $arg - )); + if $arg { + $registry.use-repository($registry.repository-for-spec( + nqp::istype($arg, $io-path) ?? $arg.absolute !! $arg + )); + } + else { + self.throw($/, 'X::LibEmpty'); + } } } else { diff --git a/src/core/Exception.pm b/src/core/Exception.pm index 70c6ae3e6d9..7963b295d94 100644 --- a/src/core/Exception.pm +++ b/src/core/Exception.pm @@ -1921,6 +1921,9 @@ my class X::Match::Bool is Exception { method message() { "Cannot use Bool as Matcher with '" ~ $.type ~ "'. Did you mean to use \$_ inside a block?" } } +my class X::LibEmpty does X::Comp { + method message { q/Repository specification can not be an empty string. Did you mean 'use lib "."' ?/ } +} my class X::LibNone does X::Comp { method message { q/Must specify at least one repository. Did you mean 'use lib "lib"' ?/ } } From 1ce3a36df4edb023d5b9f69ef0283263b704e1f0 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Mon, 9 Oct 2017 11:59:21 -0400 Subject: [PATCH 416/692] Implement :$line-editor option - Sets REPL_LINE_EDITOR for duration of the test - Default to `none`, which prevents spurious failures for users who have one of the recommended line editors installed. --- t/packages/Test/Helpers.pm6 | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/t/packages/Test/Helpers.pm6 b/t/packages/Test/Helpers.pm6 index c6f11af57a0..fb801dd86bb 100644 --- a/t/packages/Test/Helpers.pm6 +++ b/t/packages/Test/Helpers.pm6 @@ -30,9 +30,11 @@ sub is-run ( multi sub is-run-repl ($code, $out, $desc, |c) is export { is-run-repl $code, $desc, :$out, |c; } -multi sub is-run-repl ($code is copy, $desc, :$out = '', :$err = '') is export { +multi sub is-run-repl ($code is copy, $desc, :$out = '', :$err = '', + :$line-editor = 'none' +) is export { $code .= join: "\n" if $code ~~ Positional|Seq; - (temp %*ENV) = 0; + (temp %*ENV) = 0, $line-editor; my $proc = run $*EXECUTABLE, '--repl-mode=interactive', :in, :out, :err; $proc.in.print: $code; $proc.in.close; @@ -112,9 +114,11 @@ are arguments to the compiler. =head2 is-run-repl multi sub is-run-repl ($code, $out, $desc, |c) - multi sub is-run-repl ($code, $desc, :$out = '', :$err = '') + multi sub is-run-repl ($code, $desc, :$out = '', :$err = '', :$line-editor = 'none') -Fires up the REPL and feeds it with C<$code>. If C<$code> is a C +Fires up the REPL and feeds it with C<$code>, setting +C«%*ENV» to the value of C<$line-editor> for the duration +of the test. If C<$code> is a C or a C, will join each element with a C<"\n">. The C<$out> and C<$err> test STDOUT and STDERR respectively and can be of the following types: From 973f88dc652d8497064f3d6cbea1ce275ae844d2 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Mon, 9 Oct 2017 12:00:34 -0400 Subject: [PATCH 417/692] Document is-run-repl sets ERROR_COLOR option --- t/packages/Test/Helpers.pm6 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/t/packages/Test/Helpers.pm6 b/t/packages/Test/Helpers.pm6 index fb801dd86bb..7b753394246 100644 --- a/t/packages/Test/Helpers.pm6 +++ b/t/packages/Test/Helpers.pm6 @@ -132,6 +132,8 @@ It's possible to scrub STDOUT of unwanted strings before testing by setting C<$*REPL-SCRUBBER> to a C that takes original STDOUT as argument and returns the scrubbed version. +Note: the routine sets C«%*ENV» to C<0> + =head2 doesn't-hang doesn't-hang 'say "some code"' :out(/'some code'/), From 484f987259bd8b1bbb356780f1a0315ae9d327e3 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Mon, 9 Oct 2017 12:04:04 -0400 Subject: [PATCH 418/692] Close pipes in is-run-repl; ugexe++ --- t/packages/Test/Helpers.pm6 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/t/packages/Test/Helpers.pm6 b/t/packages/Test/Helpers.pm6 index 7b753394246..aff798170a4 100644 --- a/t/packages/Test/Helpers.pm6 +++ b/t/packages/Test/Helpers.pm6 @@ -52,9 +52,9 @@ multi sub is-run-repl ($code is copy, $desc, :$out = '', :$err = '', die "Don't know how to handle test of type $_.^name()"; } - run-test $_, ($*REPL-SCRUBBER//{$_})($proc.out.slurp), + run-test $_, ($*REPL-SCRUBBER//{$_})($proc.out.slurp: :close), 'stdout is correct' with $out; - run-test $_, $proc.err.slurp, 'stderr is correct' with $err; + run-test $_, $proc.err.slurp(:close), 'stderr is correct' with $err; }, $desc; } From e11f4ea26629b1861ef6ffb3b3e2db64aa708da6 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Mon, 9 Oct 2017 22:51:32 +0000 Subject: [PATCH 419/692] Bump NQP --- tools/build/NQP_REVISION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/build/NQP_REVISION b/tools/build/NQP_REVISION index 78abb3f4cbd..75fdcbf5084 100644 --- a/tools/build/NQP_REVISION +++ b/tools/build/NQP_REVISION @@ -1 +1 @@ -2017.09-66-g943f7f7 +2017.09-75-ga65dbe0 From 880a8e1c146a8c333b7d7a453aa779f85b2b904d Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Tue, 10 Oct 2017 05:49:49 -0400 Subject: [PATCH 420/692] Make is-run() mangle run() args on Windows Due to RT#132258, when we `run $*EXECUTABLE` it goes throw cmd.exe and the tests fail due to bad quoting. Mangle the args to the test routine, so they get sent off properly. The issue with sending double quotes appear to still remain in some cases and properly working around it seems to need VERBATIM args send off in libuv, which we currently have off. Fixes almost all of `make test` failures. The remaining failures just need to be switched over to this test routine instead of doing `run` manually, landing onto the same problem. --- t/packages/Test/Helpers.pm6 | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/t/packages/Test/Helpers.pm6 b/t/packages/Test/Helpers.pm6 index aff798170a4..8bf1e1ce3c0 100644 --- a/t/packages/Test/Helpers.pm6 +++ b/t/packages/Test/Helpers.pm6 @@ -5,9 +5,17 @@ sub is-run ( Str() $code, $desc = "$code runs", Stringy :$in, :@compiler-args, :@args, :$out = '', :$err = '', :$status = 0 ) is export { - with run :in, :out, :err, + my @proc-args = flat do if $*DISTRO.is-win { + # $*EXECUTABLE is a batch file on Windows, that goes through cmd.exe + # and chokes on standard quoting. We also need to remove any newlines + , $*EXECUTABLE, @compiler-args, '-e', + ($code, @args).subst(:g, "\n", " ") + } + else { $*EXECUTABLE, @compiler-args, '-e', $code, @args - { + } + + with run :in, :out, :err, @proc-args { $in ~~ Blob ?? .in.write: $in !! .in.print: $in if $in; $ = .in.close; my $proc-out = .out.slurp: :close; From 47faae2b13fe0ca8babb820bcbaa893b2a4f4ae5 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Tue, 10 Oct 2017 06:02:25 -0400 Subject: [PATCH 421/692] Make `make test` pass on Windows - Use `is-run` routine for failing tests that does a bit of arg mangling to make them palatable to Windows's cmd.exe (RT#132258) - Skip one of the tests on Windows. Couldn't figure out how to send the quote in the args; the best I got resulted in duplicated quotes. Perhaps if there's a good solution to RT#132258 this fudge could be removed. --- t/05-messages/01-errors.t | 24 +++++++++++++++++------- 1 file changed, 17 insertions(+), 7 deletions(-) diff --git a/t/05-messages/01-errors.t b/t/05-messages/01-errors.t index dda3c621878..06083e5cd52 100644 --- a/t/05-messages/01-errors.t +++ b/t/05-messages/01-errors.t @@ -1,4 +1,6 @@ +use lib ; use Test; +use Test::Helpers; # RT #129763 throws-like '1++', X::Multi::NoMatch, @@ -64,16 +66,24 @@ throws-like 「m: my @a = for 1..3 <-> { $_ }」, Exception, # RT #113954 { - is run(:err, $*EXECUTABLE, ['-e', q[multi MAIN(q|foo bar|) {}]]).err.slurp(:close), - qq|Usage:\n -e '...' 'foo bar' \n|, + is-run 「multi MAIN(q|foo bar|) {}」, + :err(qq|Usage:\n -e '...' 'foo bar' \n|), + :status(*), 'a space in a literal param to a MAIN() multi makes the suggestion quoted'; - is run(:err, $*EXECUTABLE, ['-e', q[multi MAIN(q|foo"bar|) {}]]).err.slurp(:close), - qq|Usage:\n -e '...' 'foo"bar' \n|, - 'a double qoute in a literal param to a MAIN() multi makes the suggestion quoted'; + if $*DISTRO.is-win { + skip "Test routine quoting doesn't work right on Windows: RT#132258" + } + else { + is-run 「multi MAIN(q|foo"bar|) {}」, + :err(qq|Usage:\n -e '...' 'foo"bar' \n|), + :status(*), + 'a double qoute in a literal param to a MAIN() multi makes the suggestion quoted'; + } - is run(:err, $*EXECUTABLE, ['-e', q[multi MAIN(q|foo'bar|) {}]]).err.slurp(:close), - qq|Usage:\n -e '...' 'foo'"'"'bar' \n|, + is-run 「multi MAIN(q|foo'bar|) {}」, + :err(qq|Usage:\n -e '...' 'foo'"'"'bar' \n|), + :status(*), 'a single qoute in a literal param to a MAIN() multi makes the suggestion quoted'; } From 3684384db1e3e9b6846f230eac1e44080ba59523 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Tue, 10 Oct 2017 16:39:10 +0000 Subject: [PATCH 422/692] Make cmp-ok() take its args raw - Lets users use `=:=` op as comparator - Prevents interference with other ops that rely on address equivalence to do their thang, such as `eqv` --- lib/Test.pm6 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/Test.pm6 b/lib/Test.pm6 index 3b173657a94..cdad2f2d3a5 100644 --- a/lib/Test.pm6 +++ b/lib/Test.pm6 @@ -230,7 +230,7 @@ multi sub isnt(Mu $got, Mu:D $expected, $desc = '') is export { $ok or ($die_on_fail and die-on-fail) or $ok; } -multi sub cmp-ok(Mu $got, $op, Mu $expected, $desc = '') is export { +multi sub cmp-ok(Mu $got is raw, $op, Mu $expected is raw, $desc = '') is export { $time_after = nqp::time_n; $got.defined; # Hack to deal with Failures my $ok; From 54507ac94ef1a4266a3316a85e61f7f9df41e75d Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Tue, 10 Oct 2017 16:48:11 +0000 Subject: [PATCH 423/692] Fix `Mu` as is default() on attributes Fixes RT#132082: https://rt.perl.org/Ticket/Display.html?id=132082 Routine args default to `Any`, so the multi for is default with Mu was never reached, instead going to the multi that cries about unknown traits. --- src/core/traits.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/traits.pm b/src/core/traits.pm index 571a8cdce07..c334e9eaa6e 100644 --- a/src/core/traits.pm +++ b/src/core/traits.pm @@ -97,7 +97,7 @@ multi sub trait_mod:(Attribute $attr, :$required!) { nqp::istype($required,Bool) ?? +$required !! $required ); } -multi sub trait_mod:(Attribute $attr, :$default!) { +multi sub trait_mod:(Attribute $attr, Mu :$default!) { $attr.container_descriptor.set_default(nqp::decont($default)); $attr.container = nqp::decont($default) if nqp::iscont($attr.container); } From e13512191487330cb8eaf1aa7558a62774784cfa Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Tue, 10 Oct 2017 17:53:58 +0000 Subject: [PATCH 424/692] Make Array.List fill holes with Nil - Fixes RT#132261: https://rt.perl.org/Ticket/Display.html?id=132261 - List.AT-POS already gives a Nil for a hole, but .iterator does not do similar insertion. Doing so in Array.List lets us avoid paying for this feature in List.iterator - This behaviour is closer to what happens with .Slip or .AT-POS, since we can assign the .List back into an Array and get the `is default` values where the holes were; just as we would without going through .List first. - This commit does NOT add the same behaviour when `:view` arg is passed, since adding would defeat the purpose of the arg. It's an unused (in core), undocumented, and unspecced arg, so perhaps it should be removed altogether. --- src/core/Array.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/Array.pm b/src/core/Array.pm index a8ae908b320..b41f3d42258 100644 --- a/src/core/Array.pm +++ b/src/core/Array.pm @@ -372,7 +372,7 @@ my class Array { # declared in BOOTSTRAP (my int $i = -1), nqp::while( nqp::islt_i(($i = nqp::add_i($i,1)),$elems), - nqp::bindpos($cow,$i,nqp::decont(nqp::atpos($reified,$i))), + nqp::bindpos($cow,$i,nqp::ifnull(nqp::decont(nqp::atpos($reified,$i)),Nil)), ), nqp::p6bindattrinvres(nqp::create(List),List,'$!reified',$cow) ) From dd943eded83edb37530178e9369da96cd6d64511 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Tue, 10 Oct 2017 23:23:18 +0200 Subject: [PATCH 425/692] Fix for RT #132236 - Bump NQP - this brings the NQP buildplan in line with Perl 6 - 0 -> CODE, 1 -> 0, 2 -> 11, 3 -> 12 - Add support for task codes 10, 11, 12 to auto-generated BUILDALL - having task 10 makes it ready for auto-generated BUILD_LEAST_DERIVED - Add support for tasks 11,12 to Mu.BUILDALL and Mu.BUILD_LEAST_DERIVED - in case somehow we failed to auto-generate a BUILDALL --- src/Perl6/Metamodel/BUILDPLAN.nqp | 2 + src/Perl6/World.nqp | 27 ++++++++-- src/core/Mu.pm | 86 ++++++++++++++++++++++++------- tools/build/NQP_REVISION | 2 +- 4 files changed, 94 insertions(+), 23 deletions(-) diff --git a/src/Perl6/Metamodel/BUILDPLAN.nqp b/src/Perl6/Metamodel/BUILDPLAN.nqp index 7452b3cde72..85aca424ec1 100644 --- a/src/Perl6/Metamodel/BUILDPLAN.nqp +++ b/src/Perl6/Metamodel/BUILDPLAN.nqp @@ -24,6 +24,8 @@ role Perl6::Metamodel::BUILDPLAN { # 8 die if a required attribute is not present # 9 class attr_name code = run attribute container initializer # 10 class attr_name = touch/vivify attribute if part of mixin + # 11 same as 0, but init to nqp::list if value absent (nqp only) + # 12 same as 0, but init to nqp::hash if value absent (nqp only) method create_BUILDPLAN($obj) { # First, we'll create the build plan for just this class. my @plan; diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index 18e55e77fda..e287b3d1742 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -3165,8 +3165,8 @@ class Perl6::World is HLL::World { QAST::SVal.new( :value(nqp::atpos($task,2)) ); my int $code := nqp::atpos($task,0); - # 0 = initialize opaque from %init - if $code == 0 { + # 0,11,12 = initialize opaque from %init + if $code == 0 || $code == 11 || $code == 12 { # 'a' my $key := @@ -3211,6 +3211,19 @@ class Perl6::World is HLL::World { ); } + # 11,12 +# bindattr(self,Foo,'$!a',nqp::list|hash) + if $code { + $if.push( + QAST::Op.new(:op, + $self, $class, $attr, + QAST::Op.new( + :op($code == 11 ?? 'list' !! 'hash') + ) + ) + ); + } + # ), $stmts.push($if); } @@ -3408,8 +3421,16 @@ class Perl6::World is HLL::World { $!w.add_object_if_no_sc(nqp::atpos($task,3)); } + # 10 = set attrinited on attribute + elsif $code == 10 { +# nqp::getattr(self,Foo,'$!a') + $stmts.push( + QAST::Op.new(:op, $self, $class, $attr) + ); + } + else { - nqp::die("Invalid BUILDALL plan"); + nqp::die('Invalid ' ~ $object.HOW.name($object) ~ '.BUILDALL plan: ' ~ $code); } } diff --git a/src/core/Mu.pm b/src/core/Mu.pm index 369cfa03d9c..dfc726a9738 100644 --- a/src/core/Mu.pm +++ b/src/core/Mu.pm @@ -285,26 +285,50 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" nqp::atpos($task,2), (nqp::atpos($task,3)()) ), - die("Invalid BUILDALL plan"), - ))))))), + nqp::if( + nqp::iseq_i($code,11), + nqp::if( # 11 + nqp::existskey($init,nqp::atpos($task,3)), + (nqp::getattr(self, + nqp::atpos($task,1),nqp::atpos($task,2)) + = %attrinit.AT-KEY(nqp::atpos($task,3))), + nqp::bindattr(self, + nqp::atpos($task,1),nqp::atpos($task,2), + nqp::list + ) + ), + nqp::if( + nqp::iseq_i($code,12), + nqp::if( # 12 + nqp::existskey($init,nqp::atpos($task,3)), + (nqp::getattr(self, + nqp::atpos($task,1),nqp::atpos($task,2)) + = %attrinit.AT-KEY(nqp::atpos($task,3))), + nqp::bindattr(self, + nqp::atpos($task,1),nqp::atpos($task,2), + nqp::hash + ) + ), + die('Invalid ' ~ self.^name ~ ".BUILDALL plan: $code"), + ))))))))), - nqp::if( # 0 - nqp::existskey($init,nqp::atpos($task,3)), - (nqp::getattr(self,nqp::atpos($task,1),nqp::atpos($task,2)) - = %attrinit.AT-KEY(nqp::atpos($task,3))), + nqp::if( # 0 + nqp::existskey($init,nqp::atpos($task,3)), + (nqp::getattr(self,nqp::atpos($task,1),nqp::atpos($task,2)) + = %attrinit.AT-KEY(nqp::atpos($task,3))), + ) + ) ) - ) - ) - ); - self - } + ); + self + } - method BUILD_LEAST_DERIVED(%attrinit) { - my $init := nqp::getattr(%attrinit,Map,'$!storage'); - # Get the build plan for just this class. - my $bp := nqp::findmethod(self.HOW,'BUILDPLAN')(self.HOW,self); - my int $count = nqp::elems($bp); - my int $i = -1; + method BUILD_LEAST_DERIVED(%attrinit) { + my $init := nqp::getattr(%attrinit,Map,'$!storage'); + # Get the build plan for just this class. + my $bp := nqp::findmethod(self.HOW,'BUILDPLAN')(self.HOW,self); + my int $count = nqp::elems($bp); + my int $i = -1; nqp::while( nqp::islt_i($i = nqp::add_i($i,1),$count), @@ -473,8 +497,32 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" ), ($i = nqp::sub_i($i,1)) ), - die("Invalid BUILD_LEAST_DERIVED plan") - )))))))), + nqp::if( + nqp::iseq_i($code,11), + nqp::if( # 11 + nqp::existskey($init,nqp::atpos($task,3)), + (nqp::getattr(self, + nqp::atpos($task,1),nqp::atpos($task,2)) + = %attrinit.AT-KEY(nqp::atpos($task,3))), + nqp::bindattr(self, + nqp::atpos($task,1),nqp::atpos($task,2), + nqp::list + ) + ), + nqp::if( + nqp::iseq_i($code,12), + nqp::if( # 12 + nqp::existskey($init,nqp::atpos($task,3)), + (nqp::getattr(self, + nqp::atpos($task,1),nqp::atpos($task,2)) + = %attrinit.AT-KEY(nqp::atpos($task,3))), + nqp::bindattr(self, + nqp::atpos($task,1),nqp::atpos($task,2), + nqp::hash + ) + ), + die('Invalid ' ~ self.^name ~ ".BUILD_LEAST_DERIVED plan: $code"), + )))))))))), nqp::if( # 0 nqp::existskey($init,nqp::atpos($task,3)), diff --git a/tools/build/NQP_REVISION b/tools/build/NQP_REVISION index 75fdcbf5084..918d766aeb6 100644 --- a/tools/build/NQP_REVISION +++ b/tools/build/NQP_REVISION @@ -1 +1 @@ -2017.09-75-ga65dbe0 +2017.09-76-gebac9fe From a72214c4f1602f3a7606e349431480fb4ceabd5e Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Tue, 10 Oct 2017 23:17:37 +0000 Subject: [PATCH 426/692] Bump NQP --- tools/build/NQP_REVISION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/build/NQP_REVISION b/tools/build/NQP_REVISION index 918d766aeb6..518d6e4dc7e 100644 --- a/tools/build/NQP_REVISION +++ b/tools/build/NQP_REVISION @@ -1 +1 @@ -2017.09-76-gebac9fe +2017.09-77-g26abb15 From fbae69e2be32111f6ea03cf9cfeb36b811ef387e Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Wed, 11 Oct 2017 12:37:28 +0000 Subject: [PATCH 427/692] Make `is default` on routines work earlier in setting Sometimes it's needed but the `does` op it's using is defined late in the setting. Mix in the marker role directly using .^mixin instead. --- src/core/traits.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/traits.pm b/src/core/traits.pm index c334e9eaa6e..cab8d270e96 100644 --- a/src/core/traits.pm +++ b/src/core/traits.pm @@ -141,7 +141,7 @@ multi sub trait_mod:(Routine:D $r, :$raw!) { $r.set_rw(); # for now, until we have real raw handling } multi sub trait_mod:(Routine:D $r, :$default!) { - $r does role { method default(--> True) { } } + $r.^mixin: role { method default(--> True) { } } } multi sub trait_mod:(Routine:D $r, :$DEPRECATED!) { my $new := nqp::istype($DEPRECATED,Bool) From 714c188d4aa0c5ca59d98dfb0c64c2ea889ab144 Mon Sep 17 00:00:00 2001 From: Timo Paulssen Date: Wed, 11 Oct 2017 15:06:36 +0200 Subject: [PATCH 428/692] generalize constraint for append otherwise it'll only be called when an int64 array is passed. This makes it splice 32bit, 16bit and 8bit for basically free. --- src/core/native_array.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/native_array.pm b/src/core/native_array.pm index cfe590c1d19..ba44ca4d92d 100644 --- a/src/core/native_array.pm +++ b/src/core/native_array.pm @@ -424,8 +424,8 @@ my class array does Iterable { nqp::push_i(self, $value); self } - multi method append(intarray:D: int @values) { - nqp::splice(self,@values,nqp::elems(self),0) + multi method append(intarray:D: intarray:D $values) is default { + nqp::splice(self,$values,nqp::elems(self),0) } multi method append(intarray:D: @values) { fail X::Cannot::Lazy.new(:action, :what(self.^name)) From a0f29e0dfad7f4e567360b62c3a55fe7f45d1ded Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Wed, 11 Oct 2017 14:14:44 +0000 Subject: [PATCH 429/692] Bump NQP --- tools/build/NQP_REVISION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/build/NQP_REVISION b/tools/build/NQP_REVISION index 518d6e4dc7e..36554779f72 100644 --- a/tools/build/NQP_REVISION +++ b/tools/build/NQP_REVISION @@ -1 +1 @@ -2017.09-77-g26abb15 +2017.09-84-ge9bca38 From 25c87d0d1c343d60644f84d04dae865357731bc5 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Wed, 11 Oct 2017 19:16:10 +0000 Subject: [PATCH 430/692] Blow up Failures in Duration.new Otherwise we end up binding it to Rat attribute and it explodes only later, producing really confusing errors --- src/core/Duration.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/Duration.pm b/src/core/Duration.pm index 22df487268f..88cc2b2fb57 100644 --- a/src/core/Duration.pm +++ b/src/core/Duration.pm @@ -3,7 +3,7 @@ my class Duration is Cool does Real { # A linear count of seconds. method new($tai) { - nqp::p6bindattrinvres(nqp::create(Duration),Duration,'$!tai',$tai.Rat) + nqp::p6bindattrinvres(nqp::create(Duration),Duration,'$!tai',$tai.Rat.self) # .self blows up Failures } method Bridge(Duration:D:) { $!tai.Num } From 5d3ebc09bab048f2fd2d7e680107a015b753a613 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Wed, 11 Oct 2017 19:37:23 +0000 Subject: [PATCH 431/692] Test Duration.new with bad args does not mention guts RT#127341: https://rt.perl.org/Ticket/Display.html?id=127341 --- t/05-messages/01-errors.t | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/t/05-messages/01-errors.t b/t/05-messages/01-errors.t index 06083e5cd52..2f15adeb345 100644 --- a/t/05-messages/01-errors.t +++ b/t/05-messages/01-errors.t @@ -238,6 +238,11 @@ subtest '`IO::Socket::INET.new: :listen` fails with useful error' => { throws-like 「use v5」, X::Language::Unsupported, '`use v5` in code does not try to load non-existent modules'; +# RT#127341 +is-run 'Duration.new: Inf; Duration.new: "meow"', + :out{not .contains: '$!tai'}, :err{not .contains: '$!tai'}, :status(*), + 'Duration.new with bad args does not reference guts'; + done-testing; # vim: ft=perl6 expandtab sw=4 From de564a51b843370bfcaed13ce928d7354b8a2199 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Wed, 11 Oct 2017 17:28:18 -0400 Subject: [PATCH 432/692] Add S32-io/dir-stress.t to list of test files to run --- t/spectest.data | 1 + 1 file changed, 1 insertion(+) diff --git a/t/spectest.data b/t/spectest.data index d9c9a3c7f97..6d9fd792c1b 100644 --- a/t/spectest.data +++ b/t/spectest.data @@ -1002,6 +1002,7 @@ S32-io/chdir.t S32-io/chdir-process.t # moar S32-io/copy.t S32-io/dir.t +S32-io/dir-stress.t # stress S32-io/file-tests.t S32-io/indir.t S32-io/io-cathandle.t From 50a674346bc442637841311e1987f7ff0f730d97 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Wed, 11 Oct 2017 18:08:15 -0400 Subject: [PATCH 433/692] Remove trailing whitespace --- src/RESTRICTED.setting | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/RESTRICTED.setting b/src/RESTRICTED.setting index b983147943e..5e07dbd37cc 100644 --- a/src/RESTRICTED.setting +++ b/src/RESTRICTED.setting @@ -27,7 +27,7 @@ sub RENAME-PATH { restricted('rename') } sub SYMLINK-PATH { restricted('symlink') } sub UNLINK-PATH { restricted('unlink') } -my class RESTRICTED-CLASS is Mu { +my class RESTRICTED-CLASS is Mu { method FALLBACK(|) { restricted(self.^name) } method new(|) { restricted(self.^name) } method gist(|) { restricted(self.^name) } From 4b8a0ef651435dfd0ba17264c394389b8b92fe57 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Wed, 11 Oct 2017 18:08:28 -0400 Subject: [PATCH 434/692] Remove classes we no longer have in core --- src/RESTRICTED.setting | 6 ------ 1 file changed, 6 deletions(-) diff --git a/src/RESTRICTED.setting b/src/RESTRICTED.setting index 5e07dbd37cc..c05e32c8488 100644 --- a/src/RESTRICTED.setting +++ b/src/RESTRICTED.setting @@ -33,10 +33,7 @@ my class RESTRICTED-CLASS is Mu { method gist(|) { restricted(self.^name) } } -my class IO::Dir is RESTRICTED-CLASS { } -my class IO::File is RESTRICTED-CLASS { } my class IO::Handle is RESTRICTED-CLASS { } -my class IO::Local is RESTRICTED-CLASS { } my class IO::Path is RESTRICTED-CLASS { } my class IO::Pipe is RESTRICTED-CLASS { } my class IO::Socket is RESTRICTED-CLASS { } @@ -50,6 +47,3 @@ my role RESTRICTED-ROLE { method new(|) { restricted(self.^name) } method gist(|) { restricted(self.^name) } } - -my role IO::Pathy does RESTRICTED-ROLE { } -my role PIO does RESTRICTED-ROLE { } From cc2a064395aa4849208bb553bda699b8252c910f Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Thu, 12 Oct 2017 15:26:42 +0200 Subject: [PATCH 435/692] Extract some Seq methods onto a Sequence role This will also be done by HyperSeq and RaceSeq, after upcoming changes to how they are implemented. --- src/core/Seq.pm | 70 +------------------------------- src/core/Sequence.pm | 76 +++++++++++++++++++++++++++++++++++ tools/build/jvm_core_sources | 1 + tools/build/moar_core_sources | 1 + 4 files changed, 79 insertions(+), 69 deletions(-) create mode 100644 src/core/Sequence.pm diff --git a/src/core/Seq.pm b/src/core/Seq.pm index a7a3c891d80..e2c94f569ce 100644 --- a/src/core/Seq.pm +++ b/src/core/Seq.pm @@ -1,38 +1,6 @@ -# A Seq represents anything that can lazily produce a sequence of values. A -# Seq is born in a state where iterating it will consume the values. However, -# calling .cache on a Seq will return a List that will lazily reify to the -# values in the Seq. The List is memoized, so that subsequent calls to .cache -# will always return the same List (safe thanks to List being immutable). More -# than one call to .iterator throws an exception (and calling .cache calls the -# .iterator method the first time also). The memoization can be avoided by -# asking very specifically for the Seq to be coerced to a List (using .List or .list), a -# Slip (.Slip) or an Array (.Array). The actual memoization functionality is -# factored out into a role, PositionalBindFailover, which is used by the binder -# to identify types that, on failure to bind to an @-sigilled thing, can have -# .cache called on them and expect memoization semantics. This not only makes -# it easy for HyperSeq to also have this functionality, but makes it available -# for other kinds of paradigm that show up in the future (beyond sequential -# and parallel) that also want to have this behavior. -my $in_deprecation; my class X::Seq::Consumed { ... } my class X::Seq::NotIndexable { ... } -my role PositionalBindFailover { - has $!list; - - method cache() { - $!list.DEFINITE - ?? $!list - !! ($!list := List.from-iterator(self.iterator)) - } - multi method list(::?CLASS:D:) { - List.from-iterator(self.iterator) - } - - method iterator() { ... } -} -nqp::p6configposbindfailover(Positional, PositionalBindFailover); # Binder -Routine.'!configure_positional_bind_failover'(Positional, PositionalBindFailover); # Multi-dispatch -my class Seq is Cool does Iterable does PositionalBindFailover { +my class Seq is Cool does Iterable does Sequence { # The underlying iterator that iterating this sequence will work its # way through. Can only be obtained once. has Iterator $!iter; @@ -74,10 +42,6 @@ my class Seq is Cool does Iterable does PositionalBindFailover { ) } - multi method eager(Seq:D:) { List.from-iterator(self.iterator).eager } - multi method List(Seq:D:) { List.from-iterator(self.iterator) } - multi method Slip(Seq:D:) { Slip.from-iterator(self.iterator) } - multi method Array(Seq:D:) { Array.from-iterator(self.iterator) } multi method Seq(Seq:D:) { self } method Capture() { @@ -128,22 +92,6 @@ my class Seq is Cool does Iterable does PositionalBindFailover { ) } - multi method Str(Seq:D:) { - self.cache.Str - } - - multi method Stringy(Seq:D:) { - self.cache.Stringy - } - - method fmt(|c) { - self.cache.fmt(|c) - } - - multi method gist(Seq:D:) { - self.cache.gist - } - multi method perl(Seq:D \SELF:) { # If we don't have an iterator, someone grabbed it already; # Check for cached $!list; if that's missing too, we're consumed @@ -198,22 +146,6 @@ my class Seq is Cool does Iterable does PositionalBindFailover { ) } - multi method AT-POS(Seq:D: Int $idx) is raw { - self.cache.AT-POS($idx) - } - - multi method AT-POS(Seq:D: int $idx) is raw { - self.cache.AT-POS($idx) - } - - multi method EXISTS-POS(Seq:D: Int $idx) { - self.cache.EXISTS-POS($idx) - } - - multi method EXISTS-POS(Seq:D: int $idx) { - self.cache.EXISTS-POS($idx) - } - proto method from-loop(|) { * } multi method from-loop(&body) { Seq.new(Rakudo::Iterator.Loop(&body)) diff --git a/src/core/Sequence.pm b/src/core/Sequence.pm new file mode 100644 index 00000000000..0c7317a1007 --- /dev/null +++ b/src/core/Sequence.pm @@ -0,0 +1,76 @@ +# A Sequence represents anything that can lazily produce a sequence of values. +# There are various concrete implementations of Sequence, the most common +# being Seq, which represents a sequentially produced sequence. +# +# Sequences are born in a state where iterating them will consume the values. +# However, calling .cache will return a List that will lazily reify to the +# values in the Sequence. The List is memoized, so that subsequent calls to +# .cache will always return the same List (safe as List is immutable). More +# than one call to .iterator throws an exception (and calling .cache calls the +# .iterator method the first time also). The memoization can be avoided by +# asking very specifically for the Seq to be coerced to a List (using .List +# or .list), a Slip (.Slip) or an Array (.Array). +# +# The actual memoization functionality is factored out into a role, +# PositionalBindFailover, which is used by the binder to identify types that, +# on failure to bind to an @-sigilled thing, can have .cache called on them +# and get memoization semantics. This decouples this functionality from the +# Sequence role, so other user-defined types can get access to this +# functionality. + +my role PositionalBindFailover { + has $!list; + + method cache() { + $!list.DEFINITE + ?? $!list + !! ($!list := List.from-iterator(self.iterator)) + } + multi method list(::?CLASS:D:) { + List.from-iterator(self.iterator) + } + + method iterator() { ... } +} +nqp::p6configposbindfailover(Positional, PositionalBindFailover); # Binder +Routine.'!configure_positional_bind_failover'(Positional, PositionalBindFailover); # Multi-dispatch + +my role Sequence does PositionalBindFailover { + multi method Array(::?CLASS:D:) { Array.from-iterator(self.iterator) } + multi method List(::?CLASS:D:) { List.from-iterator(self.iterator) } + multi method Slip(::?CLASS:D:) { Slip.from-iterator(self.iterator) } + + multi method Str(::?CLASS:D:) { + self.cache.Str + } + + multi method Stringy(::?CLASS:D:) { + self.cache.Stringy + } + + multi method AT-POS(::?CLASS:D: Int $idx) is raw { + self.cache.AT-POS($idx) + } + + multi method AT-POS(::?CLASS:D: int $idx) is raw { + self.cache.AT-POS($idx) + } + + multi method EXISTS-POS(::?CLASS:D: Int $idx) { + self.cache.EXISTS-POS($idx) + } + + multi method EXISTS-POS(::?CLASS:D: int $idx) { + self.cache.EXISTS-POS($idx) + } + + multi method eager(::?CLASS:D:) { List.from-iterator(self.iterator).eager } + + method fmt(|c) { + self.cache.fmt(|c) + } + + multi method gist(::?CLASS:D:) { + self.cache.gist + } +} diff --git a/tools/build/jvm_core_sources b/tools/build/jvm_core_sources index 36499c38d66..0764e44b26e 100644 --- a/tools/build/jvm_core_sources +++ b/tools/build/jvm_core_sources @@ -57,6 +57,7 @@ src/core/Capture.pm src/core/IterationBuffer.pm src/core/HyperConfiguration.pm src/core/HyperWorkBuffer.pm +src/core/Sequence.pm src/core/Seq.pm src/core/HyperSeq.pm src/core/Nil.pm diff --git a/tools/build/moar_core_sources b/tools/build/moar_core_sources index 693dbcaa0e0..88f0c2ee45d 100644 --- a/tools/build/moar_core_sources +++ b/tools/build/moar_core_sources @@ -59,6 +59,7 @@ src/core/Capture.pm src/core/IterationBuffer.pm src/core/HyperConfiguration.pm src/core/HyperWorkBuffer.pm +src/core/Sequence.pm src/core/Seq.pm src/core/HyperSeq.pm src/core/Nil.pm From 37689a3e57cafaa3b27cacec74d902b4ca11c9e0 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Thu, 12 Oct 2017 10:09:46 -0400 Subject: [PATCH 436/692] Add MISC/bug-coverage-stress.t to list of files to run --- t/spectest.data | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/t/spectest.data b/t/spectest.data index 6d9fd792c1b..e064f7d4650 100644 --- a/t/spectest.data +++ b/t/spectest.data @@ -20,7 +20,7 @@ # See the "make quicktest" and "make stresstest" targets in # build/Makefile.in for examples of use. - +MISC/bug-coverage-stress.t # stress S01-perl-5-integration/array.t # perl5 S01-perl-5-integration/basic.t # perl5 S01-perl-5-integration/class.t # perl5 From 1a97c44be66382aa56cfb7bdbe360a88f2d61363 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Thu, 12 Oct 2017 17:13:01 -0400 Subject: [PATCH 437/692] Replace cryptic code with direct <.ws> call --- src/Perl6/Grammar.nqp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Perl6/Grammar.nqp b/src/Perl6/Grammar.nqp index 730b764eb36..e4c92f73084 100644 --- a/src/Perl6/Grammar.nqp +++ b/src/Perl6/Grammar.nqp @@ -1234,7 +1234,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD { :dba('statement list') # <.check_LANG_oopsies('statementlist')> - '' + <.ws> # Define this scope to be a new language. [ From f72be0f130cf0013077d7b654b8954db49664310 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Thu, 12 Oct 2017 20:09:32 -0400 Subject: [PATCH 438/692] Remove dir-stress test file It was consolidated with other lone bug cover stresstests in https://github.com/perl6/roast/commit/bcaaad4d42 --- t/spectest.data | 1 - 1 file changed, 1 deletion(-) diff --git a/t/spectest.data b/t/spectest.data index e064f7d4650..f81799e3fdd 100644 --- a/t/spectest.data +++ b/t/spectest.data @@ -1002,7 +1002,6 @@ S32-io/chdir.t S32-io/chdir-process.t # moar S32-io/copy.t S32-io/dir.t -S32-io/dir-stress.t # stress S32-io/file-tests.t S32-io/indir.t S32-io/io-cathandle.t From 969853c673a7a5e3d925248c0ff7abdbd563441f Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Fri, 13 Oct 2017 06:03:06 -0400 Subject: [PATCH 439/692] Use actual test plan --- t/05-messages/01-errors.t | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/t/05-messages/01-errors.t b/t/05-messages/01-errors.t index 2f15adeb345..f2e345b38b3 100644 --- a/t/05-messages/01-errors.t +++ b/t/05-messages/01-errors.t @@ -2,6 +2,8 @@ use lib ; use Test; use Test::Helpers; +plan 44; + # RT #129763 throws-like '1++', X::Multi::NoMatch, message => /'but require mutable arguments'/, @@ -243,6 +245,4 @@ is-run 'Duration.new: Inf; Duration.new: "meow"', :out{not .contains: '$!tai'}, :err{not .contains: '$!tai'}, :status(*), 'Duration.new with bad args does not reference guts'; -done-testing; - # vim: ft=perl6 expandtab sw=4 From fb7abf064e1db251411f8e8343145459c4b13b66 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Fri, 13 Oct 2017 06:14:33 -0400 Subject: [PATCH 440/692] Test sane error when missing variables with my and where RT#125902: https://rt.perl.org/Public/Bug/Display.html?id=125902 --- t/05-messages/01-errors.t | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/t/05-messages/01-errors.t b/t/05-messages/01-errors.t index f2e345b38b3..d82c734056f 100644 --- a/t/05-messages/01-errors.t +++ b/t/05-messages/01-errors.t @@ -2,7 +2,7 @@ use lib ; use Test; use Test::Helpers; -plan 44; +plan 45; # RT #129763 throws-like '1++', X::Multi::NoMatch, @@ -245,4 +245,9 @@ is-run 'Duration.new: Inf; Duration.new: "meow"', :out{not .contains: '$!tai'}, :err{not .contains: '$!tai'}, :status(*), 'Duration.new with bad args does not reference guts'; +# RT#125902 +is-run 「my Str where 'foo' $test」, :status(*), + :err{.contains: 「forget a variable」 and not .contains: 「Did you mean 'Str'」}, +'sane error when missing variables with my and where'; + # vim: ft=perl6 expandtab sw=4 From 975fcf6cfd8089bfc237c40ff1db35fec474331e Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Fri, 13 Oct 2017 13:13:40 +0200 Subject: [PATCH 441/692] Fix for RT #132279 Cannot be sure we have int64 range on BagHash --- src/core/Rakudo/QuantHash.pm | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/src/core/Rakudo/QuantHash.pm b/src/core/Rakudo/QuantHash.pm index a7f70db1226..7b1fabcb624 100644 --- a/src/core/Rakudo/QuantHash.pm +++ b/src/core/Rakudo/QuantHash.pm @@ -499,10 +499,7 @@ my class Rakudo::QuantHash { nqp::stmts( (my $iter := Rakudo::QuantHash.BAG-ROLL(elems,total)), nqp::if( - nqp::iseq_i( - (my $value := nqp::getattr(nqp::iterval($iter),Pair,'$!value')), - 1 - ), + (my $value := nqp::getattr(nqp::iterval($iter),Pair,'$!value')) == 1, nqp::stmts( # going to 0, so remove (my $object := nqp::getattr(nqp::iterval($iter),Pair,'$!key')), nqp::deletekey(elems,nqp::iterkey_s($iter)), @@ -513,7 +510,7 @@ my class Rakudo::QuantHash { nqp::iterval($iter), Pair, '$!value', - nqp::sub_i($value,1) + $value - 1 ), nqp::getattr(nqp::iterval($iter),Pair,'$!key') ) From b3bb8c406a58b9dd51de7096e6ca33bc02d4d8ec Mon Sep 17 00:00:00 2001 From: MasterDuke17 Date: Fri, 13 Oct 2017 09:25:25 -0400 Subject: [PATCH 442/692] Correctly explain why couldn't instantiate a role This broke when Exceptions were changed to not create their message unless .gist'ed. Fixes RT #132285. --- src/Perl6/Metamodel/ParametricRoleHOW.nqp | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Perl6/Metamodel/ParametricRoleHOW.nqp b/src/Perl6/Metamodel/ParametricRoleHOW.nqp index e4db3d0912d..6f910f56897 100644 --- a/src/Perl6/Metamodel/ParametricRoleHOW.nqp +++ b/src/Perl6/Metamodel/ParametricRoleHOW.nqp @@ -150,7 +150,8 @@ class Perl6::Metamodel::ParametricRoleHOW } } if $error { - nqp::die("Could not instantiate role '" ~ self.name($obj) ~ "':\n$error") + nqp::die("Could not instantiate role '" ~ self.name($obj) + ~ "':\n" ~ nqp::getpayload($error)) } # Use it to build concrete role. From e611978f5401582499a659918655c0eefcfee117 Mon Sep 17 00:00:00 2001 From: MasterDuke17 Date: Fri, 13 Oct 2017 10:39:56 -0400 Subject: [PATCH 443/692] Test RT132285, correct error for Blob with num32 --- t/05-messages/01-errors.t | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/t/05-messages/01-errors.t b/t/05-messages/01-errors.t index d82c734056f..1a8614d1df0 100644 --- a/t/05-messages/01-errors.t +++ b/t/05-messages/01-errors.t @@ -2,7 +2,7 @@ use lib ; use Test; use Test::Helpers; -plan 45; +plan 46; # RT #129763 throws-like '1++', X::Multi::NoMatch, @@ -250,4 +250,10 @@ is-run 「my Str where 'foo' $test」, :status(*), :err{.contains: 「forget a variable」 and not .contains: 「Did you mean 'Str'」}, 'sane error when missing variables with my and where'; +# RT#132285 +throws-like 「Blob[num32].new: 2e0」, + Exception, + :message{ .contains: 「not yet implemented」 & 「num32」 and not .contains: 「got null」 }, + 'sane error for num32 Blob'; + # vim: ft=perl6 expandtab sw=4 From 4473591b0a30004edd93b3d5cbc0db70a1855b40 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Fri, 13 Oct 2017 13:04:17 -0400 Subject: [PATCH 444/692] Add NYI to test description So that when it is implemented the failure of the test would be more informative as to why it's failing. --- t/05-messages/01-errors.t | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/t/05-messages/01-errors.t b/t/05-messages/01-errors.t index 1a8614d1df0..dd7b282af89 100644 --- a/t/05-messages/01-errors.t +++ b/t/05-messages/01-errors.t @@ -254,6 +254,6 @@ is-run 「my Str where 'foo' $test」, :status(*), throws-like 「Blob[num32].new: 2e0」, Exception, :message{ .contains: 「not yet implemented」 & 「num32」 and not .contains: 「got null」 }, - 'sane error for num32 Blob'; + 'sane NYI error for num32 Blob'; # vim: ft=perl6 expandtab sw=4 From 80cee3622363481f21a6c1f12da1a23a2606d5c8 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Fri, 13 Oct 2017 13:06:36 -0400 Subject: [PATCH 445/692] Test callframe.my throws sane NYI error message RT#77754: https://rt.perl.org/Ticket/Display.html?id=77754 --- t/05-messages/01-errors.t | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/t/05-messages/01-errors.t b/t/05-messages/01-errors.t index dd7b282af89..f3c2c32cb92 100644 --- a/t/05-messages/01-errors.t +++ b/t/05-messages/01-errors.t @@ -2,7 +2,7 @@ use lib ; use Test; use Test::Helpers; -plan 46; +plan 47; # RT #129763 throws-like '1++', X::Multi::NoMatch, @@ -256,4 +256,8 @@ throws-like 「Blob[num32].new: 2e0」, :message{ .contains: 「not yet implemented」 & 「num32」 and not .contains: 「got null」 }, 'sane NYI error for num32 Blob'; +# RT#77754 +throws-like 「callframe.callframe(1).my.perl」, X::NYI, + 'callframe.my throws sane NYI error message'; + # vim: ft=perl6 expandtab sw=4 From 3acde358c1421511f124b6a45755d0422ae4bdff Mon Sep 17 00:00:00 2001 From: Samantha McVey Date: Fri, 13 Oct 2017 10:27:19 -0700 Subject: [PATCH 446/692] Show hex value as well as dec in char() error message When char() is requested to too large a value, also show the hex value and not just the decimal one. --- src/core/Int.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/Int.pm b/src/core/Int.pm index 6b2e087a1bf..e2cf598f196 100644 --- a/src/core/Int.pm +++ b/src/core/Int.pm @@ -69,7 +69,7 @@ my class Int does Real { # declared in BOOTSTRAP method chr(Int:D:) { nqp::if( nqp::isbig_I(self), - (die "chr codepoint too large: {self}"), + die("chr codepoint %i (0x%X) is too large".sprintf(self, self)), nqp::p6box_s(nqp::chr(nqp::unbox_i(self))) ) } From 7bea3a2dddcfc11908fe0002f1f8d34e8fac2497 Mon Sep 17 00:00:00 2001 From: Samantha McVey Date: Fri, 13 Oct 2017 11:11:37 -0700 Subject: [PATCH 447/692] Add .parent(Int) for getting up more than one level .parent only gets the path one level up. Now .parent(Int) will get the nth parent of the requested directory. This is different than adding ../ to the path as when there are links it acts differently. In addition: `Path::IO.add('../').absolute ne Path::IO.parent.absolute` --- src/core/IO/Path.pm | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/src/core/IO/Path.pm b/src/core/IO/Path.pm index 51031a5eb99..bbf75d63872 100644 --- a/src/core/IO/Path.pm +++ b/src/core/IO/Path.pm @@ -326,8 +326,15 @@ my class IO::Path is Cool does IO { $resolved = $sep unless nqp::chars($resolved); IO::Path!new-from-absolute-path($resolved,:$!SPEC,:CWD($sep)); } - - method parent(IO::Path:D:) { # XXX needs work + proto method parent(|) { * } + multi method parent(IO::Path:D: Int:D $depth) { + die "method parent(IO::Path:D: Int:D) can only be called with non-negative integers" + if $depth < 0; + my $io = self; + $io .= parent xx $depth; + $io; + } + multi method parent(IO::Path:D:) { # XXX needs work my $curdir := $!SPEC.curdir; my $updir := $!SPEC.updir; From bc5fbfcbf5a2738c35b2f735c96cf736e83d105a Mon Sep 17 00:00:00 2001 From: David Warring Date: Sat, 14 Oct 2017 09:06:07 +1300 Subject: [PATCH 448/692] optimize recently added AT-POS for typed pointers inline the add method and subsequent calls to nativecast and Int and add methods. Improves performance by 4-5x. --- lib/NativeCall/Types.pm6 | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/lib/NativeCall/Types.pm6 b/lib/NativeCall/Types.pm6 index 5c2c8139936..13bd2e61b46 100644 --- a/lib/NativeCall/Types.pm6 +++ b/lib/NativeCall/Types.pm6 @@ -68,7 +68,12 @@ our class Pointer is repr('CPointer') { self.add(-1); } method AT-POS(Int $pos) { - self.add($pos).deref; + nqp::nativecallcast( + TValue, + nqp::istype(TValue, Int) ?? Int + !! nqp::istype(TValue, Num) ?? Num !! TValue, + nqp::box_i(nqp::unbox_i(nqp::decont(self)) + nqp::nativecallsizeof(TValue) * $pos, Pointer) + ) } } method ^parameterize(Mu:U \p, Mu:U \t) { From 012c80f33607d1d3fadc2a4c002928d790b5d6b0 Mon Sep 17 00:00:00 2001 From: Nick Logan Date: Fri, 13 Oct 2017 18:06:56 -0400 Subject: [PATCH 449/692] Remove unused variable --- src/core/ThreadPoolScheduler.pm | 1 - 1 file changed, 1 deletion(-) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index f054a8a69cc..57853dc9708 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -386,7 +386,6 @@ my class ThreadPoolScheduler does Scheduler { # Otherwise, check if the queue beats the threshold to add another # worker thread. my $chosen-queue := $most-free-worker.queue; - my $queue-elems = $chosen-queue.elems; my $threshold = @affinity-add-thresholds[ ($cur-affinity-workers.elems min @affinity-add-thresholds) - 1 ]; From 1761540e9620cbc757325fe7eae55be3601ef203 Mon Sep 17 00:00:00 2001 From: Daniel Green Date: Tue, 10 Oct 2017 21:23:43 -0400 Subject: [PATCH 450/692] Break apart INTERPOLATE into obvious multis These required minimal code changes to the original method. --- src/core/Match.pm | 355 +++++++++++++++++++++++----------------------- 1 file changed, 179 insertions(+), 176 deletions(-) diff --git a/src/core/Match.pm b/src/core/Match.pm index a496e8c5ee7..5f67bc98e71 100644 --- a/src/core/Match.pm +++ b/src/core/Match.pm @@ -203,208 +203,211 @@ my class Match is Capture is Cool does NQPMatchRole { # INTERPOLATE's parameters are non-optional since the ops for optional params # aren't currently JITted on MoarVM - method INTERPOLATE(\var, int $i, int $m, int $monkey, int $s, int $a, $context) { - if nqp::isconcrete(var) { - # Call it if it is a routine. This will capture if requested. - return (var)(self) if nqp::istype(var,Callable); - - my $maxmatch; - my $cur := self.'!cursor_start_cur'(); - my str $tgt = $cur.target; - my int $eos = nqp::chars($tgt); - - my int $maxlen = -1; - my int $pos = nqp::getattr_i($cur, $?CLASS, '$!from'); - my int $start = 1; - my int $nomod = !($i || $m); - - my Mu $order := nqp::list(); - - # Looks something we need to loop over - if nqp::istype(var, Iterable) and !nqp::iscont(var) { - my $varlist := var.list; - my int $elems = $varlist.elems; # reifies - my $list := nqp::getattr($varlist,List,'$!reified'); - - # Order matters for sequential matching, so no NFA involved. - if $s { - $order := $list; - } + proto method INTERPOLATE(|) { * } - # prepare to run the NFA if var is array-ish. - else { - my Mu $nfa := QRegex::NFA.new; - my Mu $alts := nqp::setelems(nqp::list,$elems); - my int $fate = 0; - my int $j = -1; - - while nqp::islt_i(++$j,$elems) { - my Mu $topic := nqp::atpos($list,$j); - nqp::bindpos($alts,$j,$topic); - - # We are in a regex assertion, the strings we get will - # be treated as regex rules. - if $a { - return $cur.'!cursor_start_cur'() - if nqp::istype($topic,Associative); - - my $rx := MAKE_REGEX($topic,$i,$m,$monkey,$context); - $nfa.mergesubstates($start,0,nqp::decont($fate), - nqp::findmethod($rx,'NFA')($rx), - Mu); - } + multi method INTERPOLATE(Callable:D \var, int $i, int $m, int $monkey, int $s, int $a, $context) { + # Call it if it is a routine. This will capture if requested. + (var)(self) + } - # A Regex already. - elsif nqp::istype($topic,Regex) { - $nfa.mergesubstates($start,0,nqp::decont($fate), - nqp::findmethod($topic,'NFA')($topic), - Mu); - } + multi method INTERPOLATE(Mu:D \var, int $i, int $m, int $monkey, int $s, int $a, $context) { + my $maxmatch; + my $cur := self.'!cursor_start_cur'(); + my str $tgt = $cur.target; + my int $eos = nqp::chars($tgt); - # The pattern is a string. - else { - my Mu $lit := QAST::Regex.new( - :rxtype, $topic, - :subtype( $nomod - ?? '' - !! $m - ?? $i - ?? 'ignorecase+ignoremark' - !! 'ignoremark' - !! 'ignorecase') - ); - my Mu $nfa2 := QRegex::NFA.new; - my Mu $node := nqp::findmethod($nfa2,'addnode')($nfa2,$lit); - $nfa.mergesubstates($start,0,nqp::decont($fate), - nqp::findmethod($node,'save')($node,:non_empty(1)), - Mu); - } - ++$fate; - } + my int $maxlen = -1; + my int $pos = nqp::getattr_i($cur, $?CLASS, '$!from'); + my int $start = 1; + my int $nomod = !($i || $m); - # Now run the NFA - my Mu $fates := nqp::findmethod($nfa,'run')($nfa,$tgt,$pos); - my int $count = nqp::elems($fates); - nqp::setelems($order,$count); - $j = -1; - nqp::bindpos($order,$j, - nqp::atpos($alts,nqp::atpos_i($fates,$j))) - while nqp::islt_i(++$j,$count); - } + my Mu $order := nqp::list(); + + # Looks something we need to loop over + if nqp::istype(var, Iterable) and !nqp::iscont(var) { + my $varlist := var.list; + my int $elems = $varlist.elems; # reifies + my $list := nqp::getattr($varlist,List,'$!reified'); + + # Order matters for sequential matching, so no NFA involved. + if $s { + $order := $list; } - # Use the var as it is if it's not array-ish. + # prepare to run the NFA if var is array-ish. else { - nqp::push($order, var); - } + my Mu $nfa := QRegex::NFA.new; + my Mu $alts := nqp::setelems(nqp::list,$elems); + my int $fate = 0; + my int $j = -1; + + while nqp::islt_i(++$j,$elems) { + my Mu $topic := nqp::atpos($list,$j); + nqp::bindpos($alts,$j,$topic); + + # We are in a regex assertion, the strings we get will + # be treated as regex rules. + if $a { + return $cur.'!cursor_start_cur'() + if nqp::istype($topic,Associative); + + my $rx := MAKE_REGEX($topic,$i,$m,$monkey,$context); + $nfa.mergesubstates($start,0,nqp::decont($fate), + nqp::findmethod($rx,'NFA')($rx), + Mu); + } - my str $topic_str; - my int $omax = nqp::elems($order); - my int $o = -1; - while nqp::islt_i(++$o,$omax) { - my Mu $topic := nqp::atpos($order,$o); - my $match; - my int $len; - - # We are in a regex assertion, the strings we get will be - # treated as regex rules. - if $a { - return $cur.'!cursor_start_cur'() - if nqp::istype($topic,Associative); - - my $rx := MAKE_REGEX($topic,$i,$m,$monkey,$context); - $match := self.$rx; - $len = $match.pos - $match.from; - } + # A Regex already. + elsif nqp::istype($topic,Regex) { + $nfa.mergesubstates($start,0,nqp::decont($fate), + nqp::findmethod($topic,'NFA')($topic), + Mu); + } - # A Regex already. - elsif nqp::istype($topic,Regex) { - $match := self.$topic; - $len = $match.pos - $match.from; + # The pattern is a string. + else { + my Mu $lit := QAST::Regex.new( + :rxtype, $topic, + :subtype( $nomod + ?? '' + !! $m + ?? $i + ?? 'ignorecase+ignoremark' + !! 'ignoremark' + !! 'ignorecase') + ); + my Mu $nfa2 := QRegex::NFA.new; + my Mu $node := nqp::findmethod($nfa2,'addnode')($nfa2,$lit); + $nfa.mergesubstates($start,0,nqp::decont($fate), + nqp::findmethod($node,'save')($node,:non_empty(1)), + Mu); + } + ++$fate; } - # The pattern is a string. $len and and $topic_str are used - # later on if this condition does not hold. - elsif nqp::iseq_i(($len = nqp::chars($topic_str = $topic.Str)),0) { - $match = 1; - } + # Now run the NFA + my Mu $fates := nqp::findmethod($nfa,'run')($nfa,$tgt,$pos); + my int $count = nqp::elems($fates); + nqp::setelems($order,$count); + $j = -1; + nqp::bindpos($order,$j, + nqp::atpos($alts,nqp::atpos_i($fates,$j))) + while nqp::islt_i(++$j,$count); + } + } - # no modifier, match literally - elsif $nomod { - $match = nqp::eqat($tgt, $topic_str, $pos); - } + # Use the var as it is if it's not array-ish. + else { + nqp::push($order, var); + } + + my str $topic_str; + my int $omax = nqp::elems($order); + my int $o = -1; + while nqp::islt_i(++$o,$omax) { + my Mu $topic := nqp::atpos($order,$o); + my $match; + my int $len; + + # We are in a regex assertion, the strings we get will be + # treated as regex rules. + if $a { + return $cur.'!cursor_start_cur'() + if nqp::istype($topic,Associative); + + my $rx := MAKE_REGEX($topic,$i,$m,$monkey,$context); + $match := self.$rx; + $len = $match.pos - $match.from; + } + + # A Regex already. + elsif nqp::istype($topic,Regex) { + $match := self.$topic; + $len = $match.pos - $match.from; + } + + # The pattern is a string. $len and and $topic_str are used + # later on if this condition does not hold. + elsif nqp::iseq_i(($len = nqp::chars($topic_str = $topic.Str)),0) { + $match = 1; + } + + # no modifier, match literally + elsif $nomod { + $match = nqp::eqat($tgt, $topic_str, $pos); + } #?if moar - # ignoremark+ignorecase - elsif $m && $i { - $match = nqp::eqaticim($tgt, $topic_str, $pos); - } + # ignoremark+ignorecase + elsif $m && $i { + $match = nqp::eqaticim($tgt, $topic_str, $pos); + } - # ignoremark - elsif $m { - $match = nqp::eqatim($tgt, $topic_str, $pos); - } + # ignoremark + elsif $m { + $match = nqp::eqatim($tgt, $topic_str, $pos); + } - # ignorecase - elsif $i { - $match = nqp::eqatic($tgt, $topic_str, $pos); - } + # ignorecase + elsif $i { + $match = nqp::eqatic($tgt, $topic_str, $pos); + } #?endif #?if !moar - # ignoremark(+ignorecase?) - elsif $m { - my int $k = -1; - - # ignorecase+ignoremark - if $i { - my str $tgt_fc = nqp::fc(nqp::substr($tgt,$pos,$len)); - my str $topic_fc = nqp::fc($topic_str); - Nil while nqp::islt_i(++$k,$len) - && nqp::iseq_i( - nqp::ordbaseat($tgt_fc, nqp::add_i($pos,$k)), - nqp::ordbaseat($topic_fc, $k) - ); - } - - # ignoremark - else { - Nil while nqp::islt_i(++$k, $len) - && nqp::iseq_i( - nqp::ordbaseat($tgt, nqp::add_i($pos,$k)), - nqp::ordbaseat($topic_str, $k) - ); - } - - $match = nqp::iseq_i($k,$len); # match if completed + # ignoremark(+ignorecase?) + elsif $m { + my int $k = -1; + + # ignorecase+ignoremark + if $i { + my str $tgt_fc = nqp::fc(nqp::substr($tgt,$pos,$len)); + my str $topic_fc = nqp::fc($topic_str); + Nil while nqp::islt_i(++$k,$len) + && nqp::iseq_i( + nqp::ordbaseat($tgt_fc, nqp::add_i($pos,$k)), + nqp::ordbaseat($topic_fc, $k) + ); } - # ignorecase + # ignoremark else { - $match = nqp::iseq_s( - nqp::fc(nqp::substr($tgt, $pos, $len)), - nqp::fc($topic_str) - ) + Nil while nqp::islt_i(++$k, $len) + && nqp::iseq_i( + nqp::ordbaseat($tgt, nqp::add_i($pos,$k)), + nqp::ordbaseat($topic_str, $k) + ); } -#?endif - if $match - && nqp::isgt_i($len,$maxlen) - && nqp::isle_i(nqp::add_i($pos,$len),$eos) { - $maxlen = $len; - $maxmatch := $match; - last if $s; # stop here for sequential alternation - } + $match = nqp::iseq_i($k,$len); # match if completed } - nqp::istype($maxmatch, Match) - ?? $maxmatch - !! nqp::isge_i($maxlen,0) - ?? $cur.'!cursor_pass'(nqp::add_i($pos,$maxlen), '') - !! $cur - } - else { - self."!cursor_start_cur"() + # ignorecase + else { + $match = nqp::iseq_s( + nqp::fc(nqp::substr($tgt, $pos, $len)), + nqp::fc($topic_str) + ) + } +#?endif + + if $match + && nqp::isgt_i($len,$maxlen) + && nqp::isle_i(nqp::add_i($pos,$len),$eos) { + $maxlen = $len; + $maxmatch := $match; + last if $s; # stop here for sequential alternation + } } + + nqp::istype($maxmatch, Match) + ?? $maxmatch + !! nqp::isge_i($maxlen,0) + ?? $cur.'!cursor_pass'(nqp::add_i($pos,$maxlen), '') + !! $cur + } + + multi method INTERPOLATE(Mu:U \var, int $i, int $m, int $monkey, int $s, int $a, $context) { + self."!cursor_start_cur"() } method CALL_SUBRULE($rule, |c) { From 0a68a18f168552989141f65f7697103d2b2cf9ef Mon Sep 17 00:00:00 2001 From: Daniel Green Date: Tue, 10 Oct 2017 21:32:33 -0400 Subject: [PATCH 451/692] Break out an Iterable multi for INTERPOLATE And remove that funcitonality from the main Mu:D multi. --- src/core/Match.pm | 115 +++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 113 insertions(+), 2 deletions(-) diff --git a/src/core/Match.pm b/src/core/Match.pm index 5f67bc98e71..cb32168c821 100644 --- a/src/core/Match.pm +++ b/src/core/Match.pm @@ -210,7 +210,7 @@ my class Match is Capture is Cool does NQPMatchRole { (var)(self) } - multi method INTERPOLATE(Mu:D \var, int $i, int $m, int $monkey, int $s, int $a, $context) { + multi method INTERPOLATE(Iterable:D \var, int $i, int $m, int $monkey, int $s, int $a, $context) { my $maxmatch; my $cur := self.'!cursor_start_cur'(); my str $tgt = $cur.target; @@ -224,7 +224,7 @@ my class Match is Capture is Cool does NQPMatchRole { my Mu $order := nqp::list(); # Looks something we need to loop over - if nqp::istype(var, Iterable) and !nqp::iscont(var) { + if !nqp::iscont(var) { my $varlist := var.list; my int $elems = $varlist.elems; # reifies my $list := nqp::getattr($varlist,List,'$!reified'); @@ -406,6 +406,117 @@ my class Match is Capture is Cool does NQPMatchRole { !! $cur } + multi method INTERPOLATE(Mu:D \var, int $i, int $m, int $monkey, int $s, int $a, $context) { + my $maxmatch; + my $cur := self.'!cursor_start_cur'(); + my str $tgt = $cur.target; + my int $eos = nqp::chars($tgt); + + my int $maxlen = -1; + my int $pos = nqp::getattr_i($cur, $?CLASS, '$!from'); + my int $start = 1; + my int $nomod = !($i || $m); + + my str $topic_str; + my $match; + my int $len; + + # We are in a regex assertion, the strings we get will be + # treated as regex rules. + if $a { + return $cur.'!cursor_start_cur'() + if nqp::istype(var,Associative); + + my $rx := MAKE_REGEX(var,$i,$m,$monkey,$context); + $match := self.$rx; + $len = $match.pos - $match.from; + } + + # A Regex already. + elsif nqp::istype(var,Regex) { + $match := self.var; + $len = $match.pos - $match.from; + } + + # The pattern is a string. $len and and $topic_str are used + # later on if this condition does not hold. + elsif nqp::iseq_i(($len = nqp::chars($topic_str = var.Str)),0) { + $match = 1; + } + + # no modifier, match literally + elsif $nomod { + $match = nqp::eqat($tgt, $topic_str, $pos); + } + +#?if moar + # ignoremark+ignorecase + elsif $m && $i { + $match = nqp::eqaticim($tgt, $topic_str, $pos); + } + + # ignoremark + elsif $m { + $match = nqp::eqatim($tgt, $topic_str, $pos); + } + + # ignorecase + elsif $i { + $match = nqp::eqatic($tgt, $topic_str, $pos); + } +#?endif +#?if !moar + # ignoremark(+ignorecase?) + elsif $m { + my int $k = -1; + + # ignorecase+ignoremark + if $i { + my str $tgt_fc = nqp::fc(nqp::substr($tgt,$pos,$len)); + my str $topic_fc = nqp::fc($topic_str); + Nil while nqp::islt_i(++$k,$len) + && nqp::iseq_i( + nqp::ordbaseat($tgt_fc, nqp::add_i($pos,$k)), + nqp::ordbaseat($topic_fc, $k) + ); + } + + # ignoremark + else { + Nil while nqp::islt_i(++$k, $len) + && nqp::iseq_i( + nqp::ordbaseat($tgt, nqp::add_i($pos,$k)), + nqp::ordbaseat($topic_str, $k) + ); + } + + $match = nqp::iseq_i($k,$len); # match if completed + } + + # ignorecase + else { + $match = nqp::iseq_s( + nqp::fc(nqp::substr($tgt, $pos, $len)), + nqp::fc($topic_str) + ) + } +#?endif + + if $match + && nqp::isgt_i($len,$maxlen) + && nqp::isle_i(nqp::add_i($pos,$len),$eos) { + $maxlen = $len; + $maxmatch := $match; + last if $s; # stop here for sequential alternation + } + + nqp::istype($maxmatch, Match) + ?? $maxmatch + !! nqp::isge_i($maxlen,0) + ?? $cur.'!cursor_pass'(nqp::add_i($pos,$maxlen), '') + !! $cur + } + multi method INTERPOLATE(Mu:U \var, int $i, int $m, int $monkey, int $s, int $a, $context) { self."!cursor_start_cur"() } From d73d500bf4788b8317d57c801ba8f027abd9ae9f Mon Sep 17 00:00:00 2001 From: Daniel Green Date: Wed, 11 Oct 2017 21:44:43 -0400 Subject: [PATCH 452/692] Consolidate $i and $m flags to INTERPOLATE There was one too many parameters to intern the callsite, so the method dispatch wasn't getting cached, so the initial conversion to multis ended up making it 3x slower. --- src/Perl6/Actions.nqp | 11 +++-------- src/core/Match.pm | 43 +++++++++++++++++++++---------------------- 2 files changed, 24 insertions(+), 30 deletions(-) diff --git a/src/Perl6/Actions.nqp b/src/Perl6/Actions.nqp index a486789ba79..f068a0ace40 100644 --- a/src/Perl6/Actions.nqp +++ b/src/Perl6/Actions.nqp @@ -9887,8 +9887,7 @@ class Perl6::RegexActions is QRegex::P6Regex::Actions does STDActions { make QAST::Regex.new(QAST::NodeList.new( QAST::SVal.new( :value('INTERPOLATE') ), $varast, - QAST::IVal.new( :value(%*RX ?? 1 !! 0) ), - QAST::IVal.new( :value(%*RX ?? 1 !! 0) ), + QAST::IVal.new( :value(%*RX && %*RX ?? 3 !! %*RX ?? 2 !! %*RX ?? 1 !! 0) ), QAST::IVal.new( :value(monkey_see_no_eval($/)) ), QAST::IVal.new( :value($*SEQ ?? 1 !! 0) ), QAST::IVal.new( :value(0) ), @@ -9904,8 +9903,7 @@ class Perl6::RegexActions is QRegex::P6Regex::Actions does STDActions { QAST::NodeList.new( QAST::SVal.new( :value('INTERPOLATE') ), $.ast, - QAST::IVal.new( :value(%*RX ?? 1 !! 0) ), - QAST::IVal.new( :value(%*RX ?? 1 !! 0) ), + QAST::IVal.new( :value(%*RX && %*RX ?? 3 !! %*RX ?? 2 !! %*RX ?? 1 !! 0) ), QAST::IVal.new( :value(monkey_see_no_eval($/)) ), QAST::IVal.new( :value($*SEQ ?? 1 !! 0) ), QAST::IVal.new( :value(1) ), @@ -9943,8 +9941,7 @@ class Perl6::RegexActions is QRegex::P6Regex::Actions does STDActions { QAST::NodeList.new( QAST::SVal.new( :value('INTERPOLATE') ), wanted($.ast, 'assertvar2'), - QAST::IVal.new( :value(%*RX ?? 1 !! 0) ), - QAST::IVal.new( :value(%*RX ?? 1 !! 0) ), + QAST::IVal.new( :value(%*RX && %*RX ?? 3 !! %*RX ?? 2 !! %*RX ?? 1 !! 0) ), QAST::IVal.new( :value(monkey_see_no_eval($/)) ), QAST::IVal.new( :value($*SEQ ?? 1 !! 0) ), QAST::IVal.new( :value(1) ), @@ -10107,7 +10104,6 @@ class Perl6::P5RegexActions is QRegex::P5Regex::Actions does STDActions { QAST::SVal.new( :value('INTERPOLATE') ), $.ast, QAST::IVal.new( :value(%*RX ?? 1 !! 0) ), - QAST::IVal.new( :value(0) ), QAST::IVal.new( :value(monkey_see_no_eval($/)) ), QAST::IVal.new( :value($*SEQ ?? 1 !! 0) ), QAST::IVal.new( :value($*INTERPOLATION) ), @@ -10124,7 +10120,6 @@ class Perl6::P5RegexActions is QRegex::P5Regex::Actions does STDActions { QAST::SVal.new( :value('INTERPOLATE') ), wanted($.ast, 'p5var'), QAST::IVal.new( :value(%*RX ?? 1 !! 0) ), - QAST::IVal.new( :value(0) ), QAST::IVal.new( :value(monkey_see_no_eval($/)) ), QAST::IVal.new( :value($*SEQ ?? 1 !! 0) ), QAST::IVal.new( :value($*INTERPOLATION) ), diff --git a/src/core/Match.pm b/src/core/Match.pm index cb32168c821..9648c3aff98 100644 --- a/src/core/Match.pm +++ b/src/core/Match.pm @@ -205,12 +205,12 @@ my class Match is Capture is Cool does NQPMatchRole { # aren't currently JITted on MoarVM proto method INTERPOLATE(|) { * } - multi method INTERPOLATE(Callable:D \var, int $i, int $m, int $monkey, int $s, int $a, $context) { + multi method INTERPOLATE(Callable:D \var, int $im, int $monkey, int $s, int $a, $context) { # Call it if it is a routine. This will capture if requested. (var)(self) } - multi method INTERPOLATE(Iterable:D \var, int $i, int $m, int $monkey, int $s, int $a, $context) { + multi method INTERPOLATE(Iterable:D \var, int $im, int $monkey, int $s, int $a, $context) { my $maxmatch; my $cur := self.'!cursor_start_cur'(); my str $tgt = $cur.target; @@ -219,7 +219,7 @@ my class Match is Capture is Cool does NQPMatchRole { my int $maxlen = -1; my int $pos = nqp::getattr_i($cur, $?CLASS, '$!from'); my int $start = 1; - my int $nomod = !($i || $m); + my int $nomod = $im == 0; my Mu $order := nqp::list(); @@ -250,8 +250,7 @@ my class Match is Capture is Cool does NQPMatchRole { if $a { return $cur.'!cursor_start_cur'() if nqp::istype($topic,Associative); - - my $rx := MAKE_REGEX($topic,$i,$m,$monkey,$context); + my $rx := MAKE_REGEX($topic,$im == 1 || $im == 3,$im == 2 || $im == 3,$monkey,$context); $nfa.mergesubstates($start,0,nqp::decont($fate), nqp::findmethod($rx,'NFA')($rx), Mu); @@ -270,8 +269,8 @@ my class Match is Capture is Cool does NQPMatchRole { :rxtype, $topic, :subtype( $nomod ?? '' - !! $m - ?? $i + !! $im == 2 + ?? $im == 1 ?? 'ignorecase+ignoremark' !! 'ignoremark' !! 'ignorecase') @@ -315,7 +314,7 @@ my class Match is Capture is Cool does NQPMatchRole { return $cur.'!cursor_start_cur'() if nqp::istype($topic,Associative); - my $rx := MAKE_REGEX($topic,$i,$m,$monkey,$context); + my $rx := MAKE_REGEX($topic,$im == 1 || $im == 3,$im == 2 || $im == 3,$monkey,$context); $match := self.$rx; $len = $match.pos - $match.from; } @@ -339,27 +338,27 @@ my class Match is Capture is Cool does NQPMatchRole { #?if moar # ignoremark+ignorecase - elsif $m && $i { + elsif $im == 3 { $match = nqp::eqaticim($tgt, $topic_str, $pos); } # ignoremark - elsif $m { + elsif $im == 2 { $match = nqp::eqatim($tgt, $topic_str, $pos); } # ignorecase - elsif $i { + elsif $im == 1 { $match = nqp::eqatic($tgt, $topic_str, $pos); } #?endif #?if !moar # ignoremark(+ignorecase?) - elsif $m { + elsif $im == 2 || $im == 3 { my int $k = -1; # ignorecase+ignoremark - if $i { + if $im == 3 { my str $tgt_fc = nqp::fc(nqp::substr($tgt,$pos,$len)); my str $topic_fc = nqp::fc($topic_str); Nil while nqp::islt_i(++$k,$len) @@ -406,7 +405,7 @@ my class Match is Capture is Cool does NQPMatchRole { !! $cur } - multi method INTERPOLATE(Mu:D \var, int $i, int $m, int $monkey, int $s, int $a, $context) { + multi method INTERPOLATE(Mu:D \var, int $im, int $monkey, int $s, int $a, $context) { my $maxmatch; my $cur := self.'!cursor_start_cur'(); my str $tgt = $cur.target; @@ -415,7 +414,7 @@ my class Match is Capture is Cool does NQPMatchRole { my int $maxlen = -1; my int $pos = nqp::getattr_i($cur, $?CLASS, '$!from'); my int $start = 1; - my int $nomod = !($i || $m); + my int $nomod = $im == 0; my str $topic_str; my $match; @@ -427,7 +426,7 @@ my class Match is Capture is Cool does NQPMatchRole { return $cur.'!cursor_start_cur'() if nqp::istype(var,Associative); - my $rx := MAKE_REGEX(var,$i,$m,$monkey,$context); + my $rx := MAKE_REGEX(var,$im == 1 || $im == 3,$im == 2 || $im == 3,$monkey,$context); $match := self.$rx; $len = $match.pos - $match.from; } @@ -451,27 +450,27 @@ my class Match is Capture is Cool does NQPMatchRole { #?if moar # ignoremark+ignorecase - elsif $m && $i { + elsif $im == 3 { $match = nqp::eqaticim($tgt, $topic_str, $pos); } # ignoremark - elsif $m { + elsif $im == 2 { $match = nqp::eqatim($tgt, $topic_str, $pos); } # ignorecase - elsif $i { + elsif $im == 1 { $match = nqp::eqatic($tgt, $topic_str, $pos); } #?endif #?if !moar # ignoremark(+ignorecase?) - elsif $m { + elsif $im == 2 || $im == 3 { my int $k = -1; # ignorecase+ignoremark - if $i { + if $im == 3 { my str $tgt_fc = nqp::fc(nqp::substr($tgt,$pos,$len)); my str $topic_fc = nqp::fc($topic_str); Nil while nqp::islt_i(++$k,$len) @@ -517,7 +516,7 @@ my class Match is Capture is Cool does NQPMatchRole { !! $cur } - multi method INTERPOLATE(Mu:U \var, int $i, int $m, int $monkey, int $s, int $a, $context) { + multi method INTERPOLATE(Mu:U \var, int $im, int $monkey, int $s, int $a, $context) { self."!cursor_start_cur"() } From 1775259a32a18249e12f040ac7dfd1c2753d8882 Mon Sep 17 00:00:00 2001 From: Daniel Green Date: Fri, 13 Oct 2017 12:36:22 -0400 Subject: [PATCH 453/692] Break out Associatve and Regex into their own... multis for INTERPOLATE. --- src/core/Match.pm | 133 ++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 124 insertions(+), 9 deletions(-) diff --git a/src/core/Match.pm b/src/core/Match.pm index 9648c3aff98..e99cc0a7125 100644 --- a/src/core/Match.pm +++ b/src/core/Match.pm @@ -405,6 +405,130 @@ my class Match is Capture is Cool does NQPMatchRole { !! $cur } + multi method INTERPOLATE(Associative \var, int $im, int $monkey, int $s, int $a, $context) { + my $cur := self.'!cursor_start_cur'(); + if $a { + return $cur.'!cursor_start_cur'() + } + my $maxmatch; + my str $tgt = $cur.target; + my int $eos = nqp::chars($tgt); + + my int $maxlen = -1; + my int $pos = nqp::getattr_i($cur, $?CLASS, '$!from'); + my int $start = 1; + my int $nomod = $im == 0; + + my str $topic_str; + my $match; + my int $len; + + # The pattern is a string. $len and and $topic_str are used + # later on if this condition does not hold. + if nqp::iseq_i(($len = nqp::chars($topic_str = var.Str)),0) { + $match = 1; + } + + # no modifier, match literally + elsif $nomod { + $match = nqp::eqat($tgt, $topic_str, $pos); + } + +#?if moar + # ignoremark+ignorecase + elsif $im == 3 { + $match = nqp::eqaticim($tgt, $topic_str, $pos); + } + + # ignoremark + elsif $im == 2 { + $match = nqp::eqatim($tgt, $topic_str, $pos); + } + + # ignorecase + elsif $im == 1 { + $match = nqp::eqatic($tgt, $topic_str, $pos); + } +#?endif +#?if !moar + # ignoremark(+ignorecase?) + elsif $im == 2 || $im == 3 { + my int $k = -1; + + # ignorecase+ignoremark + if $im == 3 { + my str $tgt_fc = nqp::fc(nqp::substr($tgt,$pos,$len)); + my str $topic_fc = nqp::fc($topic_str); + Nil while nqp::islt_i(++$k,$len) + && nqp::iseq_i( + nqp::ordbaseat($tgt_fc, nqp::add_i($pos,$k)), + nqp::ordbaseat($topic_fc, $k) + ); + } + + # ignoremark + else { + Nil while nqp::islt_i(++$k, $len) + && nqp::iseq_i( + nqp::ordbaseat($tgt, nqp::add_i($pos,$k)), + nqp::ordbaseat($topic_str, $k) + ); + } + + $match = nqp::iseq_i($k,$len); # match if completed + } + + # ignorecase + else { + $match = nqp::iseq_s( + nqp::fc(nqp::substr($tgt, $pos, $len)), + nqp::fc($topic_str) + ) + } +#?endif + + if $match + && nqp::isgt_i($len,$maxlen) + && nqp::isle_i(nqp::add_i($pos,$len),$eos) { + $maxlen = $len; + $maxmatch := $match; + last if $s; # stop here for sequential alternation + } + + nqp::istype($maxmatch, Match) + ?? $maxmatch + !! nqp::isge_i($maxlen,0) + ?? $cur.'!cursor_pass'(nqp::add_i($pos,$maxlen), '') + !! $cur + } + + multi method INTERPOLATE(Regex \var, int $im, int $monkey, int $s, int $a, $context) { + my $maxmatch; + my $cur := self.'!cursor_start_cur'(); + my str $tgt = $cur.target; + my int $eos = nqp::chars($tgt); + + my int $maxlen = -1; + my int $pos = nqp::getattr_i($cur, $?CLASS, '$!from'); + my Mu $topic := var; + my $match := self.$topic; + my int $len = $match.pos - $match.from; + + if $match + && nqp::isgt_i($len,$maxlen) + && nqp::isle_i(nqp::add_i($pos,$len),$eos) { + $maxlen = $len; + $maxmatch := $match; + last if $s; # stop here for sequential alternation + } + + nqp::istype($maxmatch, Match) + ?? $maxmatch + !! nqp::isge_i($maxlen,0) + ?? $cur.'!cursor_pass'(nqp::add_i($pos,$maxlen), '') + !! $cur + } + multi method INTERPOLATE(Mu:D \var, int $im, int $monkey, int $s, int $a, $context) { my $maxmatch; my $cur := self.'!cursor_start_cur'(); @@ -423,20 +547,11 @@ my class Match is Capture is Cool does NQPMatchRole { # We are in a regex assertion, the strings we get will be # treated as regex rules. if $a { - return $cur.'!cursor_start_cur'() - if nqp::istype(var,Associative); - my $rx := MAKE_REGEX(var,$im == 1 || $im == 3,$im == 2 || $im == 3,$monkey,$context); $match := self.$rx; $len = $match.pos - $match.from; } - # A Regex already. - elsif nqp::istype(var,Regex) { - $match := self.var; - $len = $match.pos - $match.from; - } - # The pattern is a string. $len and and $topic_str are used # later on if this condition does not hold. elsif nqp::iseq_i(($len = nqp::chars($topic_str = var.Str)),0) { From e8003c873eabf70c2bb92b0ab5385cba6501961c Mon Sep 17 00:00:00 2001 From: Daniel Green Date: Fri, 13 Oct 2017 17:39:32 -0400 Subject: [PATCH 454/692] Remove unused conditional and variable in some... INTERPOLATE multis. --- src/core/Match.pm | 5 ----- 1 file changed, 5 deletions(-) diff --git a/src/core/Match.pm b/src/core/Match.pm index e99cc0a7125..50e2b75f4df 100644 --- a/src/core/Match.pm +++ b/src/core/Match.pm @@ -416,7 +416,6 @@ my class Match is Capture is Cool does NQPMatchRole { my int $maxlen = -1; my int $pos = nqp::getattr_i($cur, $?CLASS, '$!from'); - my int $start = 1; my int $nomod = $im == 0; my str $topic_str; @@ -492,7 +491,6 @@ my class Match is Capture is Cool does NQPMatchRole { && nqp::isle_i(nqp::add_i($pos,$len),$eos) { $maxlen = $len; $maxmatch := $match; - last if $s; # stop here for sequential alternation } nqp::istype($maxmatch, Match) @@ -519,7 +517,6 @@ my class Match is Capture is Cool does NQPMatchRole { && nqp::isle_i(nqp::add_i($pos,$len),$eos) { $maxlen = $len; $maxmatch := $match; - last if $s; # stop here for sequential alternation } nqp::istype($maxmatch, Match) @@ -537,7 +534,6 @@ my class Match is Capture is Cool does NQPMatchRole { my int $maxlen = -1; my int $pos = nqp::getattr_i($cur, $?CLASS, '$!from'); - my int $start = 1; my int $nomod = $im == 0; my str $topic_str; @@ -621,7 +617,6 @@ my class Match is Capture is Cool does NQPMatchRole { && nqp::isle_i(nqp::add_i($pos,$len),$eos) { $maxlen = $len; $maxmatch := $match; - last if $s; # stop here for sequential alternation } nqp::istype($maxmatch, Match) From 4d3ccd834952f6d138c250b2e70aa291929fc4eb Mon Sep 17 00:00:00 2001 From: Daniel Green Date: Fri, 13 Oct 2017 18:30:12 -0400 Subject: [PATCH 455/692] Comment about how the #?if !moar branch in the... INTERPOLATE multis is required to compile on JVM and JS, but doesn't actually work. --- src/core/Match.pm | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/src/core/Match.pm b/src/core/Match.pm index 50e2b75f4df..3158ff33a1a 100644 --- a/src/core/Match.pm +++ b/src/core/Match.pm @@ -353,6 +353,11 @@ my class Match is Capture is Cool does NQPMatchRole { } #?endif #?if !moar + +# This branch is required because neither the JVM nor the JS implementations +# have the nqp::eqat* ops. However, nqp::ordbaseat just throws a NYI +# exception for both, so the code doesn't actually work. + # ignoremark(+ignorecase?) elsif $im == 2 || $im == 3 { my int $k = -1; @@ -450,6 +455,11 @@ my class Match is Capture is Cool does NQPMatchRole { } #?endif #?if !moar + +# This branch is required because neither the JVM nor the JS implementations +# have the nqp::eqat* ops. However, nqp::ordbaseat just throws a NYI +# exception for both, so the code doesn't actually work. + # ignoremark(+ignorecase?) elsif $im == 2 || $im == 3 { my int $k = -1; @@ -576,6 +586,11 @@ my class Match is Capture is Cool does NQPMatchRole { } #?endif #?if !moar + +# This branch is required because neither the JVM nor the JS implementations +# have the nqp::eqat* ops. However, nqp::ordbaseat just throws a NYI +# exception for both, so the code doesn't actually work. + # ignoremark(+ignorecase?) elsif $im == 2 || $im == 3 { my int $k = -1; From a0279e561ac1005bc4c7a349d65bcfb3a30de43d Mon Sep 17 00:00:00 2001 From: MasterDuke17 Date: Sat, 14 Oct 2017 08:48:26 -0400 Subject: [PATCH 456/692] Whitespace fix, convert tabs to spaces --- src/core/Match.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/Match.pm b/src/core/Match.pm index 3158ff33a1a..49334879e8b 100644 --- a/src/core/Match.pm +++ b/src/core/Match.pm @@ -761,8 +761,8 @@ my class Match is Capture is Cool does NQPMatchRole { } method clone() { - my $new := nqp::clone(self); - $new; + my $new := nqp::clone(self); + $new; } multi method WHICH (Match:D:) { From 0262a997aa17373565e1e2166a0c90b7d531c9f8 Mon Sep 17 00:00:00 2001 From: MasterDuke17 Date: Sat, 14 Oct 2017 08:53:39 -0400 Subject: [PATCH 457/692] Rest of tabs -> spaces in Match.pm --- src/core/Match.pm | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/src/core/Match.pm b/src/core/Match.pm index 49334879e8b..2d122987927 100644 --- a/src/core/Match.pm +++ b/src/core/Match.pm @@ -745,16 +745,16 @@ my class Match is Capture is Cool does NQPMatchRole { } submethod BUILD( - :$orig = '', - :$from = 0, - :to(:$pos), - :ast(:$made), - :$shared, - :$braid, - :$list, - :$hash) + :$orig = '', + :$from = 0, + :to(:$pos), + :ast(:$made), + :$shared, + :$braid, + :$list, + :$hash) { - # :build tells !cursor_init that it's too late to do a CREATE + # :build tells !cursor_init that it's too late to do a CREATE self.'!cursor_init'($orig, :build, :p($pos), :$shared, :$braid); nqp::bindattr_i(self, Match, '$!from', $from); nqp::bindattr( self, Match, '$!made', nqp::decont($made)) if $made.defined; From 9d9c7f9c3bd40011fa11981cfa67a8457fb442cf Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 14 Oct 2017 10:41:43 -0400 Subject: [PATCH 458/692] Deprecate .new on native types - For now, just maintain old behaviour of returning a boxed version - After 2017.12, toss the deprecation and make the methods die - Fixes RT#132293: https://rt.perl.org/Ticket/Display.html?id=132293 --- src/Perl6/Metamodel/NativeHOW.nqp | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/src/Perl6/Metamodel/NativeHOW.nqp b/src/Perl6/Metamodel/NativeHOW.nqp index 5d2a22ea0fa..88127b8af27 100644 --- a/src/Perl6/Metamodel/NativeHOW.nqp +++ b/src/Perl6/Metamodel/NativeHOW.nqp @@ -113,6 +113,17 @@ class Perl6::Metamodel::NativeHOW $!unsigned } - method method_table($obj) { nqp::hash() } + method method_table($obj) { + nqp::hash('new', + nqp::getstaticcode(sub (*@_,*%_) { + # nqp::die('Cannot instantiate a native type'); + nqp::getlexcaller('&DEPRECATED')( + '(my ' ~ @_[0].HOW.name(@_[0]) ~ ' $ = ' ~ @_[1].perl() ~ ')', + '2017.09.403', + '2018.01', + ); + @_[1]; + })) + } method submethod_table($obj) { nqp::hash() } } From cc6c05586b62bbf29632683608f2d7813e03e849 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 14 Oct 2017 10:44:05 -0400 Subject: [PATCH 459/692] Test behaviour of .new on native types RT#132293: https://rt.perl.org/Ticket/Display.html?id=132293 Rakudo fix: https://github.com/rakudo/rakudo/commit/9d9c7f9c3b --- t/05-messages/01-errors.t | 41 ++++++++++++++++++++++++++++++++++++++- 1 file changed, 40 insertions(+), 1 deletion(-) diff --git a/t/05-messages/01-errors.t b/t/05-messages/01-errors.t index f3c2c32cb92..e0c11fb5359 100644 --- a/t/05-messages/01-errors.t +++ b/t/05-messages/01-errors.t @@ -2,7 +2,7 @@ use lib ; use Test; use Test::Helpers; -plan 47; +plan 48; # RT #129763 throws-like '1++', X::Multi::NoMatch, @@ -260,4 +260,43 @@ throws-like 「Blob[num32].new: 2e0」, throws-like 「callframe.callframe(1).my.perl」, X::NYI, 'callframe.my throws sane NYI error message'; + +subtest '.new on native types works (deprecated; will die)' => { + plan 9; + + die "Time to remove deprecation and make .new on ints die" + if $*PERL.compiler.version after v2017.12.50; + + # TODO XXX: remove deprecation in NativeHOW + # (see https://github.com/rakudo/rakudo/commit/9d9c7f9c3b ) + # and make .new die, then remove + # the tests that test the values and uncomment tests that test the + # throwage and likely move them to roast + + sub DEPRECATED (|) {}; + is-deeply int.new(4), 4, 'int'; + is-deeply int8.new(4), 4, 'int8'; + is-deeply int16.new(4), 4, 'int16'; + is-deeply int32.new(4), 4, 'int32'; + is-deeply int64.new(4), 4, 'int64'; + + is-deeply num.new(4e0), 4e0, 'num'; + is-deeply num32.new(4e0), 4e0, 'num32'; + is-deeply num64.new(4e0), 4e0, 'num64'; + + is-deeply str.new('x'), 'x', 'str'; + + # throws-like { int .new: 4 }, Exception, 'int'; + # throws-like { int8 .new: 4 }, Exception, 'int8'; + # throws-like { int16.new: 4 }, Exception, 'int16'; + # throws-like { int32.new: 4 }, Exception, 'int32'; + # throws-like { int64.new: 4 }, Exception, 'int64'; + # + # throws-like { num .new: 4e0 }, Exception, 'num'; + # throws-like { num32.new: 4e0 }, Exception, 'num32'; + # throws-like { num64.new: 4e0 }, Exception, 'num64'; + # + # throws-like { str.new: 'x' }, Exception, 'str'; +} + # vim: ft=perl6 expandtab sw=4 From 441fc9b32b700fbf4ea9c30f3955a2cea3ea7c6e Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 14 Oct 2017 12:13:24 -0400 Subject: [PATCH 460/692] Do not add more stuff into 01-errors.t It takes forever to run and there's no reason we can't split it up into multiple files. --- t/05-messages/01-errors.t | 2 ++ 1 file changed, 2 insertions(+) diff --git a/t/05-messages/01-errors.t b/t/05-messages/01-errors.t index e0c11fb5359..d4a0aed3b5a 100644 --- a/t/05-messages/01-errors.t +++ b/t/05-messages/01-errors.t @@ -299,4 +299,6 @@ subtest '.new on native types works (deprecated; will die)' => { # throws-like { str.new: 'x' }, Exception, 'str'; } +#### THIS FILE ALREADY LOTS OF TESTS ADD NEW TESTS TO THE NEXT error.t FILE + # vim: ft=perl6 expandtab sw=4 From de2b9ff7209e896dc4df4bb772d34b21a0f4cb37 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 14 Oct 2017 12:27:31 -0400 Subject: [PATCH 461/692] Remove unwanted .perl call Fixes RT#132295: https://rt.perl.org/Ticket/Display.html?id=132295 --- src/core/Exception.pm | 2 +- t/05-messages/02-errors.t | 12 ++++++++++++ 2 files changed, 13 insertions(+), 1 deletion(-) create mode 100644 t/05-messages/02-errors.t diff --git a/src/core/Exception.pm b/src/core/Exception.pm index 7963b295d94..e98a4f4cb50 100644 --- a/src/core/Exception.pm +++ b/src/core/Exception.pm @@ -2465,7 +2465,7 @@ my class X::Numeric::Confused is Exception { ~ ( "\n(If you really wanted to convert {$.num.perl} to a base-$.base" ~ " string, use {$.num.perl}.base($.base) instead.)" - if $.num.perl.^can('base') + if $.num.^can('base') ); } } diff --git a/t/05-messages/02-errors.t b/t/05-messages/02-errors.t new file mode 100644 index 00000000000..f51bb2b713f --- /dev/null +++ b/t/05-messages/02-errors.t @@ -0,0 +1,12 @@ +use lib ; +use Test; +use Test::Helpers; + +plan 1; + +# RT #132295 + +is-run 「:2(1)」, :err{.contains: 「use 1.base(2) instead」}, :status(* !== 0), + ':2(1) suggests using 1.base(2)'; + +# vim: ft=perl6 expandtab sw=4 From 04b171bd1245a6c2bc5afa5f32ae892503a058d6 Mon Sep 17 00:00:00 2001 From: Daniel Green Date: Sat, 14 Oct 2017 12:36:51 -0400 Subject: [PATCH 462/692] Optimize Regex multi for INTERPOLATE Move some code into a conditional and don't allocate some variables if not needed. --- src/core/Match.pm | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/core/Match.pm b/src/core/Match.pm index 2d122987927..3336039e2de 100644 --- a/src/core/Match.pm +++ b/src/core/Match.pm @@ -513,20 +513,20 @@ my class Match is Capture is Cool does NQPMatchRole { multi method INTERPOLATE(Regex \var, int $im, int $monkey, int $s, int $a, $context) { my $maxmatch; my $cur := self.'!cursor_start_cur'(); - my str $tgt = $cur.target; - my int $eos = nqp::chars($tgt); my int $maxlen = -1; my int $pos = nqp::getattr_i($cur, $?CLASS, '$!from'); my Mu $topic := var; my $match := self.$topic; - my int $len = $match.pos - $match.from; - if $match - && nqp::isgt_i($len,$maxlen) - && nqp::isle_i(nqp::add_i($pos,$len),$eos) { - $maxlen = $len; - $maxmatch := $match; + if $match { + my int $len = $match.pos - $match.from; + + if nqp::isgt_i($len,$maxlen) + && nqp::isle_i(nqp::add_i($pos,$len),nqp::chars($cur.target)) { + $maxlen = $len; + $maxmatch := $match; + } } nqp::istype($maxmatch, Match) From c1e5cfcfa59596a57be69f47871f3d2a4dee7b4d Mon Sep 17 00:00:00 2001 From: usev6 Date: Sat, 14 Oct 2017 19:22:15 +0200 Subject: [PATCH 463/692] [jvm] Don't run files when all tests are hanging --- t/spectest.data | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/t/spectest.data b/t/spectest.data index f81799e3fdd..84d10bdfc02 100644 --- a/t/spectest.data +++ b/t/spectest.data @@ -1007,7 +1007,7 @@ S32-io/indir.t S32-io/io-cathandle.t S32-io/io-handle.t S32-io/lock.t # slow -S32-io/socket-host-port-split.t +S32-io/socket-host-port-split.t # moar S32-io/socket-fail-invalid-values.t S32-io/io-special.t S32-io/io-spec-qnx.t @@ -1031,8 +1031,8 @@ S32-io/other.t S32-io/pipe.t S32-io/rename.t S32-io/seek.t -S32-io/socket-accept-and-working-threads.t -S32-io/socket-recv-vs-read.t +S32-io/socket-accept-and-working-threads.t # moar +S32-io/socket-recv-vs-read.t # moar S32-io/slurp.t S32-io/spurt.t S32-io/tell.t From 1275fd4ab7a4a213f6dcbe406199bb50152ad850 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 14 Oct 2017 18:58:39 +0000 Subject: [PATCH 464/692] Make Cool.[starts|ends]-with 12x faster Part of fixing RT#132280: https://rt.perl.org/Ticket/Display.html?id=132280 --- src/core/Cool.pm | 26 ++++++++++++++++++++------ src/core/Str.pm | 10 +++++++--- 2 files changed, 27 insertions(+), 9 deletions(-) diff --git a/src/core/Cool.pm b/src/core/Cool.pm index 87bfd876bc2..9e0b239ee5d 100644 --- a/src/core/Cool.pm +++ b/src/core/Cool.pm @@ -128,12 +128,26 @@ my class Cool { # declared in BOOTSTRAP } method trans(|c) { self.Str.trans(|c) } - method starts-with(Cool:D: |c) { - self.Str.starts-with(|c) - } - - method ends-with(Cool:D: |c) { - self.Str.ends-with(|c) + # NOTE: here we duplicate Str's candidates because currently simply + # grabbing a Capture and slipping it in makes things super slow RT#132280 + # TODO Use coercer in 1 candidate when RT#131014 + proto method starts-with(|) {*} + multi method starts-with(Cool:D: Cool:D \needle) { + self.Str.starts-with: needle.Str + } + multi method starts-with(Cool:D: Str:D \needle) { + self.Str.starts-with: needle + } + + # NOTE: here we duplicate Str's candidates because currently simply + # grabbing a Capture and slipping it in makes things super slow RT#132280 + # TODO Use coercer in 1 candidate when RT#131014 + proto method ends-with(|) {*} + multi method ends-with(Cool:D: Cool:D \suffix) { + self.Str.ends-with: suffix.Str + } + multi method ends-with(Cool:D: Str:D \suffix) { + self.Str.ends-with: suffix } method substr-eq(Cool:D: |c) { diff --git a/src/core/Str.pm b/src/core/Str.pm index 852466b9437..b7cef58f88b 100644 --- a/src/core/Str.pm +++ b/src/core/Str.pm @@ -134,14 +134,18 @@ my class Str does Stringy { # declared in BOOTSTRAP $chars > 0 ?? nqp::p6box_s(nqp::substr($!value,0,$chars)) !! ''; } - # TODO Use coercer in 1 candidate when RT131014 + # TODO Use coercer in 1 candidate when RT#131014 + # NOTE: if changing candidates' signatures, ensure Cool candidate has + # the same change applied to its candidates for this routine as well proto method starts-with(|) {*} multi method starts-with(Str:D: Cool:D $needle) {self.starts-with: $needle.Str} multi method starts-with(Str:D: Str:D $needle) { nqp::p6bool(nqp::eqat(self, $needle, 0)) } - # TODO Use coercer in 1 candidate when RT131014 + # TODO Use coercer in 1 candidate when RT#131014 + # NOTE: if changing candidates' signatures, ensure Cool candidate has + # the same change applied to its candidates for this routine as well proto method ends-with(|) {*} multi method ends-with(Str:D: Cool:D $suffix) {self.ends-with: $suffix.Str} multi method ends-with(Str:D: Str:D $suffix) { @@ -152,7 +156,7 @@ my class Str does Stringy { # declared in BOOTSTRAP )) } - # TODO Use coercer in 1 candidate when RT131014 + # TODO Use coercer in 1 candidate when RT#131014 proto method substr-eq(|) {*} multi method substr-eq(Str:D: Cool:D $needle) {self.substr-eq: $needle.Str} multi method substr-eq(Str:D: Str:D $needle) { From a7b044937598d330ee86825e7ffa878219e114a5 Mon Sep 17 00:00:00 2001 From: usev6 Date: Sat, 14 Oct 2017 22:28:42 +0200 Subject: [PATCH 465/692] [jvm] Move handling of Nil back to 'store' --- .../org/perl6/rakudo/RakudoContainerSpec.java | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/src/vm/jvm/runtime/org/perl6/rakudo/RakudoContainerSpec.java b/src/vm/jvm/runtime/org/perl6/rakudo/RakudoContainerSpec.java index f88b25ed034..a6f4bb85d37 100644 --- a/src/vm/jvm/runtime/org/perl6/rakudo/RakudoContainerSpec.java +++ b/src/vm/jvm/runtime/org/perl6/rakudo/RakudoContainerSpec.java @@ -54,11 +54,7 @@ private void checkStore(ThreadContext tc, SixModelObject cont, SixModelObject va "Cannot assign to a readonly variable or a value"); } - if (value.st.WHAT == gcx.Nil) { - value = desc.get_attribute_boxed(tc, - gcx.ContainerDescriptor, "$!default", RakOps.HINT_CD_DEFAULT); - } - else { + if (value.st.WHAT != gcx.Nil) { SixModelObject of = desc.get_attribute_boxed(tc, gcx.ContainerDescriptor, "$!of", RakOps.HINT_CD_OF); long ok = Ops.istype(value, of, tc); @@ -82,6 +78,12 @@ public void store(ThreadContext tc, SixModelObject cont, SixModelObject value) { if (whence != null) Ops.invokeDirect(tc, whence, WHENCE, new Object[] { }); + if (value.st.WHAT == gcx.Nil) { + SixModelObject desc = cont.get_attribute_boxed(tc, gcx.Scalar, + "$!descriptor", HINT_descriptor); + value = desc.get_attribute_boxed(tc, + gcx.ContainerDescriptor, "$!default", RakOps.HINT_CD_DEFAULT); + } cont.bind_attribute_boxed(tc, gcx.Scalar, "$!value", HINT_value, value); } public void store_i(ThreadContext tc, SixModelObject cont, long value) { From 530e1294616fb6f1f723d2a9a014d2b69831a26c Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 14 Oct 2017 20:36:01 +0000 Subject: [PATCH 466/692] Make Cool.contains 11.5x faster Part of fixing RT#132280: https://rt.perl.org/Ticket/Display.html?id=132280 --- src/core/Cool.pm | 15 +++++++++++++-- src/core/Str.pm | 2 ++ 2 files changed, 15 insertions(+), 2 deletions(-) diff --git a/src/core/Cool.pm b/src/core/Cool.pm index 9e0b239ee5d..aae851d9fb4 100644 --- a/src/core/Cool.pm +++ b/src/core/Cool.pm @@ -154,8 +154,19 @@ my class Cool { # declared in BOOTSTRAP self.Str.substr-eq(|c) } - method contains(Cool:D: |c) { - self.Str.contains(|c) + # NOTE: here we duplicate Str's candidates because currently simply + # grabbing a Capture and slipping it in makes things super slow RT#132280 + # TODO Use coercer in 1 candidate when RT#131014 + proto method contains(|) {*} + multi method contains(Cool:D: Cool:D \needle) {self.contains: needle.Str} + multi method contains(Cool:D: Str:D \needle) { + self.Str.contains: needle + } + multi method contains(Cool:D: Cool:D \needle, Int(Cool:D) \pos) { + self.Str.contains: needle.Str, pos + } + multi method contains(Cool:D: Str:D \needle, Int:D \pos) { + self.Str.contains: needle, pos } method indices(Cool:D: |c) { diff --git a/src/core/Str.pm b/src/core/Str.pm index b7cef58f88b..e26ee7109e3 100644 --- a/src/core/Str.pm +++ b/src/core/Str.pm @@ -173,6 +173,8 @@ my class Str does Stringy { # declared in BOOTSTRAP } # TODO Use coercer in 1 candidate when RT131014 + # NOTE: if changing candidates' signatures, ensure Cool candidate has + # the same change applied to its candidates for this routine as well proto method contains(|) {*} multi method contains(Str:D: Cool:D $needle) {self.contains: $needle.Str} multi method contains(Str:D: Str:D $needle) { From 785d2f251da5324cba55893387b0acccc5f187ba Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 14 Oct 2017 20:55:34 +0000 Subject: [PATCH 467/692] Make Cool.split 0x-2.7x faster Split with Str matcher is 2.7x faster, but looks like Regex matcher is just so slow that dispatch improvement is drowned so there's no noticalbe improvement there. Part of fixing RT#132280: https://rt.perl.org/Ticket/Display.html?id=132280 --- src/core/Cool.pm | 20 ++++++++++++++++++-- src/core/Str.pm | 9 +++++++++ 2 files changed, 27 insertions(+), 2 deletions(-) diff --git a/src/core/Cool.pm b/src/core/Cool.pm index aae851d9fb4..8dec517cd7b 100644 --- a/src/core/Cool.pm +++ b/src/core/Cool.pm @@ -181,8 +181,24 @@ my class Cool { # declared in BOOTSTRAP self.Str.rindex(|c) } - method split(Cool: |c) { - self.Stringy.split(|c); + # NOTE: here we duplicate Str's candidates because currently simply + # grabbing a Capture and slipping it in makes things super slow RT#132280 + proto method split(|) {*} + multi method split(Cool:D: Regex:D \pat, \limit is copy = Inf;; + :$v is copy, :$k, :$kv, :$p, :$skip-empty) { + self.Stringy.split: pat, limit, :$v, :$k, :$kv, :$p, :$skip-empty + } + multi method split(Cool:D: Str(Cool) \match;; + :$v is copy, :$k, :$kv, :$p, :$skip-empty) { + self.Stringy.split: match, :$v, :$k, :$kv, :$p, :$skip-empty + } + multi method split(Cool:D: Str(Cool) \match, \limit is copy = Inf;; + :$v is copy, :$k, :$kv, :$p, :$skip-empty) { + self.Stringy.split: match, limit, :$v, :$k, :$kv, :$p, :$skip-empty + } + multi method split(Cool:D: @needles, \parts is copy = Inf;; + :$v is copy, :$k, :$kv, :$p, :$skip-empty) { + self.Stringy.split: @needles, parts, :$v, :$k, :$kv, :$p, :$skip-empty } method match(Cool:D: |c) { diff --git a/src/core/Str.pm b/src/core/Str.pm index e26ee7109e3..48e65f623dd 100644 --- a/src/core/Str.pm +++ b/src/core/Str.pm @@ -1434,6 +1434,9 @@ my class Str does Stringy { # declared in BOOTSTRAP $res } + # NOTE: if changing candidates' signatures, ensure Cool candidate has + # the same change applied to its candidates for this routine as well + proto method split(|) {*} multi method split(Str:D: Regex:D $pat, $limit is copy = Inf;; :$v is copy, :$k, :$kv, :$p, :$skip-empty) { @@ -1511,6 +1514,8 @@ my class Str does Stringy { # declared in BOOTSTRAP Seq.new(Rakudo::Iterator.ReifiedList($result)) } + # NOTE: if changing candidates' signatures, ensure Cool candidate has + # the same change applied to its candidates for this routine as well multi method split(Str:D: Str(Cool) $match;; :$v is copy, :$k, :$kv, :$p, :$skip-empty) { my int $any = self!ensure-split-sanity($v,$k,$kv,$p); @@ -1571,6 +1576,8 @@ my class Str does Stringy { # declared in BOOTSTRAP Seq.new(Rakudo::Iterator.ReifiedList($matches)) } + # NOTE: if changing candidates' signatures, ensure Cool candidate has + # the same change applied to its candidates for this routine as well multi method split(Str:D: Str(Cool) $match, $limit is copy = Inf;; :$v is copy, :$k, :$kv, :$p, :$skip-empty) { my int $any = self!ensure-split-sanity($v,$k,$kv,$p); @@ -1732,6 +1739,8 @@ my class Str does Stringy { # declared in BOOTSTRAP } } + # NOTE: if changing candidates' signatures, ensure Cool candidate has + # the same change applied to its candidates for this routine as well multi method split(Str:D: @needles, $parts is copy = Inf;; :$v is copy, :$k, :$kv, :$p, :$skip-empty) { my int $any = self!ensure-split-sanity($v,$k,$kv,$p); From 43e7b893b1d19e551fc6008369571aa8571203a4 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sat, 14 Oct 2017 23:12:03 +0200 Subject: [PATCH 468/692] Fix for RT #132288 Make sure we check in HLL before committing to the natives. --- src/core/Rakudo/Iterator.pm | 32 ++++++++++++++++++++++---------- 1 file changed, 22 insertions(+), 10 deletions(-) diff --git a/src/core/Rakudo/Iterator.pm b/src/core/Rakudo/Iterator.pm index 09b298f1848..f3bb84557d0 100644 --- a/src/core/Rakudo/Iterator.pm +++ b/src/core/Rakudo/Iterator.pm @@ -2453,11 +2453,17 @@ class Rakudo::Iterator { nqp::elems($!reified) ) } - method skip-at-least(int $toskip) { - nqp::islt_i( - ($!i = - nqp::add_i($!i,nqp::if(nqp::isgt_i($toskip,0),$toskip,0))), - nqp::elems($!reified) + method skip-at-least(Int:D $toskip) { + nqp::unless( + $toskip <= 0, # must be HLL + nqp::stmts( + ($!i = nqp::if( + $!i + $toskip < nqp::elems($!reified), # must be HLL + nqp::add_i($!i,$toskip), + nqp::elems($!reified) + )), + nqp::islt_i($!i,nqp::elems($!reified)) + ) ) } method count-only() { nqp::p6box_i(nqp::elems($!reified)) } @@ -2513,11 +2519,17 @@ class Rakudo::Iterator { nqp::elems($!reified) ) } - method skip-at-least(int $toskip) { - nqp::islt_i( - ($!i = - nqp::add_i($!i,nqp::if(nqp::isgt_i($toskip,0),$toskip,0))), - nqp::elems($!reified) + method skip-at-least(Int:D $toskip) { + nqp::unless( + $toskip <= 0, # must be HLL + nqp::stmts( + ($!i = nqp::if( + $!i + $toskip < nqp::elems($!reified), # must be HLL + nqp::add_i($!i,$toskip), + nqp::elems($!reified) + )), + nqp::islt_i($!i,nqp::elems($!reified)) + ) ) } method count-only() { nqp::p6box_i(nqp::elems($!reified)) } From d79ac9704d8a9ae761e203ea5f3fb8ef313c4a11 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 14 Oct 2017 21:14:07 +0000 Subject: [PATCH 469/692] Revert fixes to Cool methods with captures Do not sweet the problem under the rug and instead fix slippy method caching --- src/core/Cool.pm | 57 +++++++----------------------------------------- src/core/Str.pm | 21 +++--------------- 2 files changed, 11 insertions(+), 67 deletions(-) diff --git a/src/core/Cool.pm b/src/core/Cool.pm index 8dec517cd7b..87bfd876bc2 100644 --- a/src/core/Cool.pm +++ b/src/core/Cool.pm @@ -128,45 +128,20 @@ my class Cool { # declared in BOOTSTRAP } method trans(|c) { self.Str.trans(|c) } - # NOTE: here we duplicate Str's candidates because currently simply - # grabbing a Capture and slipping it in makes things super slow RT#132280 - # TODO Use coercer in 1 candidate when RT#131014 - proto method starts-with(|) {*} - multi method starts-with(Cool:D: Cool:D \needle) { - self.Str.starts-with: needle.Str - } - multi method starts-with(Cool:D: Str:D \needle) { - self.Str.starts-with: needle + method starts-with(Cool:D: |c) { + self.Str.starts-with(|c) } - # NOTE: here we duplicate Str's candidates because currently simply - # grabbing a Capture and slipping it in makes things super slow RT#132280 - # TODO Use coercer in 1 candidate when RT#131014 - proto method ends-with(|) {*} - multi method ends-with(Cool:D: Cool:D \suffix) { - self.Str.ends-with: suffix.Str - } - multi method ends-with(Cool:D: Str:D \suffix) { - self.Str.ends-with: suffix + method ends-with(Cool:D: |c) { + self.Str.ends-with(|c) } method substr-eq(Cool:D: |c) { self.Str.substr-eq(|c) } - # NOTE: here we duplicate Str's candidates because currently simply - # grabbing a Capture and slipping it in makes things super slow RT#132280 - # TODO Use coercer in 1 candidate when RT#131014 - proto method contains(|) {*} - multi method contains(Cool:D: Cool:D \needle) {self.contains: needle.Str} - multi method contains(Cool:D: Str:D \needle) { - self.Str.contains: needle - } - multi method contains(Cool:D: Cool:D \needle, Int(Cool:D) \pos) { - self.Str.contains: needle.Str, pos - } - multi method contains(Cool:D: Str:D \needle, Int:D \pos) { - self.Str.contains: needle, pos + method contains(Cool:D: |c) { + self.Str.contains(|c) } method indices(Cool:D: |c) { @@ -181,24 +156,8 @@ my class Cool { # declared in BOOTSTRAP self.Str.rindex(|c) } - # NOTE: here we duplicate Str's candidates because currently simply - # grabbing a Capture and slipping it in makes things super slow RT#132280 - proto method split(|) {*} - multi method split(Cool:D: Regex:D \pat, \limit is copy = Inf;; - :$v is copy, :$k, :$kv, :$p, :$skip-empty) { - self.Stringy.split: pat, limit, :$v, :$k, :$kv, :$p, :$skip-empty - } - multi method split(Cool:D: Str(Cool) \match;; - :$v is copy, :$k, :$kv, :$p, :$skip-empty) { - self.Stringy.split: match, :$v, :$k, :$kv, :$p, :$skip-empty - } - multi method split(Cool:D: Str(Cool) \match, \limit is copy = Inf;; - :$v is copy, :$k, :$kv, :$p, :$skip-empty) { - self.Stringy.split: match, limit, :$v, :$k, :$kv, :$p, :$skip-empty - } - multi method split(Cool:D: @needles, \parts is copy = Inf;; - :$v is copy, :$k, :$kv, :$p, :$skip-empty) { - self.Stringy.split: @needles, parts, :$v, :$k, :$kv, :$p, :$skip-empty + method split(Cool: |c) { + self.Stringy.split(|c); } method match(Cool:D: |c) { diff --git a/src/core/Str.pm b/src/core/Str.pm index 48e65f623dd..852466b9437 100644 --- a/src/core/Str.pm +++ b/src/core/Str.pm @@ -134,18 +134,14 @@ my class Str does Stringy { # declared in BOOTSTRAP $chars > 0 ?? nqp::p6box_s(nqp::substr($!value,0,$chars)) !! ''; } - # TODO Use coercer in 1 candidate when RT#131014 - # NOTE: if changing candidates' signatures, ensure Cool candidate has - # the same change applied to its candidates for this routine as well + # TODO Use coercer in 1 candidate when RT131014 proto method starts-with(|) {*} multi method starts-with(Str:D: Cool:D $needle) {self.starts-with: $needle.Str} multi method starts-with(Str:D: Str:D $needle) { nqp::p6bool(nqp::eqat(self, $needle, 0)) } - # TODO Use coercer in 1 candidate when RT#131014 - # NOTE: if changing candidates' signatures, ensure Cool candidate has - # the same change applied to its candidates for this routine as well + # TODO Use coercer in 1 candidate when RT131014 proto method ends-with(|) {*} multi method ends-with(Str:D: Cool:D $suffix) {self.ends-with: $suffix.Str} multi method ends-with(Str:D: Str:D $suffix) { @@ -156,7 +152,7 @@ my class Str does Stringy { # declared in BOOTSTRAP )) } - # TODO Use coercer in 1 candidate when RT#131014 + # TODO Use coercer in 1 candidate when RT131014 proto method substr-eq(|) {*} multi method substr-eq(Str:D: Cool:D $needle) {self.substr-eq: $needle.Str} multi method substr-eq(Str:D: Str:D $needle) { @@ -173,8 +169,6 @@ my class Str does Stringy { # declared in BOOTSTRAP } # TODO Use coercer in 1 candidate when RT131014 - # NOTE: if changing candidates' signatures, ensure Cool candidate has - # the same change applied to its candidates for this routine as well proto method contains(|) {*} multi method contains(Str:D: Cool:D $needle) {self.contains: $needle.Str} multi method contains(Str:D: Str:D $needle) { @@ -1434,9 +1428,6 @@ my class Str does Stringy { # declared in BOOTSTRAP $res } - # NOTE: if changing candidates' signatures, ensure Cool candidate has - # the same change applied to its candidates for this routine as well - proto method split(|) {*} multi method split(Str:D: Regex:D $pat, $limit is copy = Inf;; :$v is copy, :$k, :$kv, :$p, :$skip-empty) { @@ -1514,8 +1505,6 @@ my class Str does Stringy { # declared in BOOTSTRAP Seq.new(Rakudo::Iterator.ReifiedList($result)) } - # NOTE: if changing candidates' signatures, ensure Cool candidate has - # the same change applied to its candidates for this routine as well multi method split(Str:D: Str(Cool) $match;; :$v is copy, :$k, :$kv, :$p, :$skip-empty) { my int $any = self!ensure-split-sanity($v,$k,$kv,$p); @@ -1576,8 +1565,6 @@ my class Str does Stringy { # declared in BOOTSTRAP Seq.new(Rakudo::Iterator.ReifiedList($matches)) } - # NOTE: if changing candidates' signatures, ensure Cool candidate has - # the same change applied to its candidates for this routine as well multi method split(Str:D: Str(Cool) $match, $limit is copy = Inf;; :$v is copy, :$k, :$kv, :$p, :$skip-empty) { my int $any = self!ensure-split-sanity($v,$k,$kv,$p); @@ -1739,8 +1726,6 @@ my class Str does Stringy { # declared in BOOTSTRAP } } - # NOTE: if changing candidates' signatures, ensure Cool candidate has - # the same change applied to its candidates for this routine as well multi method split(Str:D: @needles, $parts is copy = Inf;; :$v is copy, :$k, :$kv, :$p, :$skip-empty) { my int $any = self!ensure-split-sanity($v,$k,$kv,$p); From b6982e6892bcde9dd453eb63ed8e09f542c51e4a Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sun, 15 Oct 2017 00:00:08 +0200 Subject: [PATCH 470/692] Streamline Routine traits - give name to role for better gisting - make sure we only mixin if a trueish value was specified - traits affected: - is hidden-from -backtrace - is hidden-from-USAGE - is pure - is nodal As part of research into RT #132290: the problem seems to occur the moment we mixin something into the Method object. Which shouldn't matter for method dispatching, but apparently does as Method.gist is then no longer seen. --- src/core/traits.pm | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/src/core/traits.pm b/src/core/traits.pm index cab8d270e96..a73fb99813a 100644 --- a/src/core/traits.pm +++ b/src/core/traits.pm @@ -337,25 +337,27 @@ multi sub trait_mod:(Routine:D $target, Mu:U $type) { } multi sub trait_mod:(Routine:D $r, :$hidden-from-backtrace!) { - $r.^mixin( role { method is-hidden-from-backtrace(--> True) { } } ); + $r.^mixin( role is-hidden-from-backtrace { + method is-hidden-from-backtrace(--> True) { } + }) if $hidden-from-backtrace; } multi sub trait_mod:(Routine:D $r, :$hidden-from-USAGE!) { - $r.^mixin( role { + $r.^mixin( role is-hidden-from-USAGE { method is-hidden-from-USAGE(--> True) { } - }); + }) if $hidden-from-USAGE; } multi sub trait_mod:(Routine:D $r, :$pure!) { - $r.^mixin( role { + $r.^mixin( role is-pure { method IS_PURE(--> True) { } - }); + }) if $pure; } multi sub trait_mod:(Routine:D $r, :$nodal!) { - $r.^mixin( role { + $r.^mixin( role is-nodal { method nodal(--> True) { } - }); + }) if $nodal; } proto sub trait_mod:(|) { * } From bb1df2cb0c52b6eef65532710620f913ce1e8c2f Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sun, 15 Oct 2017 00:15:43 +0200 Subject: [PATCH 471/692] Streamline "is pure" trait handling - rename role's method to "is-pure", to be consistent with other traits - don't bother calling the method: the existence is the flag --- src/Perl6/Actions.nqp | 4 ++-- src/Perl6/Optimizer.nqp | 2 +- src/core/traits.pm | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Perl6/Actions.nqp b/src/Perl6/Actions.nqp index f068a0ace40..c1822fad741 100644 --- a/src/Perl6/Actions.nqp +++ b/src/Perl6/Actions.nqp @@ -352,7 +352,7 @@ sub unwanted($ast, $by) { my $subname := $node0[0].name; my $subfun := try $*W.find_symbol([$subname]); if $subfun { - if nqp::index($node0.name, 'ASSIGN') < 0 && nqp::can($subfun, 'IS_PURE') && $subfun.IS_PURE { + if nqp::index($node0.name, 'ASSIGN') < 0 && nqp::can($subfun, 'is-pure') { $purity := 1; } } @@ -7265,7 +7265,7 @@ class Perl6::Actions is HLL::Actions does STDActions { if nqp::istype($basepast, QAST::Var) { my $subfun := try $*W.find_symbol([$basepast.name]); if $subfun { - $purity := 1 if nqp::can($subfun, 'IS_PURE') && $subfun.IS_PURE; + $purity := 1 if nqp::can($subfun, 'is-pure'); } else { $purity := 1; # assume will be defined pure diff --git a/src/Perl6/Optimizer.nqp b/src/Perl6/Optimizer.nqp index 5d6fb6ed0fd..15aeab0f61c 100644 --- a/src/Perl6/Optimizer.nqp +++ b/src/Perl6/Optimizer.nqp @@ -1408,7 +1408,7 @@ class Perl6::Optimizer { self.convert_unicode_op_to_ascii($op); # Pure operators can be constant folded. - if nqp::can($obj, 'IS_PURE') && $obj.IS_PURE { + if nqp::can($obj, 'is-pure') { # First ensure we're not in void context; warn if so. sub widen($m) { my int $from := $m.from; diff --git a/src/core/traits.pm b/src/core/traits.pm index a73fb99813a..3a55ad7a1f5 100644 --- a/src/core/traits.pm +++ b/src/core/traits.pm @@ -350,7 +350,7 @@ multi sub trait_mod:(Routine:D $r, :$hidden-from-USAGE!) { multi sub trait_mod:(Routine:D $r, :$pure!) { $r.^mixin( role is-pure { - method IS_PURE(--> True) { } + method is-pure (--> True) { } }) if $pure; } From 317ae16c0ef0ebd321389a5b5c75658819d0a2d1 Mon Sep 17 00:00:00 2001 From: Daniel Green Date: Sat, 14 Oct 2017 19:53:36 -0400 Subject: [PATCH 472/692] Simplify signatures for Regex and Associative... multis of INTERPOLATE. --- src/core/Match.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/Match.pm b/src/core/Match.pm index 3336039e2de..38668559f43 100644 --- a/src/core/Match.pm +++ b/src/core/Match.pm @@ -410,7 +410,7 @@ my class Match is Capture is Cool does NQPMatchRole { !! $cur } - multi method INTERPOLATE(Associative \var, int $im, int $monkey, int $s, int $a, $context) { + multi method INTERPOLATE(Associative:D \var, int $im, int $monkey, int $s, int $a, $context) { my $cur := self.'!cursor_start_cur'(); if $a { return $cur.'!cursor_start_cur'() @@ -510,7 +510,7 @@ my class Match is Capture is Cool does NQPMatchRole { !! $cur } - multi method INTERPOLATE(Regex \var, int $im, int $monkey, int $s, int $a, $context) { + multi method INTERPOLATE(Regex:D \var, $, $, $, $, $) { my $maxmatch; my $cur := self.'!cursor_start_cur'(); From ee0bcbd86e9dde970e9019926505bb059e39ec08 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sun, 15 Oct 2017 04:38:16 -0400 Subject: [PATCH 473/692] Pass correct types to :bin The only reason this didn't crash in the past is due to RT#132307 --- src/core/Argfiles.pm | 4 ++-- src/core/IO/CatHandle.pm | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/core/Argfiles.pm b/src/core/Argfiles.pm index 466384eb38e..57d53c7aa41 100644 --- a/src/core/Argfiles.pm +++ b/src/core/Argfiles.pm @@ -12,8 +12,8 @@ Rakudo::Internals.REGISTER-DYNAMIC: '$*ARGFILES', { ?? IO::ArgFiles.new(@*ARGS) !! IO::ArgFiles.new: (my $in := $*IN), - :nl-in($in.nl-in), :chomp($in.chomp), - :encoding($in.encoding), :bin(nqp::isfalse($in.encoding)); + :nl-in($in.nl-in), :chomp($in.chomp), :encoding($in.encoding), + :bin(nqp::p6bool(nqp::isfalse($in.encoding))); } # vim: ft=perl6 expandtab sw=4 diff --git a/src/core/IO/CatHandle.pm b/src/core/IO/CatHandle.pm index ecf872e5756..557a417ef39 100644 --- a/src/core/IO/CatHandle.pm +++ b/src/core/IO/CatHandle.pm @@ -66,14 +66,14 @@ my class IO::CatHandle is IO::Handle { nqp::if( nqp::istype( ($_ = .open: :r, :$!chomp, :$!nl-in, :enc($!encoding), - :bin(nqp::isfalse($!encoding))), + :bin(nqp::p6bool(nqp::isfalse($!encoding)))), Failure), .throw, ($!active-handle = $_))), nqp::if( nqp::istype( ($_ := .IO.open: :r, :$!chomp, :$!nl-in, :enc($!encoding), - :bin(nqp::isfalse($!encoding))), + :bin(nqp::p6bool(nqp::isfalse($!encoding)))), Failure), .throw, ($!active-handle = $_))), From d23a9ba9d2d0da1d9196c85bdbe6c2e19e13f9b3 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sun, 15 Oct 2017 04:39:00 -0400 Subject: [PATCH 474/692] Add IO::CatHandle to RESTRICTED setting --- src/RESTRICTED.setting | 1 + 1 file changed, 1 insertion(+) diff --git a/src/RESTRICTED.setting b/src/RESTRICTED.setting index c05e32c8488..977dd8970d6 100644 --- a/src/RESTRICTED.setting +++ b/src/RESTRICTED.setting @@ -33,6 +33,7 @@ my class RESTRICTED-CLASS is Mu { method gist(|) { restricted(self.^name) } } +my class IO::CatHandle is RESTRICTED-CLASS { } my class IO::Handle is RESTRICTED-CLASS { } my class IO::Path is RESTRICTED-CLASS { } my class IO::Pipe is RESTRICTED-CLASS { } From 74328278f84ba7b1e283921030b60f1fdc9d44ce Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sun, 15 Oct 2017 14:24:18 -0400 Subject: [PATCH 475/692] Fix IO::Pipe.close not always returning the Proc Currently, only the .close on the last open handle returns the Proc object, the rest return Nil, and since using Proc in Bool context is a way to check whether it was successful, the Nil interferes with such a test, giving a false negative. --- src/core/Proc.pm | 9 ++------- 1 file changed, 2 insertions(+), 7 deletions(-) diff --git a/src/core/Proc.pm b/src/core/Proc.pm index 63c665acd71..4cfdc47eafb 100644 --- a/src/core/Proc.pm +++ b/src/core/Proc.pm @@ -146,13 +146,8 @@ my class Proc { } method !await-if-last-handle() { - if --$!active-handles { - Nil - } - else { - self!wait-for-finish; - self - } + self!wait-for-finish unless --$!active-handles; + self } method !wait-for-finish { From 1706194c728971747c1346ee05462c6b59ef6338 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sun, 15 Oct 2017 14:52:35 -0400 Subject: [PATCH 476/692] Add extra proc async tests From https://github.com/perl6/roast/commit/37cc7eaacc --- t/spectest.data | 2 ++ 1 file changed, 2 insertions(+) diff --git a/t/spectest.data b/t/spectest.data index 84d10bdfc02..24cf84ec725 100644 --- a/t/spectest.data +++ b/t/spectest.data @@ -836,6 +836,8 @@ S17-promise/anyof.t S17-promise/basic.t S17-promise/in.t # slow S17-promise/lock-async.t +S17-promise/lock-async-stress.t # stress slow +S17-promise/lock-async-stress2.t # stress slow S17-promise/start.t # slow S17-promise/stress.t # stress S17-promise/then.t From 084078e1c3bd7ca41928f374c26e6a7845db0033 Mon Sep 17 00:00:00 2001 From: MasterDuke17 Date: Sun, 15 Oct 2017 16:56:49 -0400 Subject: [PATCH 477/692] Improve wrong arity error for anonymous subs If the routine doesn't have a name, use '' instead. --- src/Perl6/Metamodel/BOOTSTRAP.nqp | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Perl6/Metamodel/BOOTSTRAP.nqp b/src/Perl6/Metamodel/BOOTSTRAP.nqp index b6e839057ca..6c1d716403e 100644 --- a/src/Perl6/Metamodel/BOOTSTRAP.nqp +++ b/src/Perl6/Metamodel/BOOTSTRAP.nqp @@ -166,6 +166,7 @@ my class Binder { } my str $s := $arity == 1 ?? "" !! "s"; my str $routine := nqp::getcodeobj(nqp::ctxcode($lexpad)).name; + $routine := '' unless $routine; if $arity == $count { return "$error_prefix positionals passed to '$routine'; expected $arity argument$s but got $num_pos_args"; From d6a9edacf2eba66b8d1e971f2b7f631d8edfa398 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Mon, 16 Oct 2017 16:10:32 +0200 Subject: [PATCH 478/692] Remove unneeded var, improve push-all on native arrays Mentioned in RT #132306, this is what I probably had in mind working on that. --- src/core/native_array.pm | 33 ++++++++++++++----------- tools/build/makeNATIVE_SHAPED_ARRAY.pl6 | 9 ++++--- 2 files changed, 23 insertions(+), 19 deletions(-) diff --git a/src/core/native_array.pm b/src/core/native_array.pm index ba44ca4d92d..7637ee3b8d6 100644 --- a/src/core/native_array.pm +++ b/src/core/native_array.pm @@ -1017,7 +1017,7 @@ my class array does Iterable { } #- start of generated part of shapedintarray role ----------------------------- -#- Generated on 2017-08-15T17:55:57+02:00 by tools/build/makeNATIVE_SHAPED_ARRAY.pl6 +#- Generated on 2017-10-16T15:04:46+02:00 by tools/build/makeNATIVE_SHAPED_ARRAY.pl6 #- PLEASE DON'T CHANGE ANYTHING BELOW THIS LINE role shapedintarray does shapedarray { @@ -1396,11 +1396,12 @@ my class array does Iterable { method push-all($target --> IterationEnd) { nqp::stmts( (my int $elems = nqp::elems($!list)), - (my int $i = -1), + (my int $pos = $!pos), nqp::while( - nqp::islt_i(($!pos = nqp::add_i($!pos,1)),$elems), - $target.push(nqp::atpos_i($!list,$!pos)) - ) + nqp::islt_i(($pos = nqp::add_i($pos,1)),$elems), + $target.push(nqp::atpos_i($!list,$pos)) + ), + ($!pos = $pos) ) } method count-only() { nqp::p6box_i(nqp::elems($!list)) } @@ -1567,7 +1568,7 @@ my class array does Iterable { #- end of generated part of shapedintarray role ------------------------------- #- start of generated part of shapednumarray role ----------------------------- -#- Generated on 2017-08-15T17:55:57+02:00 by tools/build/makeNATIVE_SHAPED_ARRAY.pl6 +#- Generated on 2017-10-16T15:04:46+02:00 by tools/build/makeNATIVE_SHAPED_ARRAY.pl6 #- PLEASE DON'T CHANGE ANYTHING BELOW THIS LINE role shapednumarray does shapedarray { @@ -1946,11 +1947,12 @@ my class array does Iterable { method push-all($target --> IterationEnd) { nqp::stmts( (my int $elems = nqp::elems($!list)), - (my int $i = -1), + (my int $pos = $!pos), nqp::while( - nqp::islt_i(($!pos = nqp::add_i($!pos,1)),$elems), - $target.push(nqp::atpos_n($!list,$!pos)) - ) + nqp::islt_i(($pos = nqp::add_i($pos,1)),$elems), + $target.push(nqp::atpos_n($!list,$pos)) + ), + ($!pos = $pos) ) } method count-only() { nqp::p6box_i(nqp::elems($!list)) } @@ -2117,7 +2119,7 @@ my class array does Iterable { #- end of generated part of shapednumarray role ------------------------------- #- start of generated part of shapedstrarray role ----------------------------- -#- Generated on 2017-08-15T17:55:57+02:00 by tools/build/makeNATIVE_SHAPED_ARRAY.pl6 +#- Generated on 2017-10-16T15:04:46+02:00 by tools/build/makeNATIVE_SHAPED_ARRAY.pl6 #- PLEASE DON'T CHANGE ANYTHING BELOW THIS LINE role shapedstrarray does shapedarray { @@ -2496,11 +2498,12 @@ my class array does Iterable { method push-all($target --> IterationEnd) { nqp::stmts( (my int $elems = nqp::elems($!list)), - (my int $i = -1), + (my int $pos = $!pos), nqp::while( - nqp::islt_i(($!pos = nqp::add_i($!pos,1)),$elems), - $target.push(nqp::atpos_s($!list,$!pos)) - ) + nqp::islt_i(($pos = nqp::add_i($pos,1)),$elems), + $target.push(nqp::atpos_s($!list,$pos)) + ), + ($!pos = $pos) ) } method count-only() { nqp::p6box_i(nqp::elems($!list)) } diff --git a/tools/build/makeNATIVE_SHAPED_ARRAY.pl6 b/tools/build/makeNATIVE_SHAPED_ARRAY.pl6 index 590383d3f11..eed9f47e562 100644 --- a/tools/build/makeNATIVE_SHAPED_ARRAY.pl6 +++ b/tools/build/makeNATIVE_SHAPED_ARRAY.pl6 @@ -418,11 +418,12 @@ for $*IN.lines -> $line { method push-all($target --> IterationEnd) { nqp::stmts( (my int $elems = nqp::elems($!list)), - (my int $i = -1), + (my int $pos = $!pos), nqp::while( - nqp::islt_i(($!pos = nqp::add_i($!pos,1)),$elems), - $target.push(nqp::atpos_#postfix#($!list,$!pos)) - ) + nqp::islt_i(($pos = nqp::add_i($pos,1)),$elems), + $target.push(nqp::atpos_#postfix#($!list,$pos)) + ), + ($!pos = $pos) ) } method count-only() { nqp::p6box_i(nqp::elems($!list)) } From 2352efe51390183258126a2868c60906bf507c55 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Mon, 16 Oct 2017 17:39:33 +0200 Subject: [PATCH 479/692] Gut current, broken, hyper/race implementation --- src/core/Any-iterable-methods.pm | 38 ----- src/core/HyperConfiguration.pm | 6 +- src/core/HyperIterable.pm | 6 - src/core/HyperIterator.pm | 29 ---- src/core/HyperSeq.pm | 238 +------------------------------ src/core/HyperWorkBuffer.pm | 59 -------- src/core/Iterable.pm | 26 +--- tools/build/jvm_core_sources | 3 - tools/build/moar_core_sources | 3 - 9 files changed, 5 insertions(+), 403 deletions(-) delete mode 100644 src/core/HyperIterable.pm delete mode 100644 src/core/HyperIterator.pm delete mode 100644 src/core/HyperWorkBuffer.pm diff --git a/src/core/Any-iterable-methods.pm b/src/core/Any-iterable-methods.pm index 2958526eb90..498280fab6a 100644 --- a/src/core/Any-iterable-methods.pm +++ b/src/core/Any-iterable-methods.pm @@ -18,44 +18,6 @@ Did you mean to add a stub (\{...\}) or did you mean to .classify?" sequential-map(($item ?? (SELF,) !! SELF).iterator, &block, $label); } - multi method map(HyperIterable:D: █; :$label) { - # For now we only know how to parallelize when we've only one input - # value needed per block. For the rest, fall back to sequential. - if &block.count != 1 { - sequential-map(self.iterator, &block, $label) - } - else { - HyperSeq.new(class :: does HyperIterator { - has $!source; - has &!block; - - method new(\source, &block) { - my \iter = nqp::create(self); - nqp::bindattr(iter, self, '$!source', source); - nqp::bindattr(iter, self, '&!block', &block); - iter - } - - method fill-buffer(HyperWorkBuffer:D $work, int $items) { - $!source.fill-buffer($work, $items); - } - - method process-buffer(HyperWorkBuffer:D $work) { - unless $!source.process-buffer($work) =:= Nil { - $work.swap(); - } - my \buffer-mapper = sequential-map($work.input-iterator, &!block, $label); - buffer-mapper.iterator.push-all($work.output); - $work - } - - method configuration() { - $!source.configuration - } - }.new(self.hyper-iterator, &block)) - } - } - my class IterateOneWithPhasers does SlippyIterator { has &!block; has $!source; diff --git a/src/core/HyperConfiguration.pm b/src/core/HyperConfiguration.pm index 7da3ab55117..ab2b4dd3e5e 100644 --- a/src/core/HyperConfiguration.pm +++ b/src/core/HyperConfiguration.pm @@ -1,8 +1,6 @@ -# Configuration for hyper/race, controlling how we parallelize. Not a class -# end users can expect to work with unless they're doing truly special -# things. +# Configuration for hyper/race, controlling how we parallelize (number of +# items at a time, and number of threads). my class HyperConfiguration { - has Bool $.race; has int $.batch; has Int $.degree; } diff --git a/src/core/HyperIterable.pm b/src/core/HyperIterable.pm deleted file mode 100644 index 752ebffec65..00000000000 --- a/src/core/HyperIterable.pm +++ /dev/null @@ -1,6 +0,0 @@ -# HyperIterable is done by anything that can produce a HyperIterator. -my role HyperIterable { - method hyper-iterator() { ... } -} - -# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/HyperIterator.pm b/src/core/HyperIterator.pm deleted file mode 100644 index 6e36ccd251a..00000000000 --- a/src/core/HyperIterator.pm +++ /dev/null @@ -1,29 +0,0 @@ -# HyperIterator is done by things that know how to get a batch of values -# filled up, and maybe to process it. -my class HyperWorkBuffer { ... } -my class HyperConfiguration { ... } -my role HyperIterator { - # Called in order to fill up a work buffer with items. For things that - # can be part of a pipeline of operations, this simply defers to the - # next thing in the pipeline, up until a source is reached. The source - # should push items to the input of the work buffer. Only one thread - # can ever be calling fill-batch on a given iterator chain at a time - # (usually the co-ordinating thread), so you can safely consume items - # from any usual iterable to fill the batch. Return IterationEnd if this - # is the last buffer you can produce, and anything else otherwise. - method fill-buffer(HyperWorkBuffer:D $work, int $items) { ... } - - # Process the provided work buffer. If you are a source, then return Mu. - # If you are a processing stage, you should pass the work buffer down to - # the next process-buffer in the chain. If it returns a HyperWorkBuffer, - # then .swap() it so the previous stage's output is now your input, and - # then process it, putting your results into the output buffer. This is - # the code that can run on any thread; keep it side-effect free. - method process-buffer(HyperWorkBuffer:D $work) { ... } - - # Gets HyperConfiguration information for this parallelized operation. - # Processing stages should ask their source. - method configuration() { ... } -} - -# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/HyperSeq.pm b/src/core/HyperSeq.pm index 6d9c4949850..1a7d8ef4f60 100644 --- a/src/core/HyperSeq.pm +++ b/src/core/HyperSeq.pm @@ -1,240 +1,4 @@ -# A HyperSeq wraps up a HyperIterator. When asked for the hyper-iterator, it -# simply returns it, then complains if you ask a second time - much like Seq -# does for its iterator. If you ask for its iterator, then you are ending the -# declaration of a chain of parallelizable operations. That is, in fact, the -# thing that will actually kick off the parallel work. -my class HyperSeq does Iterable does HyperIterable does PositionalBindFailover { - has HyperIterator $!hyper-iter; - - # The only valid way to create a HyperSeq directly is by giving it the - # hyper-iterator it will expose and maybe memoize. - method new(HyperIterator:D $hyper-iter) { - nqp::p6bindattrinvres( - nqp::create(self),HyperSeq,'$!hyper-iter',nqp::decont($hyper-iter) - ) - } - - # Obtains the hyper-iterator (meaning we're being consumed as part of a - # parallel processing pipeline). - method hyper-iterator(HyperSeq:D:) { - my \hyper-iter = $!hyper-iter; - X::Seq::Consumed.new.throw unless hyper-iter.DEFINITE; - $!hyper-iter := HyperIterator; - hyper-iter - } - - # Obtain the iterator, the consumption of which will kick off parallel - # processing. - method iterator(HyperSeq:D:) { - class :: does Iterator { - my constant NOT_STARTED = 0; - my constant STARTED = 1; - my constant ALL_ADDED = 2; - - # For concurrency control - has $!lock; - has $!cond-have-work; - has $!cond-have-result; - - # State that must be protected by the above lock, used by all - # threads involved. - has $!work-available; - has $!work-completed; - has int $!in-progress; - - # State only touched by the thread controlling the iteration. - has $!configuration; - has $!hyper-iterator; - has $!active-result-buffer; - has $!status; - has int $!sequence-number; - - has int $!next-result-sequence-number; - - method new(\hyper-iterator) { - my \iter = nqp::create(self); - my \lock = Lock.new; - nqp::bindattr(iter, self, '$!hyper-iterator', hyper-iterator); - nqp::bindattr(iter, self, '$!configuration', hyper-iterator.configuration); - nqp::bindattr(iter, self, '$!work-available', nqp::create(IterationBuffer)); - nqp::bindattr(iter, self, '$!work-completed', nqp::create(IterationBuffer)); - nqp::bindattr(iter, self, '$!lock', lock); - nqp::bindattr(iter, self, '$!cond-have-work', lock.condition); - nqp::bindattr(iter, self, '$!cond-have-result', lock.condition); - nqp::bindattr(iter, self, '$!status', NOT_STARTED); - iter - } - - method pull-one() { - self!start() if $!status == NOT_STARTED; - self!block-for-result() unless $!active-result-buffer.DEFINITE; - if $!active-result-buffer.DEFINITE { - my \result = nqp::shift($!active-result-buffer); - $!active-result-buffer := Mu - unless nqp::elems($!active-result-buffer); - result - } - else { - IterationEnd - } - } - - method !start(--> Nil) { - # Mark that we've started the work (done here because this - # may get upgraded to ALL_ADDED if there's not much work). - $!status := STARTED; - - # Add batches and start workers. Provided there is enough - # work to do, this should feed them all nicely. - for ^$!configuration.degree { - my \done = self!add-batch(); - self!start-worker(); - last if done =:= IterationEnd; - } - } - - method !add-batch() { - my \work = HyperWorkBuffer.new; - work.sequence-number = $!sequence-number++; - # XXX error handling around below - my \done = $!hyper-iterator.fill-buffer(work, $!configuration.batch); - $!lock.protect({ - nqp::push($!work-available, work); - if done =:= IterationEnd { - $!status := ALL_ADDED; - $!cond-have-work.signal_all(); - } else { - $!cond-have-work.signal(); - } - }); - done - } - - method !start-worker() { - start { - loop { - # Acquire work. - my $my-work; - $!lock.protect({ - until $my-work.DEFINITE { - if nqp::elems($!work-available) { - $my-work := nqp::shift($!work-available); - $!in-progress++; - } - elsif $!status == ALL_ADDED { - last; - } - else { - $!cond-have-work.wait(); - } - } - }); - unless $my-work.DEFINITE { - $!cond-have-result.signal(); - last; - } - - # Do work. - try { - $!hyper-iterator.process-buffer($my-work); - CATCH { - default { - # GLR XXX error handling - nqp::say(.gist); - } - } - } - - # Place in results and signal anyone waiting for it. - $!lock.protect({ - nqp::push($!work-completed, $my-work); - $!in-progress--; - $!cond-have-result.signal(); - }); - } - } - } - - method !block-for-result(--> Nil) { - my int $we-got-an-empty-buffer; - my int $last-amount-of-completed = 0; - repeat while $we-got-an-empty-buffer { - my int $work-deficit = 0; - $we-got-an-empty-buffer = 0; - $!lock.protect({ - until nqp::elems($!work-completed) > $last-amount-of-completed || self!finished() { - $!cond-have-result.wait(); - } - my Mu $backlog := Mu; - while nqp::elems($!work-completed) && !$we-got-an-empty-buffer { - my $first-result := nqp::shift($!work-completed); - if $!configuration.race || $first-result.sequence-number == $!next-result-sequence-number { - $!active-result-buffer := $first-result.output; - $!next-result-sequence-number++; - } else { - if $backlog =:= Mu { - $backlog := nqp::list(); - } - nqp::push($backlog, $first-result); - } - $work-deficit = $!configuration.degree - nqp::elems($!work-available); - if $!active-result-buffer =:= Mu || $!active-result-buffer.elems == 0 { - $!active-result-buffer := Mu; - $we-got-an-empty-buffer = 1; - } else { - last; - } - } - unless $backlog =:= Mu { - while nqp::elems($backlog) { - nqp::push($!work-completed, nqp::shift($backlog)); - } - } - $last-amount-of-completed = nqp::elems($!work-completed); - }); - while $!status != ALL_ADDED && $work-deficit > 0 { - last if self!add-batch() =:= IterationEnd; - $work-deficit--; - } - } - } - - method !finished() { - $!status == ALL_ADDED && - nqp::elems($!work-available) == 0 && - $!in-progress == 0 - } - }.new(self.hyper-iterator) - } - - # Various operations use the sequential iterator since they wish to set - # off the parallel processing and consume the results. - method List(HyperSeq:D:) { - List.from-iterator(self.iterator) - } - method Slip(HyperSeq:D:) { - Slip.from-iterator(self.iterator) - } - method Array(HyperSeq:D:) { - Array.from-iterator(self.iterator) - } - method sink(HyperSeq:D: --> Nil) { - # Means we're doing parallel work for its side-effects. Doesn't need - # any special handling, nor does it warrant a warning since this is - # what 'hyper for @xs -> $x { }' will end up calling. - self.iterator.sink-all; - } - - # Not indexable. - multi method AT-POS(HyperSeq:D: $) { - X::Seq::NotIndexable.new.throw - } - multi method EXISTS-POS(HyperSeq:D: $) { - X::Seq::NotIndexable.new.throw - } - multi method DELETE-POS(HyperSeq:D: $) { - X::Seq::NotIndexable.new.throw - } +my class HyperSeq { } # vim: ft=perl6 expandtab sw=4 diff --git a/src/core/HyperWorkBuffer.pm b/src/core/HyperWorkBuffer.pm deleted file mode 100644 index 483b355ac4f..00000000000 --- a/src/core/HyperWorkBuffer.pm +++ /dev/null @@ -1,59 +0,0 @@ -# A HyperWorkBuffer represents a chunk of work to be processed as part of a -# parallelized operation (either thanks to hyper or race). It carries a -# sequence number, and input buffer (items to process), and an output buffer -# (results of processing them). -my class HyperWorkBuffer { - has int $.sequence-number is rw; - has $.input; - has $.output; - - method new() { - my \wb = nqp::create(self); - nqp::bindattr(wb, HyperWorkBuffer, '$!input', nqp::create(IterationBuffer)); - nqp::bindattr(wb, HyperWorkBuffer, '$!output', nqp::create(IterationBuffer)); - wb - } - - # Clears both buffers. - method clear(--> Nil) { - nqp::setelems($!input, 0); - nqp::setelems($!output, 0); - } - - # Swaps around the input/output buffers, and clears the output buffer. - # (This is used between pipelined stages, where the next stage will - # use the items in the first.) - method swap(--> Nil) { - my $new-input := $!output; - $!output := $!input; - $!input := $new-input; - nqp::setelems($!output, 0); - } - - # Gets an iterator of the input. - method input-iterator() { - class :: does Iterator { - has $!buffer; - has int $!i; - - method new(\buffer) { - nqp::p6bindattrinvres( - nqp::create(self),self,'$!buffer',buffer - ) - } - - method pull-one() { - my int $i = $!i; - if $i < nqp::elems($!buffer) { - $!i = $i + 1; - nqp::atpos($!buffer, $i) - } - else { - IterationEnd - } - } - }.new($!input) - } -} - -# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Iterable.pm b/src/core/Iterable.pm index 838612208bc..27936fe56c0 100644 --- a/src/core/Iterable.pm +++ b/src/core/Iterable.pm @@ -119,34 +119,12 @@ my role Iterable { method hyper(Int(Cool) :$batch = 64, Int(Cool) :$degree = 4) { self!valid-hyper-race('hyper',$batch,$degree); - self!go-hyper(HyperConfiguration.new(:!race, :$batch, :$degree)) + die "NYI" } method race(Int(Cool) :$batch = 64, Int(Cool) :$degree = 4) { self!valid-hyper-race('race',$batch,$degree); - self!go-hyper(HyperConfiguration.new(:race, :$batch, :$degree)) - } - - method !go-hyper($configuration) { - HyperSeq.new(class :: does HyperIterator { - has $!source; - has $!configuration; - - method new(\iter, $configuration) { - my \hyper-iter = nqp::create(self); - nqp::bindattr(hyper-iter, self, '$!source', iter); - nqp::bindattr(hyper-iter, self, '$!configuration', $configuration); - hyper-iter - } - - method fill-buffer(HyperWorkBuffer:D $work, int $items) { - $!source.push-exactly($work.input, $items) - } - - method process-buffer(HyperWorkBuffer:D $work --> Nil) { } - - method configuration() { $!configuration } - }.new(self.iterator, $configuration)); + die "NYI" } sub MIXIFY(\iterable, \type) { diff --git a/tools/build/jvm_core_sources b/tools/build/jvm_core_sources index 0764e44b26e..676b28b0a31 100644 --- a/tools/build/jvm_core_sources +++ b/tools/build/jvm_core_sources @@ -16,9 +16,7 @@ src/core/Rakudo/Internals.pm src/core/Rakudo/Iterator.pm src/core/Rakudo/QuantHash.pm src/core/Rakudo/Sorting.pm -src/core/HyperIterator.pm src/core/Iterable.pm -src/core/HyperIterable.pm src/core/Any-iterable-methods.pm src/core/SLICE.pm src/core/Whatever.pm @@ -56,7 +54,6 @@ src/core/Str.pm src/core/Capture.pm src/core/IterationBuffer.pm src/core/HyperConfiguration.pm -src/core/HyperWorkBuffer.pm src/core/Sequence.pm src/core/Seq.pm src/core/HyperSeq.pm diff --git a/tools/build/moar_core_sources b/tools/build/moar_core_sources index 88f0c2ee45d..8ccfdfc0e05 100644 --- a/tools/build/moar_core_sources +++ b/tools/build/moar_core_sources @@ -16,9 +16,7 @@ src/core/Rakudo/Internals.pm src/core/Rakudo/Iterator.pm src/core/Rakudo/QuantHash.pm src/core/Rakudo/Sorting.pm -src/core/HyperIterator.pm src/core/Iterable.pm -src/core/HyperIterable.pm src/core/Any-iterable-methods.pm src/core/SLICE.pm src/core/Whatever.pm @@ -58,7 +56,6 @@ src/core/Str.pm src/core/Capture.pm src/core/IterationBuffer.pm src/core/HyperConfiguration.pm -src/core/HyperWorkBuffer.pm src/core/Sequence.pm src/core/Seq.pm src/core/HyperSeq.pm From d43b37385046e508f29fc230b9a66ae5cd32eeda Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Mon, 16 Oct 2017 18:26:34 +0200 Subject: [PATCH 480/692] Start to add guts of new hyper/race implementation --- .../Rakudo/Internals/HyperIteratorBatcher.pm | 42 ++++++++++++++ src/core/Rakudo/Internals/HyperToIterator.pm | 57 +++++++++++++++++++ src/core/Rakudo/Internals/HyperWorkBatch.pm | 44 ++++++++++++++ src/core/Rakudo/Internals/HyperWorkStage.pm | 55 ++++++++++++++++++ src/core/Rakudo/Internals/RaceToIterator.pm | 40 +++++++++++++ src/core/stubs.pm | 2 + tools/build/jvm_core_sources | 5 ++ tools/build/moar_core_sources | 5 ++ 8 files changed, 250 insertions(+) create mode 100644 src/core/Rakudo/Internals/HyperIteratorBatcher.pm create mode 100644 src/core/Rakudo/Internals/HyperToIterator.pm create mode 100644 src/core/Rakudo/Internals/HyperWorkBatch.pm create mode 100644 src/core/Rakudo/Internals/HyperWorkStage.pm create mode 100644 src/core/Rakudo/Internals/RaceToIterator.pm diff --git a/src/core/Rakudo/Internals/HyperIteratorBatcher.pm b/src/core/Rakudo/Internals/HyperIteratorBatcher.pm new file mode 100644 index 00000000000..bd8ba1cefb1 --- /dev/null +++ b/src/core/Rakudo/Internals/HyperIteratorBatcher.pm @@ -0,0 +1,42 @@ +# Batches values sourced from an iterator, producing a work batch from them. +my role Rakudo::Internals::HyperIteratorBatcher does Rakudo::Internals::HyperBatcher { + my constant NO_LOOKAHEAD = Mu.CREATE; + has Iterator $!iterator; + has $!lookahead; + + submethod BUILD(Iterator :$iterator!) { + $!iterator := $iterator; + $!lookahead := NO_LOOKAHEAD; + } + + method produce-batch(int $batch-size --> Rakudo::Internals::HyperWorkBatch) { + my IterationBuffer $items .= new; + my Bool $first; + my Bool $last; + if $!lookahead =:= NO_LOOKAHEAD { + $first = True; + if $!iterator.push-exactly($items, $batch-size) =:= IterationEnd { + $last = True; + } + else { + $!lookahead := $!iterator.pull-one; + $last = True if $!lookahead =:= IterationEnd; + } + } + else { + $first = False; + $items.push($!lookahead); + if $!iterator.push-exactly($items, $batch-size - 1) =:= IterationEnd { + $last = True; + } + else { + $!lookahead := $!iterator.pull-one; + $last = True if $!lookahead =:= IterationEnd; + } + } + my $sequence-number = self.next-sequence-number(); + return Rakudo::Internals::HyperWorkBatch.new(:$sequence-number, :$items, :$first, :$last); + } +} + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Rakudo/Internals/HyperToIterator.pm b/src/core/Rakudo/Internals/HyperToIterator.pm new file mode 100644 index 00000000000..9a38721898d --- /dev/null +++ b/src/core/Rakudo/Internals/HyperToIterator.pm @@ -0,0 +1,57 @@ +my class Rakudo::Internals::HyperToIterator does Rakudo::Internals::HyperJoiner does Iterator { + has Channel $.batches .= new; + + has int $!last-target = -1; + has int $!next-to-send = 0; + has @!held-back; + method consume-batch(Rakudo::Internals::HyperWorkBatch $batch --> Nil) { + if $batch.last { + $!last-target = $batch.sequence-number; + } + self!handle-batch($batch); + if $!last-target >= 0 && $!next-to-send > $!last-target { + $!batches.close; + } + } + method !handle-batch($batch) { + my int $seq = $batch.sequence-number; + if $seq == $!next-to-send { + $!batches.send($batch); + $!next-to-send++; + if @!held-back { + @!held-back.=sort(*.sequence-number); + while @!held-back && @!held-back[0].sequence-number == $!next-to-send { + $!batches.send(@!held-back.shift); + $!next-to-send++; + } + } + } + else { + @!held-back.push($batch); + } + } + + method consume-error(Exception $e --> Nil) { + note $e; + $!batches.fail($e); + } + + my constant EMPTY_BUFFER = IterationBuffer.CREATE; + has IterationBuffer $!current-items = EMPTY_BUFFER; + method pull-one() { + until nqp::elems(nqp::decont($!current-items)) { # Handles empty batches + my $batch = $!batches.receive; + self.batch-used(); + $!current-items = $batch.items; + CATCH { + when X::Channel::ReceiveOnClosed { + return IterationEnd; + } + # Throw other errors onwards + } + } + nqp::shift(nqp::decont($!current-items)) + } +} + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Rakudo/Internals/HyperWorkBatch.pm b/src/core/Rakudo/Internals/HyperWorkBatch.pm new file mode 100644 index 00000000000..73e03353338 --- /dev/null +++ b/src/core/Rakudo/Internals/HyperWorkBatch.pm @@ -0,0 +1,44 @@ +# A batch of work sent to a worker in a hyper or race operation. It is an +# Iterable, and iterates to the items in the batch. This is so that it can be +# easily processed in terms of (non-hyper) Iterable implementations. +my class Rakudo::Internals::HyperWorkBatch does Iterable { + # The items in the batch. + has IterationBuffer $.items; + + # Sequence number of the batch, starting from zero. + has int $.sequence-number; + + # Is this the first batch that was produced at the last fork point or the last batch that the + # fork point will produce? + has Bool $.first; + has Bool $.last; + + # Iterator for a HyperWorkBatch; + my class HyperWorkBatchIterator does Iterator { + has $!items; + has int $!i; + has int $!n; + + submethod BUILD(:$items --> Nil) { + $!items := nqp::decont($items); + $!i = 0; + $!n = nqp::elems($!items); + } + + method pull-one() { + $!i < $!n + ?? nqp::atpos($!items, $!i++) + !! IterationEnd + } + } + + method iterator(--> Iterator) { + HyperWorkBatchIterator.new(:$!items) + } + + method replace-with(IterationBuffer $ib --> Nil) { + $!items := $ib; + } +} + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Rakudo/Internals/HyperWorkStage.pm b/src/core/Rakudo/Internals/HyperWorkStage.pm new file mode 100644 index 00000000000..6255fdf2ee8 --- /dev/null +++ b/src/core/Rakudo/Internals/HyperWorkStage.pm @@ -0,0 +1,55 @@ +# Work stages are individual steps in a hyper/race pipeline. They are chained +# in a linked list by the source attribute. Roles for different kinds of stages +# follow. +my role Rakudo::Internals::HyperWorkStage { + has Rakudo::Internals::HyperWorkStage $.source; +} + +# A HyperBatcher stage produces batches of work to do. It will typically be +# created with an Iterable of some kind, and divide up the work into batches +# of the appropriate size. Such a stage always lives at the start of a piece +# of parallel processing pipeline. +my role Rakudo::Internals::HyperBatcher does Rakudo::Internals::HyperWorkStage { + has $!sequence = 0; + + method next-sequence-number() { + $!sequence++ + } + + method produce-batch(int $batch-size --> Rakudo::Internals::HyperWorkBatch) { ... } +} + +# A HyperProcessor performs some operation in a work batch, updating it to +# reflect the results of the operation. +my role Rakudo::Internals::HyperProcessor does Rakudo::Internals::HyperWorkStage { + method process-batch(Rakudo::Internals::HyperWorkBatch $batch --> Nil) { ... } +} + +# A HyperRebatcher is given batches, and may produce zero or more batches as a +# result. The produced batches will be passed on to the next pipeline stages. +# This is intended only for steps that need to look across multiple batches, +# but that work in a "streaming" way rather than being a full bottleneck in +# the pipeline. A HyperRebatcher should produce one output batch for each +# input batch it gets (though may produce no batches on one call, and two on +# the next, for example). +my role Rakudo::Internals::HyperRebatcher does Rakudo::Internals::HyperWorkStage { + method rebatch(Rakudo::Internals::HyperWorkBatch $batch --> List) { ... } +} + +# Comes at the end of a pipeline, or a stage in a multi-stage pipeline (that +# is, one with a step in it where all results are needed). The batch-used +# method should be called whenever a batch passed to consume-batch has been +# used. This allows for backpressure control: a sequential iterator at the +# end of a parallel pipeline can choose to call batch-used only at the point +# when the downstream iterator has actually eaten all the values in a batch. +my role Rakudo::Internals::HyperJoiner does Rakudo::Internals::HyperWorkStage { + has $!batch-used-channel; + method consume-batch(Rakudo::Internals::HyperWorkBatch $batch --> Nil) { ... } + method consume-error(Exception \e) { ... } + method batch-used(--> Nil) { + $!batch-used-channel.send(True); + } + method SET-BATCH-USED-CHANNEL($!batch-used-channel) {} +} + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Rakudo/Internals/RaceToIterator.pm b/src/core/Rakudo/Internals/RaceToIterator.pm new file mode 100644 index 00000000000..740d6562e5d --- /dev/null +++ b/src/core/Rakudo/Internals/RaceToIterator.pm @@ -0,0 +1,40 @@ +my class Rakudo::Internals::RaceToIterator does Rakudo::Internals::HyperJoiner does Iterator { + has Channel $.batches .= new; + + has int $!last-target = -1; + has int $!batches-seen = 0; + method consume-batch(Rakudo::Internals::HyperWorkBatch $batch --> Nil) { + $!batches.send($batch); + $!batches-seen++; + if $batch.last { + $!last-target = $batch.sequence-number; + } + if $!last-target >= 0 && $!batches-seen == $!last-target + 1 { + $!batches.close; + } + } + + method consume-error(Exception $e --> Nil) { + note $e; + $!batches.fail($e); + } + + my constant EMPTY_BUFFER = IterationBuffer.CREATE; + has IterationBuffer $!current-items = EMPTY_BUFFER; + method pull-one() { + until nqp::elems(nqp::decont($!current-items)) { # Handles empty batches + my $batch = $!batches.receive; + self.batch-used(); + $!current-items = $batch.items; + CATCH { + when X::Channel::ReceiveOnClosed { + return IterationEnd; + } + # Throw other errors onwards + } + } + nqp::shift(nqp::decont($!current-items)) + } +} + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/stubs.pm b/src/core/stubs.pm index e5e220f0292..6ea786e1bf5 100644 --- a/src/core/stubs.pm +++ b/src/core/stubs.pm @@ -8,9 +8,11 @@ my class X::AdHoc { ... } my class FatRat { ... } my class Pair { ... } my class Promise { ... } +my class Channel { ... } my class X::OutOfRange { ... } my class X::Dynamic::NotFound { ... } my class X::SecurityPolicy::Eval { ... } +my class X::Channel::ReceiveOnClosed { ... } my role QuantHash { ... } my role Setty { ... } diff --git a/tools/build/jvm_core_sources b/tools/build/jvm_core_sources index 676b28b0a31..a4252208442 100644 --- a/tools/build/jvm_core_sources +++ b/tools/build/jvm_core_sources @@ -56,6 +56,11 @@ src/core/IterationBuffer.pm src/core/HyperConfiguration.pm src/core/Sequence.pm src/core/Seq.pm +src/core/Rakudo/Internals/HyperWorkBatch.pm +src/core/Rakudo/Internals/HyperWorkStage.pm +src/core/Rakudo/Internals/HyperIteratorBatcher.pm +src/core/Rakudo/Internals/HyperToIterator.pm +src/core/Rakudo/Internals/RaceToIterator.pm src/core/HyperSeq.pm src/core/Nil.pm src/core/Range.pm diff --git a/tools/build/moar_core_sources b/tools/build/moar_core_sources index 8ccfdfc0e05..9a3986dbceb 100644 --- a/tools/build/moar_core_sources +++ b/tools/build/moar_core_sources @@ -58,6 +58,11 @@ src/core/IterationBuffer.pm src/core/HyperConfiguration.pm src/core/Sequence.pm src/core/Seq.pm +src/core/Rakudo/Internals/HyperWorkBatch.pm +src/core/Rakudo/Internals/HyperWorkStage.pm +src/core/Rakudo/Internals/HyperIteratorBatcher.pm +src/core/Rakudo/Internals/HyperToIterator.pm +src/core/Rakudo/Internals/RaceToIterator.pm src/core/HyperSeq.pm src/core/Nil.pm src/core/Range.pm From dfa230f7bd78b6faebf234bcdf58df71c76dbfb0 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Mon, 16 Oct 2017 18:37:54 +0200 Subject: [PATCH 481/692] Add new hyper/race pipeline builder This is the part that kicks off parallel workers. It does so using non-blocking constructs, so as not to exhaust the thread pool and to play nice with other tasks ongoing in the pool. This also means we'll have nice behavior if a parallel worker does a `react` or `await` (so, non-blocking under 6.d.PREVIEW). Support for rebatchers still to come. --- src/core/Rakudo/Internals/HyperPipeline.pm | 117 +++++++++++++++++++++ tools/build/jvm_core_sources | 1 + tools/build/moar_core_sources | 1 + 3 files changed, 119 insertions(+) create mode 100644 src/core/Rakudo/Internals/HyperPipeline.pm diff --git a/src/core/Rakudo/Internals/HyperPipeline.pm b/src/core/Rakudo/Internals/HyperPipeline.pm new file mode 100644 index 00000000000..d8a3dca59d2 --- /dev/null +++ b/src/core/Rakudo/Internals/HyperPipeline.pm @@ -0,0 +1,117 @@ +# Takes a linked list of pipeline stages and assembles them into a pipeline. +# Given a pipeline must end with a HyperJoiner, it expects to be passed +# something of this type. +my class Rakudo::Internals::HyperPipeline { + method start(Rakudo::Internals::HyperJoiner $stage, HyperConfiguration $config) { + # Create channel that the last non-join operation in the pipeline will + # put its results into, and start a worker to handle the channel. + my $cur-dest-channel = Channel.new; + self!join-worker($stage, $cur-dest-channel); + + # Create a channel that will signal we're ready for more batches, + # and set join stage to send on it when batch-used is called. + my $ready-channel = Channel.new; + $stage.SET-BATCH-USED-CHANNEL($ready-channel); + + # Go through the rest of the stages. + my $cur-stage = $stage.source; + my @processors; + while $cur-stage { + my $next-stage = $cur-stage.source; + given $cur-stage { + when Rakudo::Internals::HyperProcessor { + # Unshift them so a sequence will be in application order. + unshift @processors, $_; + } + when Rakudo::Internals::HyperBatcher { + if $next-stage { + die "A HyperBatcher may only be at the pipeline start"; + } + $cur-dest-channel = self!maybe-processor-workers: + [@processors], $cur-dest-channel, $config.degree; + @processors = (); + self!batch-worker($cur-stage, $cur-dest-channel, $ready-channel, + $config.batch); + } + default { + die "Unrecognized hyper pipeline stage " ~ .^name(); + } + } + $cur-stage = $next-stage; + } + + # Set off $degree batches. + $ready-channel.send(True) for ^$config.degree; + } + + method !batch-worker(Rakudo::Internals::HyperBatcher $stage, Channel $dest-channel, + Channel $ready-channel, int $size) { + start { + loop { + $*AWAITER.await($ready-channel); + my $batch := $stage.produce-batch($size); + $dest-channel.send($batch); + last if $batch.last; + CATCH { + default { + .note; + $dest-channel.fail($_); + } + } + } + } + } + + method !maybe-processor-workers(@processors, Channel $dest-channel, Int $degree) { + return $dest-channel unless @processors; + my $source-channel := Channel.new; + for ^$degree { + start { + loop { + my $batch := $*AWAITER.await($source-channel); + for @processors { + .process-batch($batch); + } + $dest-channel.send($batch); + } + CATCH { + when X::Channel::ReceiveOnClosed { + $dest-channel.close; + } + default { + .note; + $dest-channel.fail($_); + } + } + } + } + return $source-channel; + } + + method !join-worker(Rakudo::Internals::HyperJoiner $stage, Channel $source) { + start { + loop { + $stage.consume-batch($*AWAITER.await($source)); + } + CATCH { + when X::Channel::ReceiveOnClosed { + # We got everything; quietly exit the start block. + } + default { + $stage.consume-error($_); + CATCH { + default { + # Error handling code blew up; let the scheduler's + # error handler do it, which will typically bring + # the program down. Should never get here unless + # we've some bug in a joiner implementation. + $*SCHEDULER.handle_uncaught($_); + } + } + } + } + } + } +} + +# vim: ft=perl6 expandtab sw=4 diff --git a/tools/build/jvm_core_sources b/tools/build/jvm_core_sources index a4252208442..79a76dc6fd3 100644 --- a/tools/build/jvm_core_sources +++ b/tools/build/jvm_core_sources @@ -58,6 +58,7 @@ src/core/Sequence.pm src/core/Seq.pm src/core/Rakudo/Internals/HyperWorkBatch.pm src/core/Rakudo/Internals/HyperWorkStage.pm +src/core/Rakudo/Internals/HyperPipeline.pm src/core/Rakudo/Internals/HyperIteratorBatcher.pm src/core/Rakudo/Internals/HyperToIterator.pm src/core/Rakudo/Internals/RaceToIterator.pm diff --git a/tools/build/moar_core_sources b/tools/build/moar_core_sources index 9a3986dbceb..6560f4f1782 100644 --- a/tools/build/moar_core_sources +++ b/tools/build/moar_core_sources @@ -60,6 +60,7 @@ src/core/Sequence.pm src/core/Seq.pm src/core/Rakudo/Internals/HyperWorkBatch.pm src/core/Rakudo/Internals/HyperWorkStage.pm +src/core/Rakudo/Internals/HyperPipeline.pm src/core/Rakudo/Internals/HyperIteratorBatcher.pm src/core/Rakudo/Internals/HyperToIterator.pm src/core/Rakudo/Internals/RaceToIterator.pm From 1fdc84fe04b644a472684b76395dd32bd8094df4 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Mon, 16 Oct 2017 19:38:24 +0200 Subject: [PATCH 482/692] Start new HyperSeq/RaceSeq, wire up hyper/race Supports parallel evaluation of basic cases of map and grep. --- src/core/HyperSeq.pm | 27 ++++++- src/core/Iterable.pm | 21 ++++-- src/core/RaceSeq.pm | 30 ++++++++ .../Rakudo/Internals/HyperRaceSharedImpl.pm | 72 +++++++++++++++++++ tools/build/jvm_core_sources | 4 +- tools/build/moar_core_sources | 4 +- 6 files changed, 150 insertions(+), 8 deletions(-) create mode 100644 src/core/RaceSeq.pm create mode 100644 src/core/Rakudo/Internals/HyperRaceSharedImpl.pm diff --git a/src/core/HyperSeq.pm b/src/core/HyperSeq.pm index 1a7d8ef4f60..094d0f1f631 100644 --- a/src/core/HyperSeq.pm +++ b/src/core/HyperSeq.pm @@ -1,4 +1,29 @@ -my class HyperSeq { +# A HyperSeq performs batches of work in parallel, but retains order of output +# values relative to input values. +my class HyperSeq does Iterable does Sequence { + has HyperConfiguration $.configuration; + has Rakudo::Internals::HyperWorkStage $!work-stage-head; + + submethod BUILD(:$!configuration!, :$!work-stage-head!) {} + + method iterator(HyperSeq:D: --> Iterator) { + my $joiner := Rakudo::Internals::HyperToIterator.new: + source => $!work-stage-head; + Rakudo::Internals::HyperPipeline.start($joiner, $!configuration); + $joiner + } + + method grep(HyperSeq:D: $matcher, *%options) { + Rakudo::Internals::HyperRaceSharedImpl.grep: + self, $!work-stage-head, $matcher, %options + } + + method map(HyperSeq:D: $matcher, *%options) { + Rakudo::Internals::HyperRaceSharedImpl.map: + self, $!work-stage-head, $matcher, %options + } + + method hyper(HyperSeq:D:) { self } } # vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Iterable.pm b/src/core/Iterable.pm index 27936fe56c0..198be53152f 100644 --- a/src/core/Iterable.pm +++ b/src/core/Iterable.pm @@ -5,8 +5,11 @@ # Additionally, as .lazy and .eager are about iterator behavior, they are # provided by this role. Overriding those is not likely to be needed, and # discouraged to maintain predictable semantics. Finally, both .hyper() and -# .race() are implemented here, and return a HyperSeq wrapping the iterator. +# .race() are methods to enter the hyper and race paradigm and implemented +# here, so they can use any Iterable as a source. my class HyperSeq { ... } +my class RaceSeq { ... } +my role Rakudo::Internals::HyperIteratorBatcher { ... } my class X::Invalid::Value { ... } my role Iterable { method iterator() { ... } @@ -118,13 +121,21 @@ my role Iterable { } method hyper(Int(Cool) :$batch = 64, Int(Cool) :$degree = 4) { - self!valid-hyper-race('hyper',$batch,$degree); - die "NYI" + self!valid-hyper-race('hyper', $batch, $degree); + HyperSeq.new: + configuration => HyperConfiguration.new(:$degree, :$batch), + work-stage-head => Rakudo::Internals::HyperIteratorBatcher.new( + iterator => self.iterator + ) } method race(Int(Cool) :$batch = 64, Int(Cool) :$degree = 4) { - self!valid-hyper-race('race',$batch,$degree); - die "NYI" + self!valid-hyper-race('race', $batch, $degree); + RaceSeq.new: + configuration => HyperConfiguration.new(:$degree, :$batch), + work-stage-head => Rakudo::Internals::HyperIteratorBatcher.new( + iterator => self.iterator + ) } sub MIXIFY(\iterable, \type) { diff --git a/src/core/RaceSeq.pm b/src/core/RaceSeq.pm new file mode 100644 index 00000000000..c20041a94d0 --- /dev/null +++ b/src/core/RaceSeq.pm @@ -0,0 +1,30 @@ +# A RaceSeq performs batches of work in parallel, and will deliver the results +# in the order they are produced (so potentially disordering them relative to +# the input). +my class RaceSeq does Iterable { + has HyperConfiguration $.configuration; + has Rakudo::Internals::HyperWorkStage $!work-stage-head; + + submethod BUILD(:$!configuration!, :$!work-stage-head!) {} + + method iterator(RaceSeq:D: --> Iterator) { + my $joiner := Rakudo::Internals::RaceToIterator.new: + source => $!work-stage-head; + Rakudo::Internals::HyperPipeline.start($joiner, $!configuration); + $joiner + } + + method grep(RaceSeq:D: $matcher, *%options) { + Rakudo::Internals::HyperRaceSharedImpl.grep: + self, $!work-stage-head, $matcher, %options + } + + method map(RaceSeq:D: $matcher, *%options) { + Rakudo::Internals::HyperRaceSharedImpl.map: + self, $!work-stage-head, $matcher, %options + } + + method race(RaceSeq:D:) { self } +} + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Rakudo/Internals/HyperRaceSharedImpl.pm b/src/core/Rakudo/Internals/HyperRaceSharedImpl.pm new file mode 100644 index 00000000000..f9932228989 --- /dev/null +++ b/src/core/Rakudo/Internals/HyperRaceSharedImpl.pm @@ -0,0 +1,72 @@ +# Implementations shared between HyperSeq and RaceSeq. +class Rakudo::Internals::HyperRaceSharedImpl { + my class Grep does Rakudo::Internals::HyperProcessor { + has $!matcher; + + submethod TWEAK(:$!matcher) {} + + method process-batch(Rakudo::Internals::HyperWorkBatch $batch) { + my $result := IterationBuffer.new; + my $items := $batch.items; + my int $n = $items.elems; + loop (my int $i = 0; $i < $n; $i++) { + my \item := nqp::atpos($items, $i); + $result.push(item) if $!matcher.ACCEPTS(item); + } + $batch.replace-with($result); + } + } + multi method grep(\hyper, $source, \matcher, %options) { + if %options || nqp::istype(matcher, Code) && matcher.count > 1 { + # Fall back to sequential grep for cases we can't yet handle + self.rehyper(hyper, hyper.Any::grep(matcher, |%options)) + } + else { + hyper.bless: + configuration => hyper.configuration, + work-stage-head => Grep.new(:$source, :matcher(matcher)) + } + } + + my class Map does Rakudo::Internals::HyperProcessor { + has &!mapper; + + submethod TWEAK(:&!mapper) {} + + method process-batch(Rakudo::Internals::HyperWorkBatch $batch) { + my $result := IterationBuffer.new; + my $items := $batch.items; + my int $n = $items.elems; + loop (my int $i = 0; $i < $n; $i++) { + my \mapped = &!mapper(nqp::atpos($items, $i)); + nqp::istype(mapped, Slip) && !nqp::iscont(mapped) + ?? mapped.iterator.push-all($result) + !! $result.push(mapped) + } + $batch.replace-with($result); + } + } + multi method map(\hyper, $source, &mapper, %options) { + if %options || &mapper.count > 1 { + # Fall back to sequential map for cases we can't yet handle + self.rehyper(hyper, hyper.Any::map(&mapper, |%options)) + } + else { + hyper.bless: + configuration => hyper.configuration, + work-stage-head => Map.new(:$source, :&mapper) + } + } + + proto method rehyper($, $) {*} + multi method rehyper(HyperSeq \hyper, \seq) { + my \conf = hyper.configuration; + seq.hyper(:degree(conf.degree), :batch(conf.batch)) + } + multi method rehyper(RaceSeq \hyper, \seq) { + my \conf = hyper.configuration; + seq.race(:degree(conf.degree), :batch(conf.batch)) + } +} + +# vim: ft=perl6 expandtab sw=4 diff --git a/tools/build/jvm_core_sources b/tools/build/jvm_core_sources index 79a76dc6fd3..6bdb4c1b5c1 100644 --- a/tools/build/jvm_core_sources +++ b/tools/build/jvm_core_sources @@ -16,6 +16,7 @@ src/core/Rakudo/Internals.pm src/core/Rakudo/Iterator.pm src/core/Rakudo/QuantHash.pm src/core/Rakudo/Sorting.pm +src/core/HyperConfiguration.pm src/core/Iterable.pm src/core/Any-iterable-methods.pm src/core/SLICE.pm @@ -53,7 +54,6 @@ src/core/Encoding/Registry.pm src/core/Str.pm src/core/Capture.pm src/core/IterationBuffer.pm -src/core/HyperConfiguration.pm src/core/Sequence.pm src/core/Seq.pm src/core/Rakudo/Internals/HyperWorkBatch.pm @@ -62,7 +62,9 @@ src/core/Rakudo/Internals/HyperPipeline.pm src/core/Rakudo/Internals/HyperIteratorBatcher.pm src/core/Rakudo/Internals/HyperToIterator.pm src/core/Rakudo/Internals/RaceToIterator.pm +src/core/Rakudo/Internals/HyperRaceSharedImpl.pm src/core/HyperSeq.pm +src/core/RaceSeq.pm src/core/Nil.pm src/core/Range.pm src/core/List.pm diff --git a/tools/build/moar_core_sources b/tools/build/moar_core_sources index 6560f4f1782..2658253189e 100644 --- a/tools/build/moar_core_sources +++ b/tools/build/moar_core_sources @@ -16,6 +16,7 @@ src/core/Rakudo/Internals.pm src/core/Rakudo/Iterator.pm src/core/Rakudo/QuantHash.pm src/core/Rakudo/Sorting.pm +src/core/HyperConfiguration.pm src/core/Iterable.pm src/core/Any-iterable-methods.pm src/core/SLICE.pm @@ -55,7 +56,6 @@ src/core/Encoding/Registry.pm src/core/Str.pm src/core/Capture.pm src/core/IterationBuffer.pm -src/core/HyperConfiguration.pm src/core/Sequence.pm src/core/Seq.pm src/core/Rakudo/Internals/HyperWorkBatch.pm @@ -64,7 +64,9 @@ src/core/Rakudo/Internals/HyperPipeline.pm src/core/Rakudo/Internals/HyperIteratorBatcher.pm src/core/Rakudo/Internals/HyperToIterator.pm src/core/Rakudo/Internals/RaceToIterator.pm +src/core/Rakudo/Internals/HyperRaceSharedImpl.pm src/core/HyperSeq.pm +src/core/RaceSeq.pm src/core/Nil.pm src/core/Range.pm src/core/List.pm From f7ef1fc9f1be12087b34a32603f70669bef25334 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Tue, 17 Oct 2017 12:10:57 +0200 Subject: [PATCH 483/692] Remove leftover debug code --- src/core/Rakudo/Internals/HyperToIterator.pm | 1 - src/core/Rakudo/Internals/RaceToIterator.pm | 1 - 2 files changed, 2 deletions(-) diff --git a/src/core/Rakudo/Internals/HyperToIterator.pm b/src/core/Rakudo/Internals/HyperToIterator.pm index 9a38721898d..5fec094349f 100644 --- a/src/core/Rakudo/Internals/HyperToIterator.pm +++ b/src/core/Rakudo/Internals/HyperToIterator.pm @@ -32,7 +32,6 @@ my class Rakudo::Internals::HyperToIterator does Rakudo::Internals::HyperJoiner } method consume-error(Exception $e --> Nil) { - note $e; $!batches.fail($e); } diff --git a/src/core/Rakudo/Internals/RaceToIterator.pm b/src/core/Rakudo/Internals/RaceToIterator.pm index 740d6562e5d..2f15b2a2669 100644 --- a/src/core/Rakudo/Internals/RaceToIterator.pm +++ b/src/core/Rakudo/Internals/RaceToIterator.pm @@ -15,7 +15,6 @@ my class Rakudo::Internals::RaceToIterator does Rakudo::Internals::HyperJoiner d } method consume-error(Exception $e --> Nil) { - note $e; $!batches.fail($e); } From cef4806ff66180148a45cec04b6e53397a890f18 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Tue, 17 Oct 2017 12:11:21 +0200 Subject: [PATCH 484/692] Implement sink on HyperSeq and RaceSeq --- src/core/HyperSeq.pm | 4 +++ src/core/RaceSeq.pm | 4 +++ .../Rakudo/Internals/HyperRaceSharedImpl.pm | 27 +++++++++++++++++++ 3 files changed, 35 insertions(+) diff --git a/src/core/HyperSeq.pm b/src/core/HyperSeq.pm index 094d0f1f631..7f31fa95151 100644 --- a/src/core/HyperSeq.pm +++ b/src/core/HyperSeq.pm @@ -24,6 +24,10 @@ my class HyperSeq does Iterable does Sequence { } method hyper(HyperSeq:D:) { self } + + method sink(--> Nil) { + Rakudo::Internals::HyperRaceSharedImpl.sink(self, $!work-stage-head) + } } # vim: ft=perl6 expandtab sw=4 diff --git a/src/core/RaceSeq.pm b/src/core/RaceSeq.pm index c20041a94d0..7d5cacb6f5d 100644 --- a/src/core/RaceSeq.pm +++ b/src/core/RaceSeq.pm @@ -25,6 +25,10 @@ my class RaceSeq does Iterable { } method race(RaceSeq:D:) { self } + + method sink(--> Nil) { + Rakudo::Internals::HyperRaceSharedImpl.sink(self, $!work-stage-head) + } } # vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Rakudo/Internals/HyperRaceSharedImpl.pm b/src/core/Rakudo/Internals/HyperRaceSharedImpl.pm index f9932228989..2cadbc506ae 100644 --- a/src/core/Rakudo/Internals/HyperRaceSharedImpl.pm +++ b/src/core/Rakudo/Internals/HyperRaceSharedImpl.pm @@ -58,6 +58,33 @@ class Rakudo::Internals::HyperRaceSharedImpl { } } + my class Sink does Rakudo::Internals::HyperJoiner { + has Promise $.complete .= new; + + has int $!last-target = -1; + has int $!batches-seen = 0; + method consume-batch(Rakudo::Internals::HyperWorkBatch $batch --> Nil) { + $!batches-seen++; + if $batch.last { + $!last-target = $batch.sequence-number; + } + if $!last-target >= 0 && $!batches-seen == $!last-target + 1 { + $!complete.keep(True); + } + } + + method consume-error(Exception $e --> Nil) { + $!complete.break($e); + } + } + method sink(\hyper, $source --> Nil) { + if hyper.DEFINITE { + my $sink = Sink.new($source); + Rakudo::Internals::HyperPipeline.start($sink, hyper.configuration); + $*AWAITER.await($sink.complete); + } + } + proto method rehyper($, $) {*} multi method rehyper(HyperSeq \hyper, \seq) { my \conf = hyper.configuration; From ea51d19bbd79ad6fe8675aeaf36b7f55e97b0ffb Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Tue, 17 Oct 2017 12:22:05 +0200 Subject: [PATCH 485/692] Add forgotten `does Sequence` on RaceSeq --- src/core/RaceSeq.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/RaceSeq.pm b/src/core/RaceSeq.pm index 7d5cacb6f5d..ad674f5e9ef 100644 --- a/src/core/RaceSeq.pm +++ b/src/core/RaceSeq.pm @@ -1,7 +1,7 @@ # A RaceSeq performs batches of work in parallel, and will deliver the results # in the order they are produced (so potentially disordering them relative to # the input). -my class RaceSeq does Iterable { +my class RaceSeq does Iterable does Sequence { has HyperConfiguration $.configuration; has Rakudo::Internals::HyperWorkStage $!work-stage-head; From 374ee3e2641b58c776f044147d823dbcf3dfc4be Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Tue, 17 Oct 2017 12:48:28 +0200 Subject: [PATCH 486/692] Run hyper/race stress tests --- t/spectest.data | 1 + 1 file changed, 1 insertion(+) diff --git a/t/spectest.data b/t/spectest.data index 6d9fd792c1b..7ef9eea9a25 100644 --- a/t/spectest.data +++ b/t/spectest.data @@ -544,6 +544,7 @@ S07-slip/slip.t S07-iterators/range-iterator.t S07-hyperrace/hyper.t S07-hyperrace/race.t +S07-hyperrace/stress.t # stress S06-traits/slurpy-is-rw.t S09-autovivification/autoincrement.t S09-autovivification/autovivification.t From 8a88d14905248526415b674e2944eae5e476ff4e Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Tue, 17 Oct 2017 13:31:02 +0200 Subject: [PATCH 487/692] Streamline set operators handling of Any,Any - this fixes RT #131300 - basically add Any,Failure:D and Failure:D,Any candidate for each op - because coercions *can* fail - replacy Any,Any candidate with one that simply coerces the correct way - remove some Any,QuantHash / QuantHash,Any candidates - to prevent MMD lookup ambiguities --- src/core/set_addition.pm | 12 +++++------- src/core/set_difference.pm | 11 +++++++---- src/core/set_elem.pm | 7 ++++--- src/core/set_intersection.pm | 15 ++++----------- src/core/set_multiply.pm | 9 ++++++--- src/core/set_precedes.pm | 14 +++++++++----- src/core/set_proper_subset.pm | 14 +++++--------- src/core/set_subset.pm | 8 +++++--- src/core/set_symmetric_difference.pm | 21 ++++++++++++++------- src/core/set_union.pm | 20 +++++++++++++------- 10 files changed, 72 insertions(+), 59 deletions(-) diff --git a/src/core/set_addition.pm b/src/core/set_addition.pm index d597fe781c2..3bf3f174b81 100644 --- a/src/core/set_addition.pm +++ b/src/core/set_addition.pm @@ -125,15 +125,13 @@ multi sub infix:<(+)>(Iterable:D $a, Iterable:D $b) { ) } +multi sub infix:<(+)>(Any $, Failure:D $b) { $b.throw } +multi sub infix:<(+)>(Failure:D $a, Any $) { $a.throw } multi sub infix:<(+)>(Any $a, Any $b) { nqp::if( - nqp::istype($a,Baggy:D), - infix:<(+)>($a, $b.Bag), - nqp::if( - nqp::istype($b,Baggy:D), - infix:<(+)>($a.Bag, $b), - infix:<(+)>($a.Bag, $b.Bag) - ) + nqp::istype($a,Mixy) || nqp::istype($b,Mixy), + infix:<(+)>($a.Mix, $b.Mix), + infix:<(+)>($a.Bag, $b.Bag) ) } diff --git a/src/core/set_difference.pm b/src/core/set_difference.pm index 76ed6dd8c1a..73213b168ad 100644 --- a/src/core/set_difference.pm +++ b/src/core/set_difference.pm @@ -86,12 +86,15 @@ multi sub infix:<(-)>(Baggy:D $a, Map:D $b) { multi sub infix:<(-)>(Baggy:D $a, Any:D $b) { # also Iterable Rakudo::QuantHash.DIFFERENCE-BAGGY-QUANTHASH($a, $b.Set) } -multi sub infix:<(-)>(Any:D $a, Baggy:D $b) { +multi sub infix:<(-)>(Any $a, Baggy:D $b) { Rakudo::QuantHash.DIFFERENCE-BAGGY-QUANTHASH($a.Bag, $b) } -multi sub infix:<(-)>(Any:D $a, Map:D $b) { infix:<(-)>($a.Set, $b) } -multi sub infix:<(-)>(Any:D $a, Iterable:D $b) { infix:<(-)>($a.Set, $b) } -multi sub infix:<(-)>(Any:D $a, Any:D $b) { infix:<(-)>($a.Set, $b.Set) } +multi sub infix:<(-)>(Any $a, Map:D $b) { infix:<(-)>($a.Set, $b) } +multi sub infix:<(-)>(Any $a, Iterable:D $b) { infix:<(-)>($a.Set, $b) } + +multi sub infix:<(-)>(Any $, Failure:D $b) { $b.throw } +multi sub infix:<(-)>(Failure:D $a, Any $) { $a.throw } +multi sub infix:<(-)>(Any $a, Any $b) { infix:<(-)>($a.Set,$b.Set) } multi sub infix:<(-)>(**@p) { diff --git a/src/core/set_elem.pm b/src/core/set_elem.pm index 8f99f53de95..ba908f72e2d 100644 --- a/src/core/set_elem.pm +++ b/src/core/set_elem.pm @@ -64,9 +64,10 @@ multi sub infix:<(elem)>(Any $a, QuantHash:D $b --> Bool:D) { (my $elems := $b.RAW-HASH) && nqp::existskey($elems,$a.WHICH) ) } -multi sub infix:<(elem)>(Any $a, Any $b --> Bool:D) { - $a (elem) $b.Set(:view); -} + +multi sub infix:<(elem)>(Any $, Failure:D $b) { $b.throw } +multi sub infix:<(elem)>(Failure:D $a, Any $) { $a.throw } +multi sub infix:<(elem)>(Any $a, Any $b) { infix:<(elem)>($a,$b.Set) } # U+2208 ELEMENT OF my constant &infix:<∈> := &infix:<(elem)>; diff --git a/src/core/set_intersection.pm b/src/core/set_intersection.pm index d95d8a30967..6391f74f39d 100644 --- a/src/core/set_intersection.pm +++ b/src/core/set_intersection.pm @@ -124,17 +124,10 @@ multi sub infix:<(&)>(Map:D $a, Map:D $b) { ) } -multi sub infix:<(&)>(Any:D $a, Any:D $b) { - nqp::if( - nqp::istype((my $aset := $a.Set),Set), - nqp::if( - nqp::istype((my $bset := $b.Set),Set), - infix:<(&)>($aset, $bset), - $bset.throw - ), - $aset.throw - ) -} +multi sub infix:<(&)>(Any $, Failure:D $b) { $b.throw } +multi sub infix:<(&)>(Failure:D $a, Any $) { $a.throw } +multi sub infix:<(&)>(Any $a, Any $b) { infix:<(&)>($a.Set,$b.Set) } + multi sub infix:<(&)>(**@p) { my $result = @p.shift; $result = $result (&) @p.shift while @p; diff --git a/src/core/set_multiply.pm b/src/core/set_multiply.pm index 8b0ec16b973..389695439c1 100644 --- a/src/core/set_multiply.pm +++ b/src/core/set_multiply.pm @@ -32,9 +32,9 @@ multi sub infix:<(.)>(Mixy:D $a, Mixy:D $b) { } multi sub infix:<(.)>(Mixy:D $a, Baggy:D $b) { infix:<(.)>($a, $b.Mix) } -multi sub infix:<(.)>(Mixy:D $a, Any:D $b) { infix:<(.)>($a, $b.Mix) } +multi sub infix:<(.)>(Mixy:D $a, Any $b) { infix:<(.)>($a, $b.Mix) } multi sub infix:<(.)>(Baggy:D $a, Mixy:D $b) { infix:<(.)>($a.Mix, $b) } -multi sub infix:<(.)>(Any:D $a, Mixy:D $b) { infix:<(.)>($a.Mix, $b) } +multi sub infix:<(.)>(Any $a, Mixy:D $b) { infix:<(.)>($a.Mix, $b) } multi sub infix:<(.)>(Baggy:D $a, Baggy:D $b) { nqp::if( (my $elems := Rakudo::QuantHash.BAGGY-CLONE-RAW($a.RAW-HASH)) @@ -45,7 +45,10 @@ multi sub infix:<(.)>(Baggy:D $a, Baggy:D $b) { bag() ) } -multi sub infix:<(.)>(Any:D $a, Any:D $b) { $a.Bag (.) $b.Bag } + +multi sub infix:<(.)>(Any $, Failure:D $b) { $b.throw } +multi sub infix:<(.)>(Failure:D $a, Any $) { $a.throw } +multi sub infix:<(.)>(Any $a, Any $b) { infix:<(.)>($a.Bag,$b.Bag) } multi sub infix:<(.)>(**@p) { my $result = @p.shift; diff --git a/src/core/set_precedes.pm b/src/core/set_precedes.pm index c3df6282a18..cbe28d452e2 100644 --- a/src/core/set_precedes.pm +++ b/src/core/set_precedes.pm @@ -95,13 +95,17 @@ multi sub infix:<<(<+)>>(QuantHash:D $a, QuantHash:D $b --> Bool:D ) { return False if $a.AT-KEY($_) > $b.AT-KEY($_) for $a.keys; True } + +multi sub infix:<<(<+)>>(Any $, Failure:D $b) { $b.throw } +multi sub infix:<<(<+)>>(Failure:D $a, Any $) { $a.throw } multi sub infix:<<(<+)>>(Any $a, Any $b --> Bool:D) { - if nqp::istype($a, Mixy) or nqp::istype($b, Mixy) { - $a.Mix(:view) (<+) $b.Mix(:view); - } else { - $a.Bag(:view) (<+) $b.Bag(:view); - } + nqp::if( + nqp::istype($a,Mixy) || nqp::istype($b,Mixy), + infix:<<(<+)>>($a.Mix, $b.Mix), + infix:<<(<+)>>($a.Bag, $b.Bag) + ) } + # U+227C PRECEDES OR EQUAL TO only sub infix:<≼>($a, $b --> Bool:D) is pure { my $*WHAT = "≼"; diff --git a/src/core/set_proper_subset.pm b/src/core/set_proper_subset.pm index d466aee3e33..c55e9ca12d6 100644 --- a/src/core/set_proper_subset.pm +++ b/src/core/set_proper_subset.pm @@ -104,16 +104,12 @@ multi sub infix:<<(<)>>(Baggy:D $a, Any $b --> Bool:D) { $a (<) $b.Bag } multi sub infix:<<(<)>>(Any $a, Mixy:D $b --> Bool:D) { $a.Mix (<) $b } multi sub infix:<<(<)>>(Any $a, Baggy:D $b --> Bool:D) { $a.Bag (<) $b } -multi sub infix:<<(<)>>(Any $a, Any $b --> Bool:D) { - nqp::if( - nqp::eqaddr(nqp::decont($a),nqp::decont($b)), - False, # X is never a true subset of itself - $a.Set (<) $b.Set - ) -} -multi sub infix:<<(<)>>(Failure $a, Any $b) { $a.throw } -multi sub infix:<<(<)>>(Any $a, Failure $b) { $b.throw } +multi sub infix:<<(<)>>(Failure:D $a, Any $b) { $a.throw } +multi sub infix:<<(<)>>(Any $a, Failure:D $b) { $b.throw } +multi sub infix:<<(<)>>(Any $a, Any $b --> Bool:D) { + infix:<<(<)>>($a.Set, $b.Set) +} # U+2282 SUBSET OF my constant &infix:<⊂> := &infix:<<(<)>>; diff --git a/src/core/set_subset.pm b/src/core/set_subset.pm index f608d73a8ab..2c36780d3f4 100644 --- a/src/core/set_subset.pm +++ b/src/core/set_subset.pm @@ -133,10 +133,12 @@ multi sub infix:<<(<=)>>(Map:D $a, Map:D $b --> Bool:D) { multi sub infix:<<(<=)>>(Any $a, Mixy:D $b --> Bool:D) { $a.Mix (<=) $b } multi sub infix:<<(<=)>>(Any $a, Baggy:D $b --> Bool:D) { $a.Bag (<=) $b } multi sub infix:<<(<=)>>(Any $a, Setty:D $b --> Bool:D) { $a.Set (<=) $b } -multi sub infix:<<(<=)>>(Any $a, Any $b --> Bool:D) { $a.Set (<=) $b.Set } -multi sub infix:<<(<=)>>(Failure $a, Any $b) { $a.throw } -multi sub infix:<<(<=)>>(Any $a, Failure $b) { $b.throw } +multi sub infix:<<(<=)>>(Failure:D $a, Any $b) { $a.throw } +multi sub infix:<<(<=)>>(Any $a, Failure:D $b) { $b.throw } +multi sub infix:<<(<=)>>(Any $a, Any $b --> Bool:D) { + infix:<<(<=)>>($a.Set, $b.Set) +} # U+2286 SUBSET OF OR EQUAL TO my constant &infix:<⊆> := &infix:<<(<=)>>; diff --git a/src/core/set_symmetric_difference.pm b/src/core/set_symmetric_difference.pm index bc056fa2107..48a00cb3690 100644 --- a/src/core/set_symmetric_difference.pm +++ b/src/core/set_symmetric_difference.pm @@ -44,7 +44,6 @@ multi sub infix:<(^)>(Setty:D $a, Setty:D $b) { } multi sub infix:<(^)>(Setty:D $a, Mixy:D $b) { $a.Mix (^) $b } multi sub infix:<(^)>(Setty:D $a, Baggy:D $b) { $a.Bag (^) $b } -multi sub infix:<(^)>(Setty:D $a, Any $b) { $a (^) $b.Set } multi sub infix:<(^)>(Mixy:D $a, Mixy:D $b) { nqp::if( @@ -108,7 +107,6 @@ multi sub infix:<(^)>(Mixy:D $a, Mixy:D $b) { } multi sub infix:<(^)>(Mixy:D $a, Baggy:D $b) { $a (^) $b.Mix } multi sub infix:<(^)>(Mixy:D $a, Setty:D $b) { $a (^) $b.Mix } -multi sub infix:<(^)>(Mixy:D $a, Any $b) { $a (^) $b.Mix } multi sub infix:<(^)>(Baggy:D $a, Mixy:D $b) { $a.Mix (^) $b } multi sub infix:<(^)>(Baggy:D $a, Baggy:D $b) { @@ -164,7 +162,6 @@ multi sub infix:<(^)>(Baggy:D $a, Baggy:D $b) { ) } multi sub infix:<(^)>(Baggy:D $a, Setty:D $b) { $a (^) $b.Bag } -multi sub infix:<(^)>(Baggy:D $a, Any $b) { $a (^) $b.Bag } multi sub infix:<(^)>(Map:D $a, Map:D $b) { nqp::if( @@ -212,10 +209,20 @@ multi sub infix:<(^)>(Map:D $a, Map:D $b) { $b.Set # nothing left, coerce right ) } -multi sub infix:<(^)>(Any $a, Setty:D $b) { $a.Set (^) $b } -multi sub infix:<(^)>(Any $a, Mixy:D $b) { $a.Mix (^) $b } -multi sub infix:<(^)>(Any $a, Baggy:D $b) { $a.Bag (^) $b } -multi sub infix:<(^)>(Any $a, Any $b) { $a.Set (^) $b.Set } + +multi sub infix:<(^)>(Failure:D $a, Any $b) { $a.throw } +multi sub infix:<(^)>(Any $a, Failure:D $b) { $b.throw } +multi sub infix:<(^)>(Any $a, Any $b) { + nqp::if( + nqp::istype($a,Mixy) || nqp::istype($b,Mixy), + infix:<(^)>($a.Mix, $b.Mix), + nqp::if( + nqp::istype($a,Baggy) || nqp::istype($b,Baggy), + infix:<(^)>($a.Bag, $b.Bag), + infix:<(^)>($a.Set, $b.Set) + ) + ) +} multi sub infix:<(^)>(**@p) is pure { diff --git a/src/core/set_union.pm b/src/core/set_union.pm index 6984587c24e..1cc4fe5c9d7 100644 --- a/src/core/set_union.pm +++ b/src/core/set_union.pm @@ -39,7 +39,6 @@ multi sub infix:<(|)>(Setty:D $a, Setty:D $b) { } multi sub infix:<(|)>(Setty:D $a, Mixy:D $b) { $a.Mix (|) $b } multi sub infix:<(|)>(Setty:D $a, Baggy:D $b) { $a.Bag (|) $b } -multi sub infix:<(|)>(Setty:D $a, Any $b) { $a (|) $b.Set } multi sub infix:<(|)>(Mixy:D $a, Mixy:D $b) { nqp::if( @@ -80,7 +79,6 @@ multi sub infix:<(|)>(Mixy:D $a, Mixy:D $b) { multi sub infix:<(|)>(Mixy:D $a, Baggy:D $b) { $a (|) $b.Mix } multi sub infix:<(|)>(Mixy:D $a, Setty:D $b) { $a (|) $b.Mix } -multi sub infix:<(|)>(Mixy:D $a, Any $b) { $a (|) $b.Mix } multi sub infix:<(|)>(Baggy:D $a, Mixy:D $b) { $a.Mix (|) $b } multi sub infix:<(|)>(Baggy:D $a, Baggy:D $b) { @@ -122,7 +120,6 @@ multi sub infix:<(|)>(Baggy:D $a, Baggy:D $b) { ) } multi sub infix:<(|)>(Baggy:D $a, Setty:D $b) { $a (|) $b.Bag } -multi sub infix:<(|)>(Baggy:D $a, Any $b) { $a (|) $b.Bag } multi sub infix:<(|)>(Map:D $a, Map:D $b) { nqp::create(Set).SET-SELF( @@ -150,10 +147,19 @@ multi sub infix:<(|)>(Iterable:D $a, Iterable:D $b) { ) } -multi sub infix:<(|)>(Any $a, Setty:D $b) { $a.Set (|) $b } -multi sub infix:<(|)>(Any $a, Mixy:D $b) { $a.Mix (|) $b } -multi sub infix:<(|)>(Any $a, Baggy:D $b) { $a.Bag (|) $b } -multi sub infix:<(|)>(Any $a, Any $b) { $a.Set (|) $b.Set } +multi sub infix:<(|)>(Failure:D $a, Any $b) { $a.throw } +multi sub infix:<(|)>(Any $a, Failure:D $b) { $b.throw } +multi sub infix:<(|)>(Any $a, Any $b) { + nqp::if( + nqp::istype($a,Mixy) || nqp::istype($b,Mixy), + infix:<(|)>($a.Mix, $b.Mix), + nqp::if( + nqp::istype($a,Baggy) || nqp::istype($b,Baggy), + infix:<(|)>($a.Bag, $b.Bag), + infix:<(|)>($a.Set, $b.Set) + ) + ) +} multi sub infix:<(|)>(**@p) { my $result = @p.shift; From ae9de582465e67abb923fe80f92fea215202173b Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Tue, 17 Oct 2017 14:49:46 +0200 Subject: [PATCH 488/692] Remove some debugging leftovers --- src/core/Rakudo/Internals/HyperPipeline.pm | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/core/Rakudo/Internals/HyperPipeline.pm b/src/core/Rakudo/Internals/HyperPipeline.pm index d8a3dca59d2..f4732f2a431 100644 --- a/src/core/Rakudo/Internals/HyperPipeline.pm +++ b/src/core/Rakudo/Internals/HyperPipeline.pm @@ -54,7 +54,6 @@ my class Rakudo::Internals::HyperPipeline { last if $batch.last; CATCH { default { - .note; $dest-channel.fail($_); } } @@ -79,7 +78,6 @@ my class Rakudo::Internals::HyperPipeline { $dest-channel.close; } default { - .note; $dest-channel.fail($_); } } From 82a38c291b96f677bafd0cb24c2d1ba4b648e878 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Tue, 17 Oct 2017 15:00:57 +0200 Subject: [PATCH 489/692] Don't lose original location of a Channel error --- src/core/Channel.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/Channel.pm b/src/core/Channel.pm index 4df9cb6ec9f..f5c5f78feb4 100644 --- a/src/core/Channel.pm +++ b/src/core/Channel.pm @@ -58,7 +58,7 @@ my class Channel does Awaitable { elsif nqp::istype(msg, CHANNEL_FAIL) { nqp::push($!queue, msg); # make sure other readers see it $!closed_promise_vow.break(msg.error); - die msg.error; + msg.error.rethrow; } else { msg From ad0dd8e7d5d951128c7d7150bc716aa70cec0fbd Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Tue, 17 Oct 2017 15:15:29 +0200 Subject: [PATCH 490/692] Improve hyper/race errors Include the location where the hyper/race operation was initiated as well as the location where the error occurred in the worker, with an explanation. --- .../Rakudo/Internals/HyperRaceSharedImpl.pm | 5 +++++ src/core/Rakudo/Internals/HyperToIterator.pm | 17 ++++++++++++++++- src/core/Rakudo/Internals/RaceToIterator.pm | 6 +++++- 3 files changed, 26 insertions(+), 2 deletions(-) diff --git a/src/core/Rakudo/Internals/HyperRaceSharedImpl.pm b/src/core/Rakudo/Internals/HyperRaceSharedImpl.pm index 2cadbc506ae..e815d49af6b 100644 --- a/src/core/Rakudo/Internals/HyperRaceSharedImpl.pm +++ b/src/core/Rakudo/Internals/HyperRaceSharedImpl.pm @@ -82,6 +82,11 @@ class Rakudo::Internals::HyperRaceSharedImpl { my $sink = Sink.new($source); Rakudo::Internals::HyperPipeline.start($sink, hyper.configuration); $*AWAITER.await($sink.complete); + CATCH { + unless nqp::istype($_, X::HyperRace::Died) { + ($_ but X::HyperRace::Died(Backtrace.new(5))).rethrow + } + } } } diff --git a/src/core/Rakudo/Internals/HyperToIterator.pm b/src/core/Rakudo/Internals/HyperToIterator.pm index 5fec094349f..bbb2988c357 100644 --- a/src/core/Rakudo/Internals/HyperToIterator.pm +++ b/src/core/Rakudo/Internals/HyperToIterator.pm @@ -1,3 +1,14 @@ +my class Backtrace { ... } +my role X::HyperRace::Died { + has $.start-backtrace; + multi method gist(::?CLASS:D:) { + "A worker in a parallel iteration (hyper or race) initiated here:\n" ~ + ((try $!start-backtrace ~ "\n") // '') ~ + "Died at:\n" ~ + callsame().indent(4) + } +} + my class Rakudo::Internals::HyperToIterator does Rakudo::Internals::HyperJoiner does Iterator { has Channel $.batches .= new; @@ -46,7 +57,11 @@ my class Rakudo::Internals::HyperToIterator does Rakudo::Internals::HyperJoiner when X::Channel::ReceiveOnClosed { return IterationEnd; } - # Throw other errors onwards + default { + unless nqp::istype($_, X::HyperRace::Died) { + ($_ but X::HyperRace::Died(Backtrace.new(5))).rethrow + } + } } } nqp::shift(nqp::decont($!current-items)) diff --git a/src/core/Rakudo/Internals/RaceToIterator.pm b/src/core/Rakudo/Internals/RaceToIterator.pm index 2f15b2a2669..09db1efc7a6 100644 --- a/src/core/Rakudo/Internals/RaceToIterator.pm +++ b/src/core/Rakudo/Internals/RaceToIterator.pm @@ -29,7 +29,11 @@ my class Rakudo::Internals::RaceToIterator does Rakudo::Internals::HyperJoiner d when X::Channel::ReceiveOnClosed { return IterationEnd; } - # Throw other errors onwards + default { + unless nqp::istype($_, X::HyperRace::Died) { + ($_ but X::HyperRace::Died(Backtrace.new(5))).rethrow + } + } } } nqp::shift(nqp::decont($!current-items)) From 41729e93ecc74331be6d8ecad120cfbfb9188c85 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Tue, 17 Oct 2017 17:19:24 +0200 Subject: [PATCH 491/692] Fix bugs in sink of HyperSeq/RaceSeq Remember to mark batches consumed, and construct the Sink correctly. --- src/core/Rakudo/Internals/HyperRaceSharedImpl.pm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/core/Rakudo/Internals/HyperRaceSharedImpl.pm b/src/core/Rakudo/Internals/HyperRaceSharedImpl.pm index e815d49af6b..177cf996337 100644 --- a/src/core/Rakudo/Internals/HyperRaceSharedImpl.pm +++ b/src/core/Rakudo/Internals/HyperRaceSharedImpl.pm @@ -65,6 +65,7 @@ class Rakudo::Internals::HyperRaceSharedImpl { has int $!batches-seen = 0; method consume-batch(Rakudo::Internals::HyperWorkBatch $batch --> Nil) { $!batches-seen++; + self.batch-used(); if $batch.last { $!last-target = $batch.sequence-number; } @@ -79,7 +80,7 @@ class Rakudo::Internals::HyperRaceSharedImpl { } method sink(\hyper, $source --> Nil) { if hyper.DEFINITE { - my $sink = Sink.new($source); + my $sink = Sink.new(:$source); Rakudo::Internals::HyperPipeline.start($sink, hyper.configuration); $*AWAITER.await($sink.complete); CATCH { From d74ba04135510186619bc44890a0b6e854c765dd Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Tue, 17 Oct 2017 17:46:53 +0200 Subject: [PATCH 492/692] More direct hyper -> race and vice versa No need to go via a sequential iterator and bottleneck the chain. --- src/core/HyperSeq.pm | 4 ++++ src/core/RaceSeq.pm | 4 ++++ 2 files changed, 8 insertions(+) diff --git a/src/core/HyperSeq.pm b/src/core/HyperSeq.pm index 7f31fa95151..bc65b598509 100644 --- a/src/core/HyperSeq.pm +++ b/src/core/HyperSeq.pm @@ -25,6 +25,10 @@ my class HyperSeq does Iterable does Sequence { method hyper(HyperSeq:D:) { self } + method race(HyperSeq:D:) { + RaceSeq.new(:$!configuration, :$!work-stage-head) + } + method sink(--> Nil) { Rakudo::Internals::HyperRaceSharedImpl.sink(self, $!work-stage-head) } diff --git a/src/core/RaceSeq.pm b/src/core/RaceSeq.pm index ad674f5e9ef..eceedf4cc8b 100644 --- a/src/core/RaceSeq.pm +++ b/src/core/RaceSeq.pm @@ -19,6 +19,10 @@ my class RaceSeq does Iterable does Sequence { self, $!work-stage-head, $matcher, %options } + method hyper(RaceSeq:D:) { + HyperSeq.new(:$!configuration, :$!work-stage-head) + } + method map(RaceSeq:D: $matcher, *%options) { Rakudo::Internals::HyperRaceSharedImpl.map: self, $!work-stage-head, $matcher, %options From 836761129c379a8505f0596374463a1482406843 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Tue, 17 Oct 2017 18:02:36 +0200 Subject: [PATCH 493/692] HyperSeq/RaceSeq are never lazy --- src/core/HyperSeq.pm | 2 ++ src/core/RaceSeq.pm | 2 ++ 2 files changed, 4 insertions(+) diff --git a/src/core/HyperSeq.pm b/src/core/HyperSeq.pm index bc65b598509..d9fdd50c988 100644 --- a/src/core/HyperSeq.pm +++ b/src/core/HyperSeq.pm @@ -25,6 +25,8 @@ my class HyperSeq does Iterable does Sequence { method hyper(HyperSeq:D:) { self } + method is-lazy() { False } + method race(HyperSeq:D:) { RaceSeq.new(:$!configuration, :$!work-stage-head) } diff --git a/src/core/RaceSeq.pm b/src/core/RaceSeq.pm index eceedf4cc8b..4e635953aa2 100644 --- a/src/core/RaceSeq.pm +++ b/src/core/RaceSeq.pm @@ -23,6 +23,8 @@ my class RaceSeq does Iterable does Sequence { HyperSeq.new(:$!configuration, :$!work-stage-head) } + method is-lazy() { False } + method map(RaceSeq:D: $matcher, *%options) { Rakudo::Internals::HyperRaceSharedImpl.map: self, $!work-stage-head, $matcher, %options From df01ad97e5066738b7d9c9097faaf6870e22f506 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Wed, 18 Oct 2017 00:31:01 +0000 Subject: [PATCH 494/692] Fix lockup when scheduling with degenerate delays - If delay is smaller than 0.001s (including negatives), translate that to zero - Do not warn about too-low timer resolutions if delay is zero, since zero delays have proper meaning - If interval is smaller than 0.001s (including negatives), translate that to 0.001s and warn Fixes hangs when Promise.at is given a time in the past or .in is given a negative value. --- src/core/ThreadPoolScheduler.pm | 34 +++++++++++++++------------------ 1 file changed, 15 insertions(+), 19 deletions(-) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index 57853dc9708..0dbf8ab43e5 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -590,7 +590,19 @@ my class ThreadPoolScheduler does Scheduler { if $at.defined and $in.defined; die "Cannot specify :every, :times and :stop at the same time" if $every.defined and $times > 1 and &stop; - my $delay = $at ?? $at - now !! $in // 0; + + # For $in/$at times, if the resultant delay is less than 0.001 (inlcuding + # negatives) equate those to zero. For $every intervals, we convert + # such values to minimum resolution of 0.001 and warn about that + sub to-millis(Numeric() $value, $allow-zero = False) { + my $proposed := (1000 * $value).Int; + $proposed > 0 ?? $proposed + !! $allow-zero ?? 0 + !! do {warn "Minimum timer resolution is 1ms; using that " + ~ "instead of {1000 * $value}ms"; + 1} + } + my $delay = to-millis ($at ?? $at - now !! $in // 0), True; # Wrap any catch handler around the code to run. my &run := &catch ?? wrap-catch(&code, &catch) !! &code; @@ -613,7 +625,7 @@ my class ThreadPoolScheduler does Scheduler { } $handle := nqp::timer(self!timer-queue(), { stop() ?? cancellation().cancel !! run() }, - to-millis($delay), to-millis($every), + $delay, to-millis($every), TimerCancellation); cancellation() } @@ -621,7 +633,7 @@ my class ThreadPoolScheduler does Scheduler { # no stopper else { my $handle := nqp::timer(self!timer-queue(), &run, - to-millis($delay), to-millis($every), + $delay, to-millis($every), TimerCancellation); Cancellation.new(async_handles => [$handle]) } @@ -630,7 +642,6 @@ my class ThreadPoolScheduler does Scheduler { # only after waiting a bit or more than once elsif $delay or $times > 1 { my @async_handles; - $delay = to-millis($delay) if $delay; @async_handles.push( nqp::timer(self!timer-queue(), &run, $delay, 0, TimerCancellation) ) for 1 .. $times; @@ -648,21 +659,6 @@ my class ThreadPoolScheduler does Scheduler { -> { code(); CATCH { default { catch($_) } } } } - multi to-millis(Int $value) { - 1000 * $value - } - multi to-millis(Numeric $value) { - my $proposed = (1000 * $value).Int; - if $value && $proposed == 0 { - warn "Minimum timer resolution is 1ms; using that instead of {1000 * $value}ms"; - $proposed = 1; - } - $proposed - } - multi to-millis($value) { - to-millis(+$value) - } - method loads() { [+] ($!general-queue ?? $!general-queue.elems !! 0), ($!timer-queue ?? $!timer-queue.elems !! 0), From 031f8cf77c22203792af89e268f020d543f52455 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Wed, 18 Oct 2017 01:00:26 +0000 Subject: [PATCH 495/692] Test Supply.interval with low values warns --- t/05-messages/10-warnings.t | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) create mode 100644 t/05-messages/10-warnings.t diff --git a/t/05-messages/10-warnings.t b/t/05-messages/10-warnings.t new file mode 100644 index 00000000000..69ac0647dd8 --- /dev/null +++ b/t/05-messages/10-warnings.t @@ -0,0 +1,17 @@ +use Test; + +plan 1; + +subtest 'Supply.interval with negative value warns' => { + plan 2; + CONTROL { when CX::Warn { + like .message, /'Minimum timer resolution is 1ms'/, 'useful warning'; + .resume; + }} + react whenever Supply.interval(-100) { + pass "intervaled code ran"; + done; + } +} + +# vim: ft=perl6 expandtab sw=4 From e4c32b3a0123a5b90fbaf8aa0ca7411d8a9061b1 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Tue, 17 Oct 2017 21:04:34 -0400 Subject: [PATCH 496/692] Fix typo in comment; MasterDuke++ --- src/core/ThreadPoolScheduler.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index 0dbf8ab43e5..b728631a0fb 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -591,7 +591,7 @@ my class ThreadPoolScheduler does Scheduler { die "Cannot specify :every, :times and :stop at the same time" if $every.defined and $times > 1 and &stop; - # For $in/$at times, if the resultant delay is less than 0.001 (inlcuding + # For $in/$at times, if the resultant delay is less than 0.001 (including # negatives) equate those to zero. For $every intervals, we convert # such values to minimum resolution of 0.001 and warn about that sub to-millis(Numeric() $value, $allow-zero = False) { From 4f5fc520daa5c62be03e09cbfe6a13e73f506c3f Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Wed, 18 Oct 2017 01:13:52 +0000 Subject: [PATCH 497/692] Bump NQP --- tools/build/NQP_REVISION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/build/NQP_REVISION b/tools/build/NQP_REVISION index 36554779f72..8e672f96b9f 100644 --- a/tools/build/NQP_REVISION +++ b/tools/build/NQP_REVISION @@ -1 +1 @@ -2017.09-84-ge9bca38 +2017.09-98-g81c890c From 4c3700729679461c1e68f1300e1170d723a9325d Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Tue, 17 Oct 2017 21:41:36 -0400 Subject: [PATCH 498/692] Test getlexdyn op does not segfault RT#132300: https://rt.perl.org/Public/Bug/Display.html?id=132300 --- t/02-rakudo/10-nqp-ops.t | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/t/02-rakudo/10-nqp-ops.t b/t/02-rakudo/10-nqp-ops.t index fb8864b85e2..92ba31e1782 100644 --- a/t/02-rakudo/10-nqp-ops.t +++ b/t/02-rakudo/10-nqp-ops.t @@ -1,10 +1,16 @@ +use lib ; use Test; +use Test::Helpers; use nqp; # Tests for nqp ops that don't fit into nqp's test suit -plan 1; +plan 2; # RT#132126 lives-ok { nqp::p6bindattrinvres(($ := 42), Int, q|$!value|, nqp::getattr(42, Int, q|$!value|)) }, 'p6bindattrinvres with getattr of bigint does not crash'; + +# RT #132300 +is-run 「use nqp; quietly print nqp::getlexdyn('&DEPRECATED'); print 'pass'」, + :out, 'getlexdyn op does not segfault'; From 2fba0ba0d58b271b3e9d53691a6c861c543bbe42 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Wed, 18 Oct 2017 13:53:08 +0000 Subject: [PATCH 499/692] Remove UInt type constaint on TypedPointer.add In our very own class we use negative Ints with it. Possibly fixes one of the issues with NativeHelpers::Blob --- lib/NativeCall/Types.pm6 | 2 +- t/04-nativecall/04-pointers.t | 14 ++++++++++---- 2 files changed, 11 insertions(+), 5 deletions(-) diff --git a/lib/NativeCall/Types.pm6 b/lib/NativeCall/Types.pm6 index 13bd2e61b46..3a6271809fe 100644 --- a/lib/NativeCall/Types.pm6 +++ b/lib/NativeCall/Types.pm6 @@ -56,7 +56,7 @@ our class Pointer is repr('CPointer') { my role TypedPointer[::TValue] { method of() { TValue } method deref(::?CLASS:D \ptr:) { self ?? nativecast(TValue, ptr) !! fail("Can't dereference a Null Pointer"); } - method add(UInt $off) returns Pointer { + method add(Int $off) returns Pointer { die "Can't do arithmetic with a void pointer" if TValue.isa(void); nqp::box_i(self.Int + nqp::nativecallsizeof(TValue) * $off, self.WHAT); diff --git a/t/04-nativecall/04-pointers.t b/t/04-nativecall/04-pointers.t index 6f49f8ba594..122c44fc976 100644 --- a/t/04-nativecall/04-pointers.t +++ b/t/04-nativecall/04-pointers.t @@ -1,12 +1,12 @@ use v6; -use lib ; +use lib ; use CompileTestLib; use NativeCall; use NativeCall::Types; use Test; -plan 17; +plan 22; compile_test_lib('04-pointers'); @@ -33,8 +33,14 @@ my $p = ReturnPointerToIntArray(); is $p.deref, 10, 'typed pointer deref method'; is $p[1], 20, 'typed pointer array dereference'; is (++$p).deref, 20, 'typed pointer increment'; -is $p[0], 20, 'typed pointer incremented'; -is $p[1], 30, 'typed pointer incremented'; +is ($p.add: -1).deref, 10, '.add(-1)'; +is $p[0], 20, 'typed pointer incremented (1)'; +is $p[1], 30, 'typed pointer incremented (2)'; +is (--$p).deref, 10, 'typed pointer decrement'; +is $p[0], 10, 'typed pointer incremented (1)'; +is $p[1], 20, 'typed pointer incremented (2)'; +is ($p.add: 2).deref, 30, '.add(2)'; + { eval-lives-ok q:to 'CODE', 'Signature matching with Pointer[int32] works (RT #124321)'; From ff063e7b53ab41b79279ffc38e1740d3db2eae7d Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Wed, 18 Oct 2017 20:58:59 +0000 Subject: [PATCH 500/692] Bump NQP --- tools/build/NQP_REVISION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/build/NQP_REVISION b/tools/build/NQP_REVISION index 8e672f96b9f..ae31831d10b 100644 --- a/tools/build/NQP_REVISION +++ b/tools/build/NQP_REVISION @@ -1 +1 @@ -2017.09-98-g81c890c +2017.09-99-g254d590 From f9c10c214550dd1e5a9b500cca7c63239f3f39b9 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Wed, 18 Oct 2017 18:26:31 -0400 Subject: [PATCH 501/692] Implement knob for tweaking handle output buffer - Rename[^1] "buffer" open arg to "out-buffer", as we'll be adding another knob for input buffer. The "buffer" will remain under deprecation warning for 3 releases (it was available for just 1 release) [1] https://irclog.perlgeek.de/perl6-dev/2017-10-15#i_15307167 --- src/core/IO/Handle.pm | 28 ++++++++++++++++++++++------ 1 file changed, 22 insertions(+), 6 deletions(-) diff --git a/src/core/IO/Handle.pm b/src/core/IO/Handle.pm index 7ae4b480f09..4116641ff1c 100644 --- a/src/core/IO/Handle.pm +++ b/src/core/IO/Handle.pm @@ -10,6 +10,7 @@ my class IO::Handle { has Str $.encoding; has Encoding::Decoder $!decoder; has Encoding::Encoder $!encoder; + has int $!out-buffer; submethod TWEAK (:$encoding, :$bin, IO() :$!path = Nil) { nqp::if( @@ -67,8 +68,16 @@ my class IO::Handle { :$chomp = $!chomp, :$nl-in is copy = $!nl-in, Str:D :$nl-out is copy = $!nl-out, - :$buffer + :$buffer, + :$out-buffer is copy, ) { + nqp::if( + $buffer.DEFINITE, + nqp::stmts( + ($out-buffer = $buffer), + DEPRECATED ':out-buffer argument to control handle buffering', + '2017.09.455.g.2.fba.0.ba.0.d', '2018.01')); + nqp::if( $bin, nqp::stmts( @@ -167,7 +176,7 @@ my class IO::Handle { $!encoder := $encoding.encoder(:translate-nl); $!encoding = $encoding.name; } - self!set-buffer-size($buffer); + self!set-out-buffer-size($out-buffer); return self; } @@ -214,16 +223,23 @@ my class IO::Handle { $!encoder := $encoding.encoder(:translate-nl); $!encoding = $encoding.name; } - self!set-buffer-size($buffer); + self!set-out-buffer-size($out-buffer); self; } - method !set-buffer-size($buffer is copy) { + method out-buffer is rw { + Proxy.new: :FETCH{ $!out-buffer }, STORE => -> $, \buffer { + self!set-out-buffer-size: buffer; + } + } + + method !set-out-buffer-size($buffer is copy) { $buffer //= !nqp::isttyfh($!PIO); - my int $buffer-size = nqp::istype($buffer, Bool) + $!out-buffer = nqp::istype($buffer, Bool) ?? ($buffer ?? 8192 !! 0) !! $buffer.Int; - nqp::setbuffersizefh($!PIO, $buffer-size); + nqp::setbuffersizefh($!PIO, $!out-buffer); + $!out-buffer } method nl-in is rw { From cf1673d9c20e82aad6291a8aa123c46e177edf34 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Thu, 19 Oct 2017 18:41:53 +0200 Subject: [PATCH 502/692] Clear up `for` and `hyper|race|lazy for` semantics A plain `for` loop will now always mean serial execution, to avoid surprises (for example, in `for some-module-code() { }` it is far preferable to know that the module code can't suddenly cause the `for` loop's body to run on different threads by changing its return type!) The `hyper for foo() { }` and `race for foo() { }` constructs will run the loop body in parallel under the `hyper` or `race` paradigm (these are identical in sink context). Finally, `lazy for @foo { }` is fixed to actually lazily execute the loop body when data is needed; this was broken before now. --- src/Perl6/Actions.nqp | 86 +++++++++++++++++++++++++++++++++---------- src/Perl6/Grammar.nqp | 24 ++++++++++-- src/core/Any.pm | 3 ++ src/core/HyperSeq.pm | 2 + src/core/RaceSeq.pm | 2 + 5 files changed, 94 insertions(+), 23 deletions(-) diff --git a/src/Perl6/Actions.nqp b/src/Perl6/Actions.nqp index c1822fad741..ef9469ffcd8 100644 --- a/src/Perl6/Actions.nqp +++ b/src/Perl6/Actions.nqp @@ -483,20 +483,42 @@ register_op_desugar('p6fatalize', -> $qast { )) }); register_op_desugar('p6for', -> $qast { + # Figure out the execution mode. + my $mode := $qast.ann('mode') || 'serial'; + my $after-mode; + if $mode eq 'lazy' { + $after-mode := 'lazy'; + $mode := 'serial'; + } + else { + $after-mode := $qast.sunk ?? 'sink' !! 'eager'; + } + my $cond := $qast[0]; my $block := $qast[1]; my $label := $qast[2]; my $for-list-name := QAST::Node.unique('for-list'); - my $iscont := QAST::Op.new(:op('iscont'), QAST::Var.new( :name($for-list-name), :scope('local') )); - $iscont.named('item'); my $call := QAST::Op.new( - :op, :name, :node($qast), - QAST::Var.new( :name($for-list-name), :scope('local') ), - $block, - $iscont, + :op('if'), + QAST::Op.new( :op('iscont'), QAST::Var.new( :name($for-list-name), :scope('local') ) ), + QAST::Op.new( + :op, :name, :node($qast), + QAST::Var.new( :name($for-list-name), :scope('local') ), + $block, + QAST::IVal.new( :value(1), :named('item') ) + ), + QAST::Op.new( + :op, :name, :node($qast), + QAST::Op.new( + :op, :name($mode), :node($qast), + QAST::Var.new( :name($for-list-name), :scope('local') ) + ), + $block + ) ); if $label { - $call.push($label); + $call[1].push($label); + $call[2].push($label); } my $bind := QAST::Op.new( :op('bind'), @@ -505,7 +527,7 @@ register_op_desugar('p6for', -> $qast { ); QAST::Stmts.new( $bind, - QAST::Op.new( :op, :name($qast.sunk ?? 'sink' !! 'eager'), $call ) + QAST::Op.new( :op, :name($after-mode), $call ) ); }); register_op_desugar('p6forstmt', -> $qast { @@ -2315,10 +2337,18 @@ class Perl6::Actions is HLL::Actions does STDActions { } method statement_prefix:sym($/) { - make QAST::Op.new( - :op('callmethod'), :name('lazy'), - QAST::Op.new( :op('call'), $.ast ) - ); + if $ { + my $ast := $.ast; + $ast[0].annotate('mode', 'lazy'); + $ast.annotate('statement_level', NQPMu); + make $ast; + } + else { + make QAST::Op.new( + :op('callmethod'), :name('lazy'), + QAST::Op.new( :op('call'), $.ast ) + ); + } } method statement_prefix:sym($/) { @@ -2329,17 +2359,33 @@ class Perl6::Actions is HLL::Actions does STDActions { } method statement_prefix:sym($/) { - make QAST::Op.new( - :op('callmethod'), :name('hyper'), - QAST::Op.new( :op('call'), $.ast ) - ); + if $ { + my $ast := $.ast; + $ast[0].annotate('mode', 'hyper'); + $ast.annotate('statement_level', NQPMu); + make $ast; + } + else { + make QAST::Op.new( + :op('callmethod'), :name('hyper'), + QAST::Op.new( :op('call'), $.ast ) + ); + } } method statement_prefix:sym($/) { - make QAST::Op.new( - :op('callmethod'), :name('race'), - QAST::Op.new( :op('call'), $.ast ) - ); + if $ { + my $ast := $.ast; + $ast[0].annotate('mode', 'race'); + $ast.annotate('statement_level', NQPMu); + make $ast; + } + else { + make QAST::Op.new( + :op('callmethod'), :name('race'), + QAST::Op.new( :op('call'), $.ast ) + ); + } } method statement_prefix:sym($/) { diff --git a/src/Perl6/Grammar.nqp b/src/Perl6/Grammar.nqp index e4c92f73084..c18cb0c1f17 100644 --- a/src/Perl6/Grammar.nqp +++ b/src/Perl6/Grammar.nqp @@ -1741,10 +1741,28 @@ grammar Perl6::Grammar is HLL::Grammar does STD { token statement_prefix:sym { <.kok> } token statement_prefix:sym { <.kok> } - token statement_prefix:sym { <.kok> } - token statement_prefix:sym { <.kok> } + token statement_prefix:sym { + <.kok> + [ + | > + | + ] + } + token statement_prefix:sym { + <.kok> + [ + | > + | + ] + } + token statement_prefix:sym { + <.kok> + [ + | > + | + ] + } token statement_prefix:sym { <.kok> } - token statement_prefix:sym { <.kok> } token statement_prefix:sym { <.kok> } token statement_prefix:sym { :my $*FATAL := 1; diff --git a/src/core/Any.pm b/src/core/Any.pm index a71ca8ec585..d8a9c42b0ba 100644 --- a/src/core/Any.pm +++ b/src/core/Any.pm @@ -59,6 +59,9 @@ my class Any { # declared in BOOTSTRAP proto method eager(|) is nodal { * } multi method eager() { self.list.eager } + proto method serial(|) is nodal { * } + multi method serial() { self } + # derived from .list proto method List(|) is nodal { * } multi method List() { self.list } diff --git a/src/core/HyperSeq.pm b/src/core/HyperSeq.pm index d9fdd50c988..ea61071f5c9 100644 --- a/src/core/HyperSeq.pm +++ b/src/core/HyperSeq.pm @@ -31,6 +31,8 @@ my class HyperSeq does Iterable does Sequence { RaceSeq.new(:$!configuration, :$!work-stage-head) } + multi method serial(HyperSeq:D:) { self.Seq } + method sink(--> Nil) { Rakudo::Internals::HyperRaceSharedImpl.sink(self, $!work-stage-head) } diff --git a/src/core/RaceSeq.pm b/src/core/RaceSeq.pm index 4e635953aa2..9b7293be5a4 100644 --- a/src/core/RaceSeq.pm +++ b/src/core/RaceSeq.pm @@ -32,6 +32,8 @@ my class RaceSeq does Iterable does Sequence { method race(RaceSeq:D:) { self } + multi method serial(HyperSeq:D:) { self.Seq } + method sink(--> Nil) { Rakudo::Internals::HyperRaceSharedImpl.sink(self, $!work-stage-head) } From f980cdafe4a2ef103d32e25a9276d972c3cd57aa Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Thu, 19 Oct 2017 21:26:37 +0200 Subject: [PATCH 503/692] Make creating a Promise a bit cheaper - is default is compile time, as opposed to BUILD init which is runtime --- src/core/Promise.pm | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/src/core/Promise.pm b/src/core/Promise.pm index 5ae4bd13562..ffb31e2a3e7 100644 --- a/src/core/Promise.pm +++ b/src/core/Promise.pm @@ -26,7 +26,7 @@ my role X::Promise::Broken { } my class Promise does Awaitable { has $.scheduler; - has $.status; + has $.status is default(Planned); has $!result is default(Nil); has int $!vow_taken; has $!lock; @@ -35,9 +35,8 @@ my class Promise does Awaitable { has Mu $!dynamic_context; submethod BUILD(:$!scheduler = $*SCHEDULER --> Nil) { - $!lock := nqp::create(Lock); - $!cond := $!lock.condition(); - $!status = Planned; + $!lock := nqp::create(Lock); + $!cond := $!lock.condition(); } # A Vow is used to enable the right to keep/break a promise From 270e7c8a72351c8aa4edfc8f52463bbf51bf09c6 Mon Sep 17 00:00:00 2001 From: Timo Paulssen Date: Thu, 19 Oct 2017 22:35:31 +0200 Subject: [PATCH 504/692] Promise.kept and .broken constructors for kept/broken promises can be super useful to have short-hand for sometimes. --- src/core/Promise.pm | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/src/core/Promise.pm b/src/core/Promise.pm index ffb31e2a3e7..11bb7c5744c 100644 --- a/src/core/Promise.pm +++ b/src/core/Promise.pm @@ -66,6 +66,18 @@ my class Promise does Awaitable { $vow } + proto method kept(|) { * } + multi method kept(Promise:U:) { + my \rv := self.new; + rv!keep(True); + rv; + } + multi method kept(Promise:U: Mu \result) { + my \rv := self.new; + rv!keep(result); + rv; + } + proto method keep(|) { * } multi method keep(Promise:D:) { self.vow.keep(True) @@ -83,6 +95,18 @@ my class Promise does Awaitable { }); } + proto method broken(|) { * } + multi method broken(Promise:U:) { + my \rv := self.new; + rv!break(False); + rv; + } + multi method broken(Promise:U: Mu \exception) { + my \rv := self.new; + rv!break(exception); + rv; + } + proto method break(|) { * } multi method break(Promise:D:) { self.vow.break(False) From ee3f0f4fb8bf09c14c4ef26c9b9dc648985b19de Mon Sep 17 00:00:00 2001 From: Timo Paulssen Date: Thu, 19 Oct 2017 23:00:04 +0200 Subject: [PATCH 505/692] "Died" shall be default for breaking promises to mirror what die without arguments does. --- src/core/Promise.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/Promise.pm b/src/core/Promise.pm index 11bb7c5744c..0147d97fb6f 100644 --- a/src/core/Promise.pm +++ b/src/core/Promise.pm @@ -98,7 +98,7 @@ my class Promise does Awaitable { proto method broken(|) { * } multi method broken(Promise:U:) { my \rv := self.new; - rv!break(False); + rv!break("Died"); rv; } multi method broken(Promise:U: Mu \exception) { @@ -109,7 +109,7 @@ my class Promise does Awaitable { proto method break(|) { * } multi method break(Promise:D:) { - self.vow.break(False) + self.vow.break("Died") } multi method break(Promise:D: \result) { self.vow.break(result) From 5cd7c7287864a508b699cb15840058f5b2391e54 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Thu, 19 Oct 2017 19:35:52 -0400 Subject: [PATCH 506/692] Remove trailing whitespace --- src/core/io_operators.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/io_operators.pm b/src/core/io_operators.pm index c1d34e1ced4..4245b8f3ad1 100644 --- a/src/core/io_operators.pm +++ b/src/core/io_operators.pm @@ -174,7 +174,7 @@ multi sub indir(IO() $path, &what, :$d = True, :$r, :$w, :$x) { my constant NL-OUT = "\n"; my constant ENCODING = "utf8"; - my sub setup-handle(str $what) { + my sub setup-handle(str $what) { my $handle := nqp::p6bindattrinvres( nqp::create(IO::Handle),IO::Handle,'$!path',nqp::p6bindattrinvres( nqp::create(IO::Special),IO::Special,'$!what',$what From 1e5d6f0d4eee9d3d6b02d064063ed2e633207bd5 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Thu, 19 Oct 2017 19:36:18 -0400 Subject: [PATCH 507/692] Implement knob to weak IO::Handle input buffer --- src/core/IO/Handle.pm | 33 +++++++++++++++++++++++++++------ src/core/io_operators.pm | 2 ++ 2 files changed, 29 insertions(+), 6 deletions(-) diff --git a/src/core/IO/Handle.pm b/src/core/IO/Handle.pm index 4116641ff1c..da583c76ed3 100644 --- a/src/core/IO/Handle.pm +++ b/src/core/IO/Handle.pm @@ -2,6 +2,9 @@ my class IO::Path { ... } my class Proc { ... } my class IO::Handle { + # if editing, edit the value for STDIN in src/core/io_operators.pm too + my constant IN-BUFFER-DEFAULT = 0x100000; + has $.path; has $!PIO; has $.chomp is rw = Bool::True; @@ -11,6 +14,7 @@ my class IO::Handle { has Encoding::Decoder $!decoder; has Encoding::Encoder $!encoder; has int $!out-buffer; + has int $!in-buffer = IN-BUFFER-DEFAULT; submethod TWEAK (:$encoding, :$bin, IO() :$!path = Nil) { nqp::if( @@ -70,6 +74,7 @@ my class IO::Handle { Str:D :$nl-out is copy = $!nl-out, :$buffer, :$out-buffer is copy, + :$in-buffer, ) { nqp::if( $buffer.DEFINITE, @@ -177,6 +182,7 @@ my class IO::Handle { $!encoding = $encoding.name; } self!set-out-buffer-size($out-buffer); + self!set-in-buffer-size($in-buffer); return self; } @@ -224,6 +230,7 @@ my class IO::Handle { $!encoding = $encoding.name; } self!set-out-buffer-size($out-buffer); + self!set-in-buffer-size($in-buffer); self; } @@ -242,6 +249,20 @@ my class IO::Handle { $!out-buffer } + method in-buffer is rw { + Proxy.new: :FETCH{ $!in-buffer }, STORE => -> $, \buffer { + self!set-in-buffer-size: buffer; + } + } + + method !set-in-buffer-size($buffer is copy) { + $!in-buffer = $buffer.defined + ?? nqp::istype($buffer, Bool) + ?? ($buffer ?? IN-BUFFER-DEFAULT !! 0) + !! $buffer.Int + !! IN-BUFFER-DEFAULT + } + method nl-in is rw { Proxy.new( FETCH => { @@ -295,7 +316,7 @@ my class IO::Handle { method !get-line-slow-path() { my $line := Nil; loop { - my $buf := self.read-internal(0x100000); + my $buf := self.read-internal($!in-buffer); if $buf.elems { $!decoder.add-bytes($buf); $line := $!decoder.consume-line-chars(:$!chomp); @@ -519,7 +540,7 @@ my class IO::Handle { buf8.new } else { - $!decoder.add-bytes(self.read-internal($bytes max 0x100000)); + $!decoder.add-bytes(self.read-internal($bytes max $!in-buffer)); $!decoder.consume-exactly-bytes($bytes) // $!decoder.consume-exactly-bytes($!decoder.bytes-available) // buf8.new @@ -535,7 +556,7 @@ my class IO::Handle { my $result := ''; unless self.eof-internal && $!decoder.is-empty { loop { - my $buf := self.read-internal(0x100000); + my $buf := self.read-internal($!in-buffer); if $buf.elems { $!decoder.add-bytes($buf); $result := $!decoder.consume-exactly-chars($chars); @@ -695,7 +716,7 @@ my class IO::Handle { LEAVE self.close if $close; my $res := buf8.new; loop { - my $buf := self.read(0x100000); + my $buf := self.read($!in-buffer); nqp::elems($buf) ?? $res.append($buf) !! return $res @@ -729,7 +750,7 @@ my class IO::Handle { nqp::if( nqp::isfalse($!decoder) || $bin, nqp::while( - nqp::elems(my $buf := self.read-internal(0x100000)), + nqp::elems(my $buf := self.read-internal($!in-buffer)), $res.append($buf))), # don't sink result of .close; it might be a failed Proc nqp::if($close, $ = self.close), @@ -737,7 +758,7 @@ my class IO::Handle { } method !slurp-all-chars() { - while nqp::elems(my $buf := self.read-internal(0x100000)) { + while nqp::elems(my $buf := self.read-internal($!in-buffer)) { $!decoder.add-bytes($buf); } $!decoder.consume-all-chars() diff --git a/src/core/io_operators.pm b/src/core/io_operators.pm index 4245b8f3ad1..73ac16820e6 100644 --- a/src/core/io_operators.pm +++ b/src/core/io_operators.pm @@ -173,6 +173,7 @@ multi sub indir(IO() $path, &what, :$d = True, :$r, :$w, :$x) { my constant NL-IN = ["\x0A", "\r\n"]; my constant NL-OUT = "\n"; my constant ENCODING = "utf8"; + my constant IN-BUFFER-DEFAULT = 0x100000; my sub setup-handle(str $what) { my $handle := nqp::p6bindattrinvres( @@ -184,6 +185,7 @@ multi sub indir(IO() $path, &what, :$d = True, :$r, :$w, :$x) { nqp::getattr($handle,IO::Handle,'$!nl-in') = NL-IN; nqp::getattr($handle,IO::Handle,'$!nl-out') = NL-OUT; nqp::getattr($handle,IO::Handle,'$!encoding') = ENCODING; + nqp::bindattr_i($handle,IO::Handle,'$!in-buffer',IN-BUFFER-DEFAULT); $handle } From dd50d0f02efa54c315d4cd82a51ebede900b1a70 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Thu, 19 Oct 2017 19:40:49 -0400 Subject: [PATCH 508/692] Add buffering test files to list of files to run --- t/spectest.data | 2 ++ 1 file changed, 2 insertions(+) diff --git a/t/spectest.data b/t/spectest.data index c3bcd8131f7..d2956dc9d1f 100644 --- a/t/spectest.data +++ b/t/spectest.data @@ -1006,6 +1006,7 @@ S32-io/chdir-process.t # moar S32-io/copy.t S32-io/dir.t S32-io/file-tests.t +S32-io/in-buffering.t S32-io/indir.t S32-io/io-cathandle.t S32-io/io-handle.t @@ -1031,6 +1032,7 @@ S32-io/note.t S32-io/null-char.t S32-io/open.t S32-io/other.t +S32-io/out-buffering.t S32-io/pipe.t S32-io/rename.t S32-io/seek.t From e0dabacad21da35aaa7b19ec9baebddca3c023df Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Fri, 20 Oct 2017 12:05:40 +0000 Subject: [PATCH 509/692] Remove in-buffer tests - The feature getting the axe for now - The tests were added a day ago; not part of 6.c-errata --- t/spectest.data | 1 - 1 file changed, 1 deletion(-) diff --git a/t/spectest.data b/t/spectest.data index d2956dc9d1f..3419ecd34d0 100644 --- a/t/spectest.data +++ b/t/spectest.data @@ -1006,7 +1006,6 @@ S32-io/chdir-process.t # moar S32-io/copy.t S32-io/dir.t S32-io/file-tests.t -S32-io/in-buffering.t S32-io/indir.t S32-io/io-cathandle.t S32-io/io-handle.t From 7a2561c24bdde79b0369cc9bf7524899ffd54d89 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Fri, 20 Oct 2017 12:06:19 +0000 Subject: [PATCH 510/692] Revert "Implement knob to weak IO::Handle input buffer" This reverts commit 1e5d6f0d4eee9d3d6b02d064063ed2e633207bd5. The current implementation of the feature is a bit iffy, so I'm reverting it for now. Problems: - Better named as ":decoder-refill-chunk-size", since that's what it's actually doing - Unlike :out-buffer, can't be disabled in character mode, since then we refill decoder with zero-length chunks - Unlike :out-buffer, it doesn't apply to binary mode handles, with an additional caveat that it *does* affect binary slurp chunk size --- src/core/IO/Handle.pm | 33 ++++++--------------------------- src/core/io_operators.pm | 2 -- 2 files changed, 6 insertions(+), 29 deletions(-) diff --git a/src/core/IO/Handle.pm b/src/core/IO/Handle.pm index da583c76ed3..4116641ff1c 100644 --- a/src/core/IO/Handle.pm +++ b/src/core/IO/Handle.pm @@ -2,9 +2,6 @@ my class IO::Path { ... } my class Proc { ... } my class IO::Handle { - # if editing, edit the value for STDIN in src/core/io_operators.pm too - my constant IN-BUFFER-DEFAULT = 0x100000; - has $.path; has $!PIO; has $.chomp is rw = Bool::True; @@ -14,7 +11,6 @@ my class IO::Handle { has Encoding::Decoder $!decoder; has Encoding::Encoder $!encoder; has int $!out-buffer; - has int $!in-buffer = IN-BUFFER-DEFAULT; submethod TWEAK (:$encoding, :$bin, IO() :$!path = Nil) { nqp::if( @@ -74,7 +70,6 @@ my class IO::Handle { Str:D :$nl-out is copy = $!nl-out, :$buffer, :$out-buffer is copy, - :$in-buffer, ) { nqp::if( $buffer.DEFINITE, @@ -182,7 +177,6 @@ my class IO::Handle { $!encoding = $encoding.name; } self!set-out-buffer-size($out-buffer); - self!set-in-buffer-size($in-buffer); return self; } @@ -230,7 +224,6 @@ my class IO::Handle { $!encoding = $encoding.name; } self!set-out-buffer-size($out-buffer); - self!set-in-buffer-size($in-buffer); self; } @@ -249,20 +242,6 @@ my class IO::Handle { $!out-buffer } - method in-buffer is rw { - Proxy.new: :FETCH{ $!in-buffer }, STORE => -> $, \buffer { - self!set-in-buffer-size: buffer; - } - } - - method !set-in-buffer-size($buffer is copy) { - $!in-buffer = $buffer.defined - ?? nqp::istype($buffer, Bool) - ?? ($buffer ?? IN-BUFFER-DEFAULT !! 0) - !! $buffer.Int - !! IN-BUFFER-DEFAULT - } - method nl-in is rw { Proxy.new( FETCH => { @@ -316,7 +295,7 @@ my class IO::Handle { method !get-line-slow-path() { my $line := Nil; loop { - my $buf := self.read-internal($!in-buffer); + my $buf := self.read-internal(0x100000); if $buf.elems { $!decoder.add-bytes($buf); $line := $!decoder.consume-line-chars(:$!chomp); @@ -540,7 +519,7 @@ my class IO::Handle { buf8.new } else { - $!decoder.add-bytes(self.read-internal($bytes max $!in-buffer)); + $!decoder.add-bytes(self.read-internal($bytes max 0x100000)); $!decoder.consume-exactly-bytes($bytes) // $!decoder.consume-exactly-bytes($!decoder.bytes-available) // buf8.new @@ -556,7 +535,7 @@ my class IO::Handle { my $result := ''; unless self.eof-internal && $!decoder.is-empty { loop { - my $buf := self.read-internal($!in-buffer); + my $buf := self.read-internal(0x100000); if $buf.elems { $!decoder.add-bytes($buf); $result := $!decoder.consume-exactly-chars($chars); @@ -716,7 +695,7 @@ my class IO::Handle { LEAVE self.close if $close; my $res := buf8.new; loop { - my $buf := self.read($!in-buffer); + my $buf := self.read(0x100000); nqp::elems($buf) ?? $res.append($buf) !! return $res @@ -750,7 +729,7 @@ my class IO::Handle { nqp::if( nqp::isfalse($!decoder) || $bin, nqp::while( - nqp::elems(my $buf := self.read-internal($!in-buffer)), + nqp::elems(my $buf := self.read-internal(0x100000)), $res.append($buf))), # don't sink result of .close; it might be a failed Proc nqp::if($close, $ = self.close), @@ -758,7 +737,7 @@ my class IO::Handle { } method !slurp-all-chars() { - while nqp::elems(my $buf := self.read-internal($!in-buffer)) { + while nqp::elems(my $buf := self.read-internal(0x100000)) { $!decoder.add-bytes($buf); } $!decoder.consume-all-chars() diff --git a/src/core/io_operators.pm b/src/core/io_operators.pm index 73ac16820e6..4245b8f3ad1 100644 --- a/src/core/io_operators.pm +++ b/src/core/io_operators.pm @@ -173,7 +173,6 @@ multi sub indir(IO() $path, &what, :$d = True, :$r, :$w, :$x) { my constant NL-IN = ["\x0A", "\r\n"]; my constant NL-OUT = "\n"; my constant ENCODING = "utf8"; - my constant IN-BUFFER-DEFAULT = 0x100000; my sub setup-handle(str $what) { my $handle := nqp::p6bindattrinvres( @@ -185,7 +184,6 @@ multi sub indir(IO() $path, &what, :$d = True, :$r, :$w, :$x) { nqp::getattr($handle,IO::Handle,'$!nl-in') = NL-IN; nqp::getattr($handle,IO::Handle,'$!nl-out') = NL-OUT; nqp::getattr($handle,IO::Handle,'$!encoding') = ENCODING; - nqp::bindattr_i($handle,IO::Handle,'$!in-buffer',IN-BUFFER-DEFAULT); $handle } From d20e972a121a6d72d3acb4e1e5461f5a8fa7aa59 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Fri, 20 Oct 2017 13:23:54 +0000 Subject: [PATCH 511/692] Revert "Make creating a Promise a bit cheaper" This reverts commit f980cdafe4a2ef103d32e25a9276d972c3cd57aa. This commit appears to cause reproducible stresstest hangs in S17-promise/lock-async-stress.t and S17-promise/lock-async-stress2.t IRC: https://irclog.perlgeek.de/perl6-dev/2017-10-20#i_15329963 --- src/core/Promise.pm | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/core/Promise.pm b/src/core/Promise.pm index 0147d97fb6f..2091eb94dbb 100644 --- a/src/core/Promise.pm +++ b/src/core/Promise.pm @@ -26,7 +26,7 @@ my role X::Promise::Broken { } my class Promise does Awaitable { has $.scheduler; - has $.status is default(Planned); + has $.status; has $!result is default(Nil); has int $!vow_taken; has $!lock; @@ -35,8 +35,9 @@ my class Promise does Awaitable { has Mu $!dynamic_context; submethod BUILD(:$!scheduler = $*SCHEDULER --> Nil) { - $!lock := nqp::create(Lock); - $!cond := $!lock.condition(); + $!lock := nqp::create(Lock); + $!cond := $!lock.condition(); + $!status = Planned; } # A Vow is used to enable the right to keep/break a promise From d37a19ea8360b40e6025ed999dd9f5e7a59f4f9f Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Fri, 20 Oct 2017 15:36:56 +0200 Subject: [PATCH 512/692] Make 'once' work in hypered/raced blocks, jnthn++ - by cloning the mapper for each batch --- src/core/Rakudo/Internals/HyperRaceSharedImpl.pm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/core/Rakudo/Internals/HyperRaceSharedImpl.pm b/src/core/Rakudo/Internals/HyperRaceSharedImpl.pm index 177cf996337..debf51d2e83 100644 --- a/src/core/Rakudo/Internals/HyperRaceSharedImpl.pm +++ b/src/core/Rakudo/Internals/HyperRaceSharedImpl.pm @@ -37,8 +37,9 @@ class Rakudo::Internals::HyperRaceSharedImpl { my $result := IterationBuffer.new; my $items := $batch.items; my int $n = $items.elems; + my &mapper := &!mapper.clone; loop (my int $i = 0; $i < $n; $i++) { - my \mapped = &!mapper(nqp::atpos($items, $i)); + my \mapped = mapper(nqp::atpos($items, $i)); nqp::istype(mapped, Slip) && !nqp::iscont(mapped) ?? mapped.iterator.push-all($result) !! $result.push(mapped) From 870eaa316a25881c1a5de3dc1e9863584f42d34a Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Fri, 20 Oct 2017 16:14:49 +0200 Subject: [PATCH 513/692] Optimize hyper/race a bit - use prefix ++ instead of postfix ++ in sink contexts - start at -1 instead of 0, allowing use of prefix ++ --- src/core/Rakudo/Internals/HyperRaceSharedImpl.pm | 6 +++--- src/core/Rakudo/Internals/HyperToIterator.pm | 4 ++-- src/core/Rakudo/Internals/HyperWorkBatch.pm | 6 +++--- src/core/Rakudo/Internals/HyperWorkStage.pm | 4 ++-- src/core/Rakudo/Internals/RaceToIterator.pm | 2 +- 5 files changed, 11 insertions(+), 11 deletions(-) diff --git a/src/core/Rakudo/Internals/HyperRaceSharedImpl.pm b/src/core/Rakudo/Internals/HyperRaceSharedImpl.pm index debf51d2e83..40f2872b9dc 100644 --- a/src/core/Rakudo/Internals/HyperRaceSharedImpl.pm +++ b/src/core/Rakudo/Internals/HyperRaceSharedImpl.pm @@ -9,7 +9,7 @@ class Rakudo::Internals::HyperRaceSharedImpl { my $result := IterationBuffer.new; my $items := $batch.items; my int $n = $items.elems; - loop (my int $i = 0; $i < $n; $i++) { + loop (my int $i = 0; $i < $n; ++$i) { my \item := nqp::atpos($items, $i); $result.push(item) if $!matcher.ACCEPTS(item); } @@ -38,7 +38,7 @@ class Rakudo::Internals::HyperRaceSharedImpl { my $items := $batch.items; my int $n = $items.elems; my &mapper := &!mapper.clone; - loop (my int $i = 0; $i < $n; $i++) { + loop (my int $i = 0; $i < $n; ++$i) { my \mapped = mapper(nqp::atpos($items, $i)); nqp::istype(mapped, Slip) && !nqp::iscont(mapped) ?? mapped.iterator.push-all($result) @@ -65,7 +65,7 @@ class Rakudo::Internals::HyperRaceSharedImpl { has int $!last-target = -1; has int $!batches-seen = 0; method consume-batch(Rakudo::Internals::HyperWorkBatch $batch --> Nil) { - $!batches-seen++; + ++$!batches-seen; self.batch-used(); if $batch.last { $!last-target = $batch.sequence-number; diff --git a/src/core/Rakudo/Internals/HyperToIterator.pm b/src/core/Rakudo/Internals/HyperToIterator.pm index bbb2988c357..a2d069a03c3 100644 --- a/src/core/Rakudo/Internals/HyperToIterator.pm +++ b/src/core/Rakudo/Internals/HyperToIterator.pm @@ -28,12 +28,12 @@ my class Rakudo::Internals::HyperToIterator does Rakudo::Internals::HyperJoiner my int $seq = $batch.sequence-number; if $seq == $!next-to-send { $!batches.send($batch); - $!next-to-send++; + ++$!next-to-send; if @!held-back { @!held-back.=sort(*.sequence-number); while @!held-back && @!held-back[0].sequence-number == $!next-to-send { $!batches.send(@!held-back.shift); - $!next-to-send++; + ++$!next-to-send; } } } diff --git a/src/core/Rakudo/Internals/HyperWorkBatch.pm b/src/core/Rakudo/Internals/HyperWorkBatch.pm index 73e03353338..76296b52594 100644 --- a/src/core/Rakudo/Internals/HyperWorkBatch.pm +++ b/src/core/Rakudo/Internals/HyperWorkBatch.pm @@ -21,13 +21,13 @@ my class Rakudo::Internals::HyperWorkBatch does Iterable { submethod BUILD(:$items --> Nil) { $!items := nqp::decont($items); - $!i = 0; + $!i = -1; $!n = nqp::elems($!items); } method pull-one() { - $!i < $!n - ?? nqp::atpos($!items, $!i++) + ++$!i < $!n + ?? nqp::atpos($!items, $!i) !! IterationEnd } } diff --git a/src/core/Rakudo/Internals/HyperWorkStage.pm b/src/core/Rakudo/Internals/HyperWorkStage.pm index 6255fdf2ee8..3f1ac879e5e 100644 --- a/src/core/Rakudo/Internals/HyperWorkStage.pm +++ b/src/core/Rakudo/Internals/HyperWorkStage.pm @@ -10,10 +10,10 @@ my role Rakudo::Internals::HyperWorkStage { # of the appropriate size. Such a stage always lives at the start of a piece # of parallel processing pipeline. my role Rakudo::Internals::HyperBatcher does Rakudo::Internals::HyperWorkStage { - has $!sequence = 0; + has $!sequence = -1; method next-sequence-number() { - $!sequence++ + ++$!sequence } method produce-batch(int $batch-size --> Rakudo::Internals::HyperWorkBatch) { ... } diff --git a/src/core/Rakudo/Internals/RaceToIterator.pm b/src/core/Rakudo/Internals/RaceToIterator.pm index 09db1efc7a6..bd6540f8553 100644 --- a/src/core/Rakudo/Internals/RaceToIterator.pm +++ b/src/core/Rakudo/Internals/RaceToIterator.pm @@ -5,7 +5,7 @@ my class Rakudo::Internals::RaceToIterator does Rakudo::Internals::HyperJoiner d has int $!batches-seen = 0; method consume-batch(Rakudo::Internals::HyperWorkBatch $batch --> Nil) { $!batches.send($batch); - $!batches-seen++; + ++$!batches-seen; if $batch.last { $!last-target = $batch.sequence-number; } From 527b88816a0a8b6c080476244348599188b7f286 Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Fri, 20 Oct 2017 16:51:58 +0200 Subject: [PATCH 514/692] Run S07-hyperrace/for.t --- t/spectest.data | 1 + 1 file changed, 1 insertion(+) diff --git a/t/spectest.data b/t/spectest.data index 3419ecd34d0..0c79d5ff9d3 100644 --- a/t/spectest.data +++ b/t/spectest.data @@ -542,6 +542,7 @@ S06-traits/native-is-rw.t S06-traits/precedence.t S07-slip/slip.t S07-iterators/range-iterator.t +S07-hyperrace/for.t S07-hyperrace/hyper.t S07-hyperrace/race.t S07-hyperrace/stress.t # stress From 7e9b9633d63127ef573a7d490dabbc3037f926cd Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Fri, 20 Oct 2017 17:10:33 +0200 Subject: [PATCH 515/692] Fix copy-pasta spotted by b2gills++ --- src/core/RaceSeq.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/RaceSeq.pm b/src/core/RaceSeq.pm index 9b7293be5a4..a6c65869f52 100644 --- a/src/core/RaceSeq.pm +++ b/src/core/RaceSeq.pm @@ -32,7 +32,7 @@ my class RaceSeq does Iterable does Sequence { method race(RaceSeq:D:) { self } - multi method serial(HyperSeq:D:) { self.Seq } + multi method serial(RaceSeq:D:) { self.Seq } method sink(--> Nil) { Rakudo::Internals::HyperRaceSharedImpl.sink(self, $!work-stage-head) From 6726d4af20ea5b973130036e4ce76695b30fe9bb Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Fri, 20 Oct 2017 15:12:06 +0000 Subject: [PATCH 516/692] Bump NQP --- tools/build/NQP_REVISION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/build/NQP_REVISION b/tools/build/NQP_REVISION index ae31831d10b..852aaab47df 100644 --- a/tools/build/NQP_REVISION +++ b/tools/build/NQP_REVISION @@ -1 +1 @@ -2017.09-99-g254d590 +2017.09-116-g252fd89 From da977785c6a478a97e93b73cbc4b3312e30575ad Mon Sep 17 00:00:00 2001 From: Jonathan Worthington Date: Fri, 20 Oct 2017 17:23:12 +0200 Subject: [PATCH 517/692] Replicate the `map` clone-per-batch in `grep` too This splitting up also removes a level of indirection for the common block case of hyper/race grep, and thus should speed things up a bit in that case also. --- .../Rakudo/Internals/HyperRaceSharedImpl.pm | 33 +++++++++++++++++-- 1 file changed, 31 insertions(+), 2 deletions(-) diff --git a/src/core/Rakudo/Internals/HyperRaceSharedImpl.pm b/src/core/Rakudo/Internals/HyperRaceSharedImpl.pm index 40f2872b9dc..7f65ccdb337 100644 --- a/src/core/Rakudo/Internals/HyperRaceSharedImpl.pm +++ b/src/core/Rakudo/Internals/HyperRaceSharedImpl.pm @@ -1,6 +1,6 @@ # Implementations shared between HyperSeq and RaceSeq. class Rakudo::Internals::HyperRaceSharedImpl { - my class Grep does Rakudo::Internals::HyperProcessor { + my class GrepSM does Rakudo::Internals::HyperProcessor { has $!matcher; submethod TWEAK(:$!matcher) {} @@ -24,7 +24,36 @@ class Rakudo::Internals::HyperRaceSharedImpl { else { hyper.bless: configuration => hyper.configuration, - work-stage-head => Grep.new(:$source, :matcher(matcher)) + work-stage-head => GrepSM.new(:$source, :matcher(matcher)) + } + } + + my class GrepCode does Rakudo::Internals::HyperProcessor { + has &!matcher; + + submethod TWEAK(:&!matcher) {} + + method process-batch(Rakudo::Internals::HyperWorkBatch $batch) { + my $result := IterationBuffer.new; + my $items := $batch.items; + my int $n = $items.elems; + my &matcher = &!matcher.clone; + loop (my int $i = 0; $i < $n; ++$i) { + my \item := nqp::atpos($items, $i); + $result.push(item) if matcher(item); + } + $batch.replace-with($result); + } + } + multi method grep(\hyper, $source, &matcher, %options) { + if %options || &matcher.count > 1 { + # Fall back to sequential grep for cases we can't yet handle + self.rehyper(hyper, hyper.Any::grep(&matcher, |%options)) + } + else { + hyper.bless: + configuration => hyper.configuration, + work-stage-head => GrepCode.new(:$source, :&matcher) } } From dd880cad428aefc7f164fcad35ece82d53e532d9 Mon Sep 17 00:00:00 2001 From: MasterDuke17 Date: Fri, 20 Oct 2017 17:41:36 -0400 Subject: [PATCH 518/692] Optimize INTERPOLATE even more Make as many parameters anonymous or non-sigiled as possible. --- src/core/Match.pm | 168 ++++++++++++++++++++++------------------------ 1 file changed, 82 insertions(+), 86 deletions(-) diff --git a/src/core/Match.pm b/src/core/Match.pm index 38668559f43..0c38282385a 100644 --- a/src/core/Match.pm +++ b/src/core/Match.pm @@ -205,92 +205,92 @@ my class Match is Capture is Cool does NQPMatchRole { # aren't currently JITted on MoarVM proto method INTERPOLATE(|) { * } - multi method INTERPOLATE(Callable:D \var, int $im, int $monkey, int $s, int $a, $context) { + multi method INTERPOLATE(Callable:D \var, $, $, $, $, $) { # Call it if it is a routine. This will capture if requested. (var)(self) } - multi method INTERPOLATE(Iterable:D \var, int $im, int $monkey, int $s, int $a, $context) { + multi method INTERPOLATE(Iterable:D \var, int \im, int \monkey, int \s, int \a, \context) { my $maxmatch; - my $cur := self.'!cursor_start_cur'(); - my str $tgt = $cur.target; + my \cur := self.'!cursor_start_cur'(); + my str $tgt = cur.target; my int $eos = nqp::chars($tgt); my int $maxlen = -1; - my int $pos = nqp::getattr_i($cur, $?CLASS, '$!from'); + my int $pos = nqp::getattr_i(cur, $?CLASS, '$!from'); my int $start = 1; - my int $nomod = $im == 0; + my int $nomod = im == 0; my Mu $order := nqp::list(); # Looks something we need to loop over if !nqp::iscont(var) { - my $varlist := var.list; - my int $elems = $varlist.elems; # reifies - my $list := nqp::getattr($varlist,List,'$!reified'); + my \varlist := var.list; + my int $elems = varlist.elems; # reifies + my \list := nqp::getattr(varlist,List,'$!reified'); # Order matters for sequential matching, so no NFA involved. - if $s { - $order := $list; + if s { + $order := list; } # prepare to run the NFA if var is array-ish. else { - my Mu $nfa := QRegex::NFA.new; - my Mu $alts := nqp::setelems(nqp::list,$elems); + my Mu \nfa := QRegex::NFA.new; + my Mu \alts := nqp::setelems(nqp::list,$elems); my int $fate = 0; my int $j = -1; while nqp::islt_i(++$j,$elems) { - my Mu $topic := nqp::atpos($list,$j); - nqp::bindpos($alts,$j,$topic); + my Mu $topic := nqp::atpos(list,$j); + nqp::bindpos(alts,$j,$topic); # We are in a regex assertion, the strings we get will # be treated as regex rules. - if $a { - return $cur.'!cursor_start_cur'() + if a { + return cur.'!cursor_start_cur'() if nqp::istype($topic,Associative); - my $rx := MAKE_REGEX($topic,$im == 1 || $im == 3,$im == 2 || $im == 3,$monkey,$context); - $nfa.mergesubstates($start,0,nqp::decont($fate), + my $rx := MAKE_REGEX($topic,im == 1 || im == 3,im == 2 || im == 3,monkey,context); + nfa.mergesubstates($start,0,nqp::decont($fate), nqp::findmethod($rx,'NFA')($rx), Mu); } # A Regex already. elsif nqp::istype($topic,Regex) { - $nfa.mergesubstates($start,0,nqp::decont($fate), + nfa.mergesubstates($start,0,nqp::decont($fate), nqp::findmethod($topic,'NFA')($topic), Mu); } # The pattern is a string. else { - my Mu $lit := QAST::Regex.new( + my Mu \lit := QAST::Regex.new( :rxtype, $topic, :subtype( $nomod ?? '' - !! $im == 2 - ?? $im == 1 + !! im == 2 + ?? im == 1 ?? 'ignorecase+ignoremark' !! 'ignoremark' !! 'ignorecase') ); - my Mu $nfa2 := QRegex::NFA.new; - my Mu $node := nqp::findmethod($nfa2,'addnode')($nfa2,$lit); - $nfa.mergesubstates($start,0,nqp::decont($fate), - nqp::findmethod($node,'save')($node,:non_empty(1)), + my Mu \nfa2 := QRegex::NFA.new; + my Mu \node := nqp::findmethod(nfa2,'addnode')(nfa2,lit); + nfa.mergesubstates($start,0,nqp::decont($fate), + nqp::findmethod(node,'save')(node,:non_empty(1)), Mu); } ++$fate; } # Now run the NFA - my Mu $fates := nqp::findmethod($nfa,'run')($nfa,$tgt,$pos); - my int $count = nqp::elems($fates); + my Mu \fates := nqp::findmethod(nfa,'run')(nfa,$tgt,$pos); + my int $count = nqp::elems(fates); nqp::setelems($order,$count); $j = -1; nqp::bindpos($order,$j, - nqp::atpos($alts,nqp::atpos_i($fates,$j))) + nqp::atpos(alts,nqp::atpos_i(fates,$j))) while nqp::islt_i(++$j,$count); } } @@ -310,11 +310,11 @@ my class Match is Capture is Cool does NQPMatchRole { # We are in a regex assertion, the strings we get will be # treated as regex rules. - if $a { - return $cur.'!cursor_start_cur'() + if a { + return cur.'!cursor_start_cur'() if nqp::istype($topic,Associative); - my $rx := MAKE_REGEX($topic,$im == 1 || $im == 3,$im == 2 || $im == 3,$monkey,$context); + my $rx := MAKE_REGEX($topic,im == 1 || im == 3,im == 2 || im == 3,monkey,context); $match := self.$rx; $len = $match.pos - $match.from; } @@ -338,17 +338,17 @@ my class Match is Capture is Cool does NQPMatchRole { #?if moar # ignoremark+ignorecase - elsif $im == 3 { + elsif im == 3 { $match = nqp::eqaticim($tgt, $topic_str, $pos); } # ignoremark - elsif $im == 2 { + elsif im == 2 { $match = nqp::eqatim($tgt, $topic_str, $pos); } # ignorecase - elsif $im == 1 { + elsif im == 1 { $match = nqp::eqatic($tgt, $topic_str, $pos); } #?endif @@ -359,11 +359,11 @@ my class Match is Capture is Cool does NQPMatchRole { # exception for both, so the code doesn't actually work. # ignoremark(+ignorecase?) - elsif $im == 2 || $im == 3 { + elsif im == 2 || im == 3 { my int $k = -1; # ignorecase+ignoremark - if $im == 3 { + if im == 3 { my str $tgt_fc = nqp::fc(nqp::substr($tgt,$pos,$len)); my str $topic_fc = nqp::fc($topic_str); Nil while nqp::islt_i(++$k,$len) @@ -399,29 +399,27 @@ my class Match is Capture is Cool does NQPMatchRole { && nqp::isle_i(nqp::add_i($pos,$len),$eos) { $maxlen = $len; $maxmatch := $match; - last if $s; # stop here for sequential alternation + last if s; # stop here for sequential alternation } } nqp::istype($maxmatch, Match) ?? $maxmatch !! nqp::isge_i($maxlen,0) - ?? $cur.'!cursor_pass'(nqp::add_i($pos,$maxlen), '') - !! $cur + ?? cur.'!cursor_pass'(nqp::add_i($pos,$maxlen), '') + !! cur } - multi method INTERPOLATE(Associative:D \var, int $im, int $monkey, int $s, int $a, $context) { - my $cur := self.'!cursor_start_cur'(); - if $a { - return $cur.'!cursor_start_cur'() + multi method INTERPOLATE(Associative:D \var, int \im, $, $, int \a, \context) { + my \cur := self.'!cursor_start_cur'(); + if a { + return cur.'!cursor_start_cur'() } my $maxmatch; - my str $tgt = $cur.target; - my int $eos = nqp::chars($tgt); + my str $tgt = cur.target; my int $maxlen = -1; - my int $pos = nqp::getattr_i($cur, $?CLASS, '$!from'); - my int $nomod = $im == 0; + my int $pos = nqp::getattr_i(cur, $?CLASS, '$!from'); my str $topic_str; my $match; @@ -434,23 +432,23 @@ my class Match is Capture is Cool does NQPMatchRole { } # no modifier, match literally - elsif $nomod { + elsif im ==0 { $match = nqp::eqat($tgt, $topic_str, $pos); } #?if moar # ignoremark+ignorecase - elsif $im == 3 { + elsif im == 3 { $match = nqp::eqaticim($tgt, $topic_str, $pos); } # ignoremark - elsif $im == 2 { + elsif im == 2 { $match = nqp::eqatim($tgt, $topic_str, $pos); } # ignorecase - elsif $im == 1 { + elsif im == 1 { $match = nqp::eqatic($tgt, $topic_str, $pos); } #?endif @@ -461,11 +459,11 @@ my class Match is Capture is Cool does NQPMatchRole { # exception for both, so the code doesn't actually work. # ignoremark(+ignorecase?) - elsif $im == 2 || $im == 3 { + elsif im == 2 || im == 3 { my int $k = -1; # ignorecase+ignoremark - if $im == 3 { + if im == 3 { my str $tgt_fc = nqp::fc(nqp::substr($tgt,$pos,$len)); my str $topic_fc = nqp::fc($topic_str); Nil while nqp::islt_i(++$k,$len) @@ -498,7 +496,7 @@ my class Match is Capture is Cool does NQPMatchRole { if $match && nqp::isgt_i($len,$maxlen) - && nqp::isle_i(nqp::add_i($pos,$len),$eos) { + && nqp::isle_i(nqp::add_i($pos,$len),nqp::chars($tgt)) { $maxlen = $len; $maxmatch := $match; } @@ -506,16 +504,16 @@ my class Match is Capture is Cool does NQPMatchRole { nqp::istype($maxmatch, Match) ?? $maxmatch !! nqp::isge_i($maxlen,0) - ?? $cur.'!cursor_pass'(nqp::add_i($pos,$maxlen), '') - !! $cur + ?? cur.'!cursor_pass'(nqp::add_i($pos,$maxlen), '') + !! cur } - multi method INTERPOLATE(Regex:D \var, $, $, $, $, $) { + multi method INTERPOLATE(Regex:D \var, int \im, int \monkey, $, int \a, $) { my $maxmatch; - my $cur := self.'!cursor_start_cur'(); + my \cur := self.'!cursor_start_cur'(); my int $maxlen = -1; - my int $pos = nqp::getattr_i($cur, $?CLASS, '$!from'); + my int $pos = nqp::getattr_i(cur, $?CLASS, '$!from'); my Mu $topic := var; my $match := self.$topic; @@ -523,7 +521,7 @@ my class Match is Capture is Cool does NQPMatchRole { my int $len = $match.pos - $match.from; if nqp::isgt_i($len,$maxlen) - && nqp::isle_i(nqp::add_i($pos,$len),nqp::chars($cur.target)) { + && nqp::isle_i(nqp::add_i($pos,$len),nqp::chars(cur.target)) { $maxlen = $len; $maxmatch := $match; } @@ -532,19 +530,17 @@ my class Match is Capture is Cool does NQPMatchRole { nqp::istype($maxmatch, Match) ?? $maxmatch !! nqp::isge_i($maxlen,0) - ?? $cur.'!cursor_pass'(nqp::add_i($pos,$maxlen), '') - !! $cur + ?? cur.'!cursor_pass'(nqp::add_i($pos,$maxlen), '') + !! cur } - multi method INTERPOLATE(Mu:D \var, int $im, int $monkey, int $s, int $a, $context) { + multi method INTERPOLATE(Mu:D \var, int \im, int \monkey, $, int \a, \context) { my $maxmatch; - my $cur := self.'!cursor_start_cur'(); - my str $tgt = $cur.target; - my int $eos = nqp::chars($tgt); + my \cur = self.'!cursor_start_cur'(); + my str $tgt = cur.target; my int $maxlen = -1; - my int $pos = nqp::getattr_i($cur, $?CLASS, '$!from'); - my int $nomod = $im == 0; + my int $pos = nqp::getattr_i(cur, $?CLASS, '$!from'); my str $topic_str; my $match; @@ -552,36 +548,36 @@ my class Match is Capture is Cool does NQPMatchRole { # We are in a regex assertion, the strings we get will be # treated as regex rules. - if $a { - my $rx := MAKE_REGEX(var,$im == 1 || $im == 3,$im == 2 || $im == 3,$monkey,$context); + if a { + my $rx := MAKE_REGEX(var,im == 1 || im == 3,im == 2 || im == 3,monkey,context); $match := self.$rx; $len = $match.pos - $match.from; } - # The pattern is a string. $len and and $topic_str are used - # later on if this condition does not hold. + # The pattern is a zero length string. $len and and $topic_str + # are used later on if this condition does not hold. elsif nqp::iseq_i(($len = nqp::chars($topic_str = var.Str)),0) { $match = 1; } # no modifier, match literally - elsif $nomod { + elsif im == 0 { $match = nqp::eqat($tgt, $topic_str, $pos); } #?if moar # ignoremark+ignorecase - elsif $im == 3 { + elsif im == 3 { $match = nqp::eqaticim($tgt, $topic_str, $pos); } # ignoremark - elsif $im == 2 { + elsif im == 2 { $match = nqp::eqatim($tgt, $topic_str, $pos); } # ignorecase - elsif $im == 1 { + elsif im == 1 { $match = nqp::eqatic($tgt, $topic_str, $pos); } #?endif @@ -592,11 +588,11 @@ my class Match is Capture is Cool does NQPMatchRole { # exception for both, so the code doesn't actually work. # ignoremark(+ignorecase?) - elsif $im == 2 || $im == 3 { + elsif im == 2 || im == 3 { my int $k = -1; # ignorecase+ignoremark - if $im == 3 { + if im == 3 { my str $tgt_fc = nqp::fc(nqp::substr($tgt,$pos,$len)); my str $topic_fc = nqp::fc($topic_str); Nil while nqp::islt_i(++$k,$len) @@ -615,12 +611,12 @@ my class Match is Capture is Cool does NQPMatchRole { ); } - $match = nqp::iseq_i($k,$len); # match if completed + match = nqp::iseq_i($k,$len); # match if completed } # ignorecase else { - $match = nqp::iseq_s( + match = nqp::iseq_s( nqp::fc(nqp::substr($tgt, $pos, $len)), nqp::fc($topic_str) ) @@ -629,7 +625,7 @@ my class Match is Capture is Cool does NQPMatchRole { if $match && nqp::isgt_i($len,$maxlen) - && nqp::isle_i(nqp::add_i($pos,$len),$eos) { + && nqp::isle_i(nqp::add_i($pos,$len),nqp::chars($tgt)) { $maxlen = $len; $maxmatch := $match; } @@ -637,11 +633,11 @@ my class Match is Capture is Cool does NQPMatchRole { nqp::istype($maxmatch, Match) ?? $maxmatch !! nqp::isge_i($maxlen,0) - ?? $cur.'!cursor_pass'(nqp::add_i($pos,$maxlen), '') - !! $cur + ?? cur.'!cursor_pass'(nqp::add_i($pos,$maxlen), '') + !! cur } - multi method INTERPOLATE(Mu:U \var, int $im, int $monkey, int $s, int $a, $context) { + multi method INTERPOLATE(Mu:U \var, $, $, $, $, $) { self."!cursor_start_cur"() } From 765dd6944fda9ff152ec198f00e5065d781fec65 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Fri, 20 Oct 2017 18:15:33 -0400 Subject: [PATCH 519/692] Add IO::CatHandle.out-buffer Throw NYI. To block out IO::Handle.out-buffer --- src/core/IO/CatHandle.pm | 50 ++++++++++++++++++----------------- t/02-rakudo/07-io-cathandle.t | 4 ++- 2 files changed, 29 insertions(+), 25 deletions(-) diff --git a/src/core/IO/CatHandle.pm b/src/core/IO/CatHandle.pm index 557a417ef39..2901dc78715 100644 --- a/src/core/IO/CatHandle.pm +++ b/src/core/IO/CatHandle.pm @@ -343,30 +343,32 @@ my class IO::CatHandle is IO::Handle { self } - # __________________________________________ - # / I don't know what the write methods \ - # | should do in a CatHandle, so I'll mark | - # | these as NYI, for now.... Has anyone | - # \ seen my cocoon? I always lose that thing! / - # | ----------------------------------------- - # | / - # |/ - # (⛣) - proto method flush (|) { * } - multi method flush (|) { die X::NYI.new: :feature } - proto method print (|) { * } - multi method print (|) { die X::NYI.new: :feature } - proto method printf (|) { * } - multi method printf (|) { die X::NYI.new: :feature } - proto method print-nl(|) { * } - multi method print-nl(|) { die X::NYI.new: :feature } - proto method put (|) { * } - multi method put (|) { die X::NYI.new: :feature } - proto method say (|) { * } - multi method say (|) { die X::NYI.new: :feature } - proto method write (|) { * } - multi method write (|) { die X::NYI.new: :feature } - # /|\ + # __________________________________________ + # / I don't know what the write methods \ + # | should do in a CatHandle, so I'll mark | + # | these as NYI, for now.... Has anyone | + # \ seen my cocoon? I always lose that thing! / + # | ----------------------------------------- + # | / + # |/ + # (⛣) + proto method flush (|) { * } + multi method flush (|) { die X::NYI.new: :feature } + proto method out-buffer (|) { * } + multi method out-buffer (|) { die X::NYI.new: :feature } + proto method print (|) { * } + multi method print (|) { die X::NYI.new: :feature } + proto method printf (|) { * } + multi method printf (|) { die X::NYI.new: :feature } + proto method print-nl (|) { * } + multi method print-nl (|) { die X::NYI.new: :feature } + proto method put (|) { * } + multi method put (|) { die X::NYI.new: :feature } + proto method say (|) { * } + multi method say (|) { die X::NYI.new: :feature } + proto method write (|) { * } + multi method write (|) { die X::NYI.new: :feature } + # /|\ # Don't die on this one, as doing so breaks .Capture # proto method nl-out (|) { * } diff --git a/t/02-rakudo/07-io-cathandle.t b/t/02-rakudo/07-io-cathandle.t index 4cd3392253e..e96785b955e 100644 --- a/t/02-rakudo/07-io-cathandle.t +++ b/t/02-rakudo/07-io-cathandle.t @@ -3,7 +3,9 @@ use Test; # Tests that NYI methods of IO::CatHandle throw -my @meths = ; # nl-out +my @meths = < + flush out-buffer print printf print-nl put say write +>; # nl-out plan 2 + @meths; throws-like { IO::CatHandle.new."$_"() }, X::NYI, $_ for @meths; From 37c0c49759481ae2a8bf7038b6bfdd5c22fa44be Mon Sep 17 00:00:00 2001 From: Aleks-Daniel Jakimenko-Aleksejev Date: Sat, 21 Oct 2017 04:42:57 +0300 Subject: [PATCH 520/692] Whitespace --- src/core/Match.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/Match.pm b/src/core/Match.pm index 0c38282385a..c8ea99f6c62 100644 --- a/src/core/Match.pm +++ b/src/core/Match.pm @@ -432,7 +432,7 @@ my class Match is Capture is Cool does NQPMatchRole { } # no modifier, match literally - elsif im ==0 { + elsif im == 0 { $match = nqp::eqat($tgt, $topic_str, $pos); } From 57de65fc2853f5d78452ee30df97f046907e3e23 Mon Sep 17 00:00:00 2001 From: Aleks-Daniel Jakimenko-Aleksejev Date: Sat, 21 Oct 2017 06:01:14 +0300 Subject: [PATCH 521/692] Log all changes Feel free to tweak it. Deliberately not logged: 89b9ac78 7fcab106 f8a74eab e4c32b3a da5c36c1 3e358199 c46be84c 5a9bb4a5 de56c056 b66f5e1c 06fe4c4d 78a4824b 99f90e65 56193b59 045ef448 3da62db9 17aead27 ffd17990 7af339b9 91cefc1a 21f05e3f b02da4d1 3f0f3214 8be3eb8e b0af549d 8cf083c7 bb0ebabc 167f0f83 4c337e8e 44d5256c 6d2adb20 a65d5f92 3341384b 68fdeff3 142f772e cd043f2a 8ed7adf1 01d4939c 22d3d933 be83cd4e 66a01aa8 f1c6fc58 98900dfd b7f8daf0 fe75e31b a89add0b d60ba633 04ea446d 1275fd4a 530e1294 785d2f25 d79ac970 5d12bc6e 415e9adb 9bbfed16 07c1e4fc 78c967cb bbc6570f f4275754 fa8fe84b df5899d7 a28c00a1 b33c2d6f c7322122 96669c6b d565ded0 8ff76b59 f62ae60c f28875f1 cb9d2e04 4868e927 6757f934 0d5bb909 93c4555d 78eca214 d8a20d11 64d41ffa d22722e4 6256ec82 e72dedf5 43588718 92bc011a 63643ad0 9c4025f3 71a0ad55 2f0bb20e 153f133b c45d0cd1 d82c09b3 c9913277 39d50ad5 775c367f 27131ed8 b8eda66c 973f88dc 484f9872 e11f4ea2 880a8e1c 47faae2b e19b3409 fbae69e2 a72214c4 714c188d a0f29e0d de564a51 50a67434 4b8a0ef6 37689a3e 1a97c44b f72be0f1 969853c6 f4f36915 e475ae8e 4473591b 80cee362 a54da11a 012c80f3 a0279e56 5092d6e6 0262a997 0d217357 d5615174 c1e5cfcf a7b04493 0bd2b27d ebb0521b 441fc9b3 1706194c e52c8aff f7ef1fc9 ae9de582 bd530108 dd50d0f0 0beeef9b 9190a3b8 d00b5e3a 1623f6fe 7efef119 1cb266b8 f1334512 0ffff859 6ba16f84 6646e364 c4b96e45 61a77e60 ee0bcbd8 c4b96e45 f59b2887 ba2d858f d23a9ba9 d6a9edac a225e040 ef050fe9 85ae1c92 39a4b75b fab0667f f1908a68 36f0ab4f c9f1e05a bc648184 7b89a3f1 50c11631 ac4e73cd f254e359 4c49e747 fe89d350 e99fff7b 2e2c0abd e9cf90e7 8ffe10d4 b0a6cd9e 232b0852 50538ad8 01203bda 16cb6798 037a6cf8 71dc01e7 3bf50cce b59804bc 1e747e01 40cde2ce a5e3cd54 a19fa494 a2cc03af dd5bb72b 9ca8fde5 a26613f6 da3a8770 3dc8020e 0033ac85 331fcb0d 5a226f5f bd19a666 9869dea3 cce0b949 92470459 413fa590 d1324f1c d95ae925 4b78e8ac 00319594 722d8711 f4a2840a 3ac3eb96 2e7cad44 f9432a82 54d50967 e0714904 3ede49cd 640d3857 aa354ad7 77bb7e21 106531dd e93d75e5 a1beb79b 2b3fc84c c6b3ea96 2dd80c7b 0f19e6f9 598fd9a7 baf8561e 1ed21c23 ff5e9c60 c8320e18 d3b1cdbf 87dc51f5 --- docs/ChangeLog | 112 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 112 insertions(+) diff --git a/docs/ChangeLog b/docs/ChangeLog index 97e94b67305..0bbe0fd0a50 100644 --- a/docs/ChangeLog +++ b/docs/ChangeLog @@ -1,3 +1,115 @@ +New in 2017.10: + + SPECIAL NOTES: + + This release includes fixes to || alternation in :ratchet + mode. Code that was unintentionally relying on buggy behavior + (backtracking in :ratched mode) may now produce unwanted + results (namely will fail to match) [963a0f06] + + Security: + + Restricted dynamic lookup metasyntax in rx EVAL [1d63dfd2][2448195d] + + Deprecations: + + Deprecated .new on native types [9d9c7f9c][cc6c0558] + + Deprecated :buffer `open` arg in favor of :out-buffer [f9c10c21] + + Fixes: + + Fixed Hash.perl to include Scalar indicators [47d6c66e] + + Fixed :delete with lazy Arrays [0385b2aa] + + Fixed serial/sanitry for on-demand Supplies [93a66d75] + + Fixed duplicate done/quit messages [9e179355] + + Fixed non-blocking `react { await blah() }` [29863a0b] + + Fixed issues with Int.new [dff7d9b2][0d2ca0d7][0834036d] + + Fixed isa method on a subset [cee1be22] + + Fixed Supply.zip to eager-shift its values [f9400d9a] + + Fixed two utf8-c8 bugs [963a0f06] + + Fixed infinite loop in .^roles of a class that does Rational [0961abe8] + + Changed uniname to give better strings for non-unique names [9dba498f] + + Fixed .push-all/.skip-all on SlippyIterators [41896b7b] + + Fixed and improved `**` regex quantifier [681d6be9][4ca1fc3c] + + Made cmp-ok to try harder to give useful description [8479a1ba] + + Made List.ACCEPTS non-fatal for lazy iterables [1b9638e2] + + Fixed some unspace parsing cases [11070e0f] + + Fixed &chdir failing to respect :CWD attribute [4906a1de] + + Fixed Blob.gist to trim its guts to 100 elements [ac8e5f43] + + Improved .perl and .gist methods on Maps and Hashes [aad8991e] + [39461368][381c4c3b] + + Fixed explosion in IO::CatHandle.nl-out [83008443] + + Fixed .pick and .roll on object hashes [12fcece4] + + Fixed cmp-ok() to take `=:=` op as comparator [3684384d] + + Fixed `is default(Mu)` on attributes [54507ac9] + + Made Array.List fill holes with Nil [e1351219] + + Fixed BagHash.grab with large values [975fcf6c] + + Fixed .tail with large values [43e7b893] + + Improved .gist of nodal methods [b6982e68][bb1df2cb] + + Fixed IO::Pipe.close not always returning the Proc [74328278] + + Fixed handling of type objects in set operators [8a88d149] + + Fixed location of errors coming from Channel [82a38c29] + + Fixed lockup when scheduling with degenerate delays [df01ad97][031f8cf7] + + Fixed segfault in getlexdyn [4f5fc520][4c370072] + + Various async improvements [633a15b8][ef4d16fe][f53d3963] + [26a9c313][9d903408][0d600a0c][54783920][e0e5e6fa][b16aba01] + [d8890a82][73aeee6c][2a826238][3deda842][f58ac999][40c2d0cd] + [c46de00f][e5c17462][6e42b37e][80f883bc] + + Various fixes and improvements to hyper/race [cc2a0643][2352efe5] + [d43b3738][dfa230f7][1fdc84fe][cef4806f][ea51d19b][374ee3e2] + [ad0dd8e7][41729e93][d74ba041][83676112][2580a0a6] + + Various improvements to warnings and error reporting [38186fcd] + [cf95ce81][66c2d05f][a845ac3d][48a84d6a][bb45791c][279bae08] + [6542bb80][5747bc71][c7a82d45][fb7abf06][ac97a401][64b001a1] + [1ea3297b][56eef696][25c87d0d][5d3ebc09][de2b9ff7][084078e1] + [3acde358][b3bb8c40][e611978f][12774237][33e113a2] + + Additions: + + Added trim* subroutines to Cool instance [5a19dffa][691f8b7b][e01e5bc3] + + Added Lock::Async [53dd776c][4a8038c2][85bdd38a][38896402][6170cb9d] + + Added atomic reference op support on JVM backend [32e4a1de][59c4117f] + + Added $*USAGE [0b15f672] + + Added :bin parameter to IO::Handle.slurp [e2ec569b] + + Added support for Bufs in &EVAL/&EVALFILE [6c928d61] + + Added warning on typical precedence errors with infix:<..> [26bdc95c] + + Added --repl-mode command line option [9ce896d8][20518454] + [5c7bbea0][93e599db][de0533c4] + + Implemented typed pointer increment and array dereference + [3ca6554f][bc5fbfcb][2fba0ba0] + + Added X::Cannot::Capture exception type [4ba12ff1][bad9fefd][cd5864cf] + + Added X::Numeric::CannotConvert exception type [2e726528] + [b377de1c][f04bd1d6] + + Added IO::Handle.out-buffer for controlling the buffer size [f9c10c21] + + Added IO::Path.parent(Int) for getting up more than one level [7bea3a2d] + + Removals: + + Removed $*MAIN-ALLOW-NAMED-ANYWHERE [9cb4b167] + + Removed support for ornate parenthesis from quoting constructs [9ce896d8] + + Renamed $*INITTIME to $*INIT-INSTANT according to the spec [6bdb2dd3] + + Build system: + + Reworked REPL tests [be4d57de][338a0972][7c8a2739][f8edb829][1ce3a36d] + + Various changes related to v6.d prep [7d830d5c][6cb810d2][36bc8e2d] + [31cbdada][16f64182][50d2013d][f62950dc][dd8a6102] + [36122f15][2a512f0c][03b1febc][edce8f53][c6ff787a] + + Efficiency: + + Made startup time up to 5 ms faster [48406db6][a09f5f21][bb5583ae] + + Made chained ops up to 36x faster [a92d0369] + + Made ≥, ≤, and ≠ unicode ops as fast as ascii equivalents + [6ec21cb4][1af2a745][43c348a8][9ff2f98f] + + Made &inifx: with Version:Ds 7.2x faster [1d9553f0] + + Made &DEPRECATED 27% faster when vfrom is too large [145e3156] + + Made Blob.gist 26x faster [20a99fc3] + + Made Hash.gist 24% faster [69af24c4] + + Made @a[42..*] 4.2x faster [456358e3] + + Various NativeCall speedups [a06ebaf2][269fe7db][80d6b425] + + Other small optimizations [9d4a833b][6902c590][fb4eb666] + [b9c98531][4fae0711][921db910][c91c4011][98fae3d8] + [a462d0a2][16c2a157][5f6896bd][397692ac][476741e7] + + Internal: + + New JIT [2724a851][ff063e7b] + + Better scheduler [d2eb7423][80b49320][340d8ed3][c50d35a9][9af5607d] + [683037be][7c18112c][c285b489][b5605c2d][3b98fb9e][596611c8] + + Added RAKUDO_SCHEDULER_DEBUG_STATUS env var [de311f46] + + Significantly faster INTERPOLATE [1761540e][0a68a18f][d73d500b] + [1775259a][e8003c87][4d3ccd83][04b171bd][317ae16c][dd880cad] + + Bumped libuv to the latest version [198b8497] + + Reworked BUILDALL method autogeneration [9837687d][63cf246f] + [5ad2fffe][31a03a41][eb9c3d4d][346dfeff][70ca505a][af2ab751] + [5cd9197f][6824e192][7363f898][4959df3f][dd943ede][d3c48185] + [371befe8][4d0ead24][92f239b5][7fa707db][d76af6aa][e513b857] + [f80a8461][fcbd8adb][21788c89][e2f8a57d][b58bd8fb][0dd6af71] + [f946bd35][cef3bf3e][92e51c3d][5144216f][ebd6440c] + New in 2017.09: + Fixes: + Fixed NativeCall signature check for unsupported native types [4077842c] From 7cf5ce7efef63e66256485a836e20847b8d3fc39 Mon Sep 17 00:00:00 2001 From: Aleks-Daniel Jakimenko-Aleksejev Date: Sat, 21 Oct 2017 06:42:11 +0300 Subject: [PATCH 522/692] Log more commits and tweak some things (Zoffix++) Deliberately not logged: e0dabaca 5cd7c728 527b8881 44e69a67 37c0c497 57de65fc f980cdaf d20e972a 1e5d6f0d 7a2561c2 6726d4af --- docs/ChangeLog | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/docs/ChangeLog b/docs/ChangeLog index 0bbe0fd0a50..9747b7f7399 100644 --- a/docs/ChangeLog +++ b/docs/ChangeLog @@ -32,7 +32,7 @@ New in 2017.10: [39461368][381c4c3b] + Fixed explosion in IO::CatHandle.nl-out [83008443] + Fixed .pick and .roll on object hashes [12fcece4] - + Fixed cmp-ok() to take `=:=` op as comparator [3684384d] + + Made cmp-ok take its arguments raw [3684384d] + Fixed `is default(Mu)` on attributes [54507ac9] + Made Array.List fill holes with Nil [e1351219] + Fixed BagHash.grab with large values [975fcf6c] @@ -49,13 +49,16 @@ New in 2017.10: [c46de00f][e5c17462][6e42b37e][80f883bc] + Various fixes and improvements to hyper/race [cc2a0643][2352efe5] [d43b3738][dfa230f7][1fdc84fe][cef4806f][ea51d19b][374ee3e2] - [ad0dd8e7][41729e93][d74ba041][83676112][2580a0a6] + [ad0dd8e7][41729e93][d74ba041][83676112][2580a0a6][cf1673d9] + [7e9b9633][870eaa31][d37a19ea][da977785][270e7c8a][ee3f0f4f] + Various improvements to warnings and error reporting [38186fcd] [cf95ce81][66c2d05f][a845ac3d][48a84d6a][bb45791c][279bae08] [6542bb80][5747bc71][c7a82d45][fb7abf06][ac97a401][64b001a1] [1ea3297b][56eef696][25c87d0d][5d3ebc09][de2b9ff7][084078e1] [3acde358][b3bb8c40][e611978f][12774237][33e113a2] + Additions: + + Improved .Capture semantics on all core types [4ba12ff1] + [bad9fefd][cd5864cf] + Added trim* subroutines to Cool instance [5a19dffa][691f8b7b][e01e5bc3] + Added Lock::Async [53dd776c][4a8038c2][85bdd38a][38896402][6170cb9d] + Added atomic reference op support on JVM backend [32e4a1de][59c4117f] @@ -67,10 +70,9 @@ New in 2017.10: [5c7bbea0][93e599db][de0533c4] + Implemented typed pointer increment and array dereference [3ca6554f][bc5fbfcb][2fba0ba0] - + Added X::Cannot::Capture exception type [4ba12ff1][bad9fefd][cd5864cf] + Added X::Numeric::CannotConvert exception type [2e726528] [b377de1c][f04bd1d6] - + Added IO::Handle.out-buffer for controlling the buffer size [f9c10c21] + + Added IO::Handle.out-buffer for controlling the buffer size [f9c10c21][765dd694] + Added IO::Path.parent(Int) for getting up more than one level [7bea3a2d] + Removals: + Removed $*MAIN-ALLOW-NAMED-ANYWHERE [9cb4b167] From fece49cf06fd0c8bf8b6a7013abee14497e478a7 Mon Sep 17 00:00:00 2001 From: Aleks-Daniel Jakimenko-Aleksejev Date: Sat, 21 Oct 2017 15:11:01 +0300 Subject: [PATCH 523/692] ChangeLog tweak --- docs/ChangeLog | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/ChangeLog b/docs/ChangeLog index 9747b7f7399..0d3473b9954 100644 --- a/docs/ChangeLog +++ b/docs/ChangeLog @@ -12,7 +12,7 @@ New in 2017.10: + Fixes: + Fixed Hash.perl to include Scalar indicators [47d6c66e] + Fixed :delete with lazy Arrays [0385b2aa] - + Fixed serial/sanitry for on-demand Supplies [93a66d75] + + Fixed sanitization of on-demand Supplies [93a66d75] + Fixed duplicate done/quit messages [9e179355] + Fixed non-blocking `react { await blah() }` [29863a0b] + Fixed issues with Int.new [dff7d9b2][0d2ca0d7][0834036d] From 312cac7869f3e5d61de0380a558a90bd17728fbc Mon Sep 17 00:00:00 2001 From: Aleks-Daniel Jakimenko-Aleksejev Date: Sat, 21 Oct 2017 15:20:54 +0300 Subject: [PATCH 524/692] More ChangeLog tweaks timotimo++ MasterDuke++ --- docs/ChangeLog | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/docs/ChangeLog b/docs/ChangeLog index 0d3473b9954..8386631a76c 100644 --- a/docs/ChangeLog +++ b/docs/ChangeLog @@ -2,7 +2,7 @@ New in 2017.10: + SPECIAL NOTES: + This release includes fixes to || alternation in :ratchet mode. Code that was unintentionally relying on buggy behavior - (backtracking in :ratched mode) may now produce unwanted + (backtracking in :ratchet mode) may now produce unwanted results (namely will fail to match) [963a0f06] + Security: + Restricted dynamic lookup metasyntax in rx EVAL [1d63dfd2][2448195d] @@ -94,6 +94,8 @@ New in 2017.10: + Made Hash.gist 24% faster [69af24c4] + Made @a[42..*] 4.2x faster [456358e3] + Various NativeCall speedups [a06ebaf2][269fe7db][80d6b425] + + Significantly faster INTERPOLATE [1761540e][0a68a18f][d73d500b] + [1775259a][e8003c87][4d3ccd83][04b171bd][317ae16c][dd880cad] + Other small optimizations [9d4a833b][6902c590][fb4eb666] [b9c98531][4fae0711][921db910][c91c4011][98fae3d8] [a462d0a2][16c2a157][5f6896bd][397692ac][476741e7] @@ -102,8 +104,6 @@ New in 2017.10: + Better scheduler [d2eb7423][80b49320][340d8ed3][c50d35a9][9af5607d] [683037be][7c18112c][c285b489][b5605c2d][3b98fb9e][596611c8] + Added RAKUDO_SCHEDULER_DEBUG_STATUS env var [de311f46] - + Significantly faster INTERPOLATE [1761540e][0a68a18f][d73d500b] - [1775259a][e8003c87][4d3ccd83][04b171bd][317ae16c][dd880cad] + Bumped libuv to the latest version [198b8497] + Reworked BUILDALL method autogeneration [9837687d][63cf246f] [5ad2fffe][31a03a41][eb9c3d4d][346dfeff][70ca505a][af2ab751] From 738908be4d79f1472821cd363ec82a1ef0bc3f32 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 21 Oct 2017 11:18:19 -0400 Subject: [PATCH 525/692] "Do. Or do not. There is no try." MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Fixes RT#126721: https://rt.perl.org/Ticket/Display.html?id=126721 Do not silence errors when failing to assign to $/ as that introduces action-at-a-distance bugs that can be very hard to debug: m: put "Foo".subst: /(Foo)/, {uc $/[0] } rakudo-moar 312cac786: OUTPUT: «FOO␤» If we now simply move that working code to someplace with a readonly $/ the code will silently fail and produce incorrect result: m: grammar { token TOP {(.+)} }.parse: 'bar', actions => class { method TOP ($/) { put "Foo".subst: /(Foo)/, {uc $/[0] } } } rakudo-moar 312cac786: OUTPUT: «BAR␤» --- src/core/Str.pm | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/core/Str.pm b/src/core/Str.pm index 852466b9437..1a955940e80 100644 --- a/src/core/Str.pm +++ b/src/core/Str.pm @@ -1096,7 +1096,7 @@ my class Str does Stringy { # declared in BOOTSTRAP my $SET_DOLLAR_SLASH = nqp::istype($matcher, Regex); my $word_by_word = so $samespace || %options || %options; - try $caller_dollar_slash = $/ if $SET_DOLLAR_SLASH; + $caller_dollar_slash = $/ if $SET_DOLLAR_SLASH; my @matches = %options ?? self.match($matcher, |%options) !! self.match($matcher); # 30% faster @@ -1169,7 +1169,7 @@ my class Str does Stringy { # declared in BOOTSTRAP my $word_by_word = so $samespace || %options || %options; # nothing to do - try caller_dollar_slash = $/ if $SET_DOLLAR_SLASH; + caller_dollar_slash = $/ if $SET_DOLLAR_SLASH; my @matches = %options ?? self.match($matcher, :$g, |%options) !! self.match($matcher, :$g); # 30% faster @@ -1196,7 +1196,7 @@ my class Str does Stringy { # declared in BOOTSTRAP my int $prev; my str $str = nqp::unbox_s(self); my Mu $result := nqp::list_s(); - try cds = $/ if SDS; + cds = $/ if SDS; # need to do something special if SDS || space || case || mark || callable { @@ -1205,7 +1205,7 @@ my class Str does Stringy { # declared in BOOTSTRAP my \case-and-mark := case && mark; for flat matches -> $m { - try cds = $m if SDS; + cds = $m if SDS; nqp::push_s( $result,nqp::substr($str,$prev,nqp::unbox_i($m.from) - $prev) ); From ba718f4581a95e143147a47f26a2bc96e9b6b076 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 21 Oct 2017 13:41:54 -0400 Subject: [PATCH 526/692] Fix parsing of custom named pod blocks Fixes RT#132339: https://rt.perl.org/Ticket/Display.html?id=132339 We fixed[^1] ratchet getting disabled in `||` alternations, so here we enable it back where it's needed. [1] https://github.com/rakudo/rakudo/commit/963a0f0657abaa0431d465e601c75 --- src/Perl6/Grammar.nqp | 27 ++++++++++++++++----------- 1 file changed, 16 insertions(+), 11 deletions(-) diff --git a/src/Perl6/Grammar.nqp b/src/Perl6/Grammar.nqp index c18cb0c1f17..d406e5c27f0 100644 --- a/src/Perl6/Grammar.nqp +++ b/src/Perl6/Grammar.nqp @@ -914,7 +914,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD { ] } - token pod_block:sym { + regex pod_block:sym { ^^ $ = [ \h* ] '=begin' @@ -1011,12 +1011,15 @@ grammar Perl6::Grammar is HLL::Grammar does STD { $*VMARGIN := $.to - $.from; } :my $*ALLOW_INLINE_CODE := 0; - $ = [ - { $*ALLOW_INLINE_CODE := 1 } - || + [ :!ratchet + $ = [ + { $*ALLOW_INLINE_CODE := 1 } + || + ] + :my $*POD_ALLOW_FCODES := nqp::getlexdyn('$*POD_ALLOW_FCODES'); + )> + ] - :my $*POD_ALLOW_FCODES := nqp::getlexdyn('$*POD_ALLOW_FCODES'); - )> **0..1 } @@ -1056,12 +1059,14 @@ grammar Perl6::Grammar is HLL::Grammar does STD { $*VMARGIN := $.to - $.from; } :my $*ALLOW_INLINE_CODE := 0; - $ = [ - { $*ALLOW_INLINE_CODE := 1 } - || + [ :!ratchet + $ = [ + { $*ALLOW_INLINE_CODE := 1 } + || + ] + :my $*POD_ALLOW_FCODES := nqp::getlexdyn('$*POD_ALLOW_FCODES'); + [\h*\n|\h+] ] - :my $*POD_ALLOW_FCODES := nqp::getlexdyn('$*POD_ALLOW_FCODES'); - [\h*\n|\h+] **0..1 } From 9a13759813043aef1510a13f04877bda80cc4796 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sat, 21 Oct 2017 20:55:38 +0200 Subject: [PATCH 527/692] Small fixes to ChangeLog --- docs/ChangeLog | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/docs/ChangeLog b/docs/ChangeLog index 8386631a76c..6d16aacd551 100644 --- a/docs/ChangeLog +++ b/docs/ChangeLog @@ -59,7 +59,7 @@ New in 2017.10: + Additions: + Improved .Capture semantics on all core types [4ba12ff1] [bad9fefd][cd5864cf] - + Added trim* subroutines to Cool instance [5a19dffa][691f8b7b][e01e5bc3] + + Added trim* subroutines taking Cool instance [5a19dffa][691f8b7b][e01e5bc3] + Added Lock::Async [53dd776c][4a8038c2][85bdd38a][38896402][6170cb9d] + Added atomic reference op support on JVM backend [32e4a1de][59c4117f] + Added $*USAGE [0b15f672] @@ -88,7 +88,7 @@ New in 2017.10: + Made chained ops up to 36x faster [a92d0369] + Made ≥, ≤, and ≠ unicode ops as fast as ascii equivalents [6ec21cb4][1af2a745][43c348a8][9ff2f98f] - + Made &inifx: with Version:Ds 7.2x faster [1d9553f0] + + Made &infix: with Version:Ds 7.2x faster [1d9553f0] + Made &DEPRECATED 27% faster when vfrom is too large [145e3156] + Made Blob.gist 26x faster [20a99fc3] + Made Hash.gist 24% faster [69af24c4] From 78d8d50995aefbb8a47f57cba03b6c2f05d038f6 Mon Sep 17 00:00:00 2001 From: Samantha McVey Date: Sat, 21 Oct 2017 15:30:35 -0700 Subject: [PATCH 528/692] Use UInt signature for .parent($depth) Instead of having a die inside of the function, change the signature so only positive integers are accepted. --- src/core/IO/Path.pm | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/core/IO/Path.pm b/src/core/IO/Path.pm index bbf75d63872..73622916080 100644 --- a/src/core/IO/Path.pm +++ b/src/core/IO/Path.pm @@ -327,9 +327,7 @@ my class IO::Path is Cool does IO { IO::Path!new-from-absolute-path($resolved,:$!SPEC,:CWD($sep)); } proto method parent(|) { * } - multi method parent(IO::Path:D: Int:D $depth) { - die "method parent(IO::Path:D: Int:D) can only be called with non-negative integers" - if $depth < 0; + multi method parent(IO::Path:D: UInt:D $depth) { my $io = self; $io .= parent xx $depth; $io; From 2262cc477c4b37a969300d502b1509462f7337fe Mon Sep 17 00:00:00 2001 From: usev6 Date: Sun, 22 Oct 2017 08:38:48 +0200 Subject: [PATCH 529/692] Fix JVM build (re-add removed sigil to 'match') The sigils have been removed (unintentionally, for sure) with commit dd880cad42. Because this code was part of a '#? if !moar' branch, it didn't explode while building Moar. --- src/core/Match.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/Match.pm b/src/core/Match.pm index c8ea99f6c62..8befc67abad 100644 --- a/src/core/Match.pm +++ b/src/core/Match.pm @@ -611,12 +611,12 @@ my class Match is Capture is Cool does NQPMatchRole { ); } - match = nqp::iseq_i($k,$len); # match if completed + $match = nqp::iseq_i($k,$len); # match if completed } # ignorecase else { - match = nqp::iseq_s( + $match = nqp::iseq_s( nqp::fc(nqp::substr($tgt, $pos, $len)), nqp::fc($topic_str) ) From 7277aa5470cc89a27c091a8edeb8d825c33d708e Mon Sep 17 00:00:00 2001 From: Aleks-Daniel Jakimenko-Aleksejev Date: Sun, 22 Oct 2017 10:05:12 +0300 Subject: [PATCH 530/692] Pre-release NQP_REVISION bump --- tools/build/NQP_REVISION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/build/NQP_REVISION b/tools/build/NQP_REVISION index 852aaab47df..71d4b4c4baa 100644 --- a/tools/build/NQP_REVISION +++ b/tools/build/NQP_REVISION @@ -1 +1 @@ -2017.09-116-g252fd89 +2017.09-119-g4494e7049 From d10d6977480fd6146c2db307a18ff0e657db8e54 Mon Sep 17 00:00:00 2001 From: Aleks-Daniel Jakimenko-Aleksejev Date: Sun, 22 Oct 2017 10:09:56 +0300 Subject: [PATCH 531/692] More ChangeLog tweaks Deliberately not logged: 7cf5ce7e fece49cf 312cac78 9a137598 ba718f45 --- docs/ChangeLog | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/docs/ChangeLog b/docs/ChangeLog index 6d16aacd551..80f5f79a3cf 100644 --- a/docs/ChangeLog +++ b/docs/ChangeLog @@ -59,7 +59,8 @@ New in 2017.10: + Additions: + Improved .Capture semantics on all core types [4ba12ff1] [bad9fefd][cd5864cf] - + Added trim* subroutines taking Cool instance [5a19dffa][691f8b7b][e01e5bc3] + + Added trim* subroutines taking Cool instance [5a19dffa] + [691f8b7b][e01e5bc3] + Added Lock::Async [53dd776c][4a8038c2][85bdd38a][38896402][6170cb9d] + Added atomic reference op support on JVM backend [32e4a1de][59c4117f] + Added $*USAGE [0b15f672] @@ -72,8 +73,10 @@ New in 2017.10: [3ca6554f][bc5fbfcb][2fba0ba0] + Added X::Numeric::CannotConvert exception type [2e726528] [b377de1c][f04bd1d6] - + Added IO::Handle.out-buffer for controlling the buffer size [f9c10c21][765dd694] - + Added IO::Path.parent(Int) for getting up more than one level [7bea3a2d] + + Added IO::Handle.out-buffer for controlling the buffer size + [f9c10c21][765dd694] + + Added IO::Path.parent(Int) for getting up more than one level + [7bea3a2d][78d8d509] + Removals: + Removed $*MAIN-ALLOW-NAMED-ANYWHERE [9cb4b167] + Removed support for ornate parenthesis from quoting constructs [9ce896d8] @@ -94,8 +97,9 @@ New in 2017.10: + Made Hash.gist 24% faster [69af24c4] + Made @a[42..*] 4.2x faster [456358e3] + Various NativeCall speedups [a06ebaf2][269fe7db][80d6b425] - + Significantly faster INTERPOLATE [1761540e][0a68a18f][d73d500b] - [1775259a][e8003c87][4d3ccd83][04b171bd][317ae16c][dd880cad] + + Significantly faster interpolation of variables into regexes + [1761540e][0a68a18f][d73d500b][1775259a][e8003c87] + [4d3ccd83][04b171bd][317ae16c][dd880cad][2262cc47] + Other small optimizations [9d4a833b][6902c590][fb4eb666] [b9c98531][4fae0711][921db910][c91c4011][98fae3d8] [a462d0a2][16c2a157][5f6896bd][397692ac][476741e7] From a042fd927c672cc2bf6d186e2d40f3ae69d88b86 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sun, 22 Oct 2017 14:01:59 +0200 Subject: [PATCH 532/692] Make phasers in hyper/race throw an NYI Which will allow us to shake out the semantics of phasers like LAST until the next release, without getting code out there that may depend on the current semantics (which will probably change) --- src/core/Rakudo/Internals/HyperRaceSharedImpl.pm | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/core/Rakudo/Internals/HyperRaceSharedImpl.pm b/src/core/Rakudo/Internals/HyperRaceSharedImpl.pm index 7f65ccdb337..b494c9ef23d 100644 --- a/src/core/Rakudo/Internals/HyperRaceSharedImpl.pm +++ b/src/core/Rakudo/Internals/HyperRaceSharedImpl.pm @@ -46,6 +46,9 @@ class Rakudo::Internals::HyperRaceSharedImpl { } } multi method grep(\hyper, $source, &matcher, %options) { + X::NYI.new(feature => 'Phasers in hyper/race').throw + if nqp::istype(&matcher,Block) && &matcher.has-phasers; + if %options || &matcher.count > 1 { # Fall back to sequential grep for cases we can't yet handle self.rehyper(hyper, hyper.Any::grep(&matcher, |%options)) @@ -77,6 +80,9 @@ class Rakudo::Internals::HyperRaceSharedImpl { } } multi method map(\hyper, $source, &mapper, %options) { + X::NYI.new(feature => 'Phasers in hyper/race').throw + if nqp::istype(&mapper,Block) && &mapper.has-phasers; + if %options || &mapper.count > 1 { # Fall back to sequential map for cases we can't yet handle self.rehyper(hyper, hyper.Any::map(&mapper, |%options)) From 6ad06fad9f6f136b28c83172f7971826ef2846a8 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sun, 22 Oct 2017 11:16:28 -0400 Subject: [PATCH 533/692] =?UTF-8?q?Make=20=E2=89=A4,=20=E2=89=A5,=20and=20?= =?UTF-8?q?=E2=89=A0=20work=20like=20ASCII=20versions?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Fixes RT#132346: https://rt.perl.org/Ticket/Display.html?id=132346 Alt Fix for RT#131626: https://rt.perl.org/Ticket/Display.html?id=131626 The previous fix did not catch all the cases even with core ops and did not (on purpose) resolve issues when user defined their own versions of ASCII ops. So in some cases we still had up to 86x slowdown In addition, when the Unicode ops are used, it seems something in the optimizer doesn't handle things right and the variant with a Junction behaves as a normal op and not as a negated op (negated ops junct the non-negated version and then `not` it). --- src/Perl6/Grammar.nqp | 2 +- src/Perl6/Optimizer.nqp | 19 ------------------- src/core/Date.pm | 6 ++++++ src/core/DateTime.pm | 9 +++++++++ src/core/Instant.pm | 9 +++++++++ src/core/Int.pm | 17 ++++++++++++++--- src/core/Num.pm | 15 +++++++++++++++ src/core/Numeric.pm | 27 +++++++++++++++++---------- src/core/Rat.pm | 18 ++++++++++++++++++ src/core/Real.pm | 2 ++ src/core/Version.pm | 3 +++ 11 files changed, 94 insertions(+), 33 deletions(-) diff --git a/src/Perl6/Grammar.nqp b/src/Perl6/Grammar.nqp index d406e5c27f0..b58b684e3eb 100644 --- a/src/Perl6/Grammar.nqp +++ b/src/Perl6/Grammar.nqp @@ -4648,7 +4648,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD { if $categorical { # Does it look like a metaop? my $cat := ~$categorical[0][0]; my $op := ~$categorical[0][1]; - return self if $op eq '!='; + return self if $op eq '!=' || $op eq '≠'; my $lang := self.'!cursor_init'($op, :p(0), :actions($actions)); $lang.clone_braid_from(self); my $meth := $cat eq 'infix' || $cat eq 'prefix' || $cat eq 'postfix' ?? $cat ~ 'ish' !! $cat; diff --git a/src/Perl6/Optimizer.nqp b/src/Perl6/Optimizer.nqp index 15aeab0f61c..eb061b2e946 100644 --- a/src/Perl6/Optimizer.nqp +++ b/src/Perl6/Optimizer.nqp @@ -1376,23 +1376,6 @@ class Perl6::Optimizer { } } - method convert_unicode_op_to_ascii($op) { - sub asciify-to ($to) { - try { - # this method reifies lazy symbol's values, and the value - # is then looked at by the is_from_core method. - $!symbols.find_lexical($to); # dies if can't find - $!symbols.is_from_core($to) && $op.name: $to - } - } - - if $!symbols.is_from_core: my $name := $op.name { - if ($name eq '&infix:<≤>') { asciify-to('&infix:«<=»') } - elsif ($name eq '&infix:<≥>') { asciify-to('&infix:«>=»') } - elsif ($name eq '&infix:<≠>') { asciify-to('&infix:') } - } - } - method optimize_call($op) { # See if we can find the thing we're going to call. my $obj; @@ -1405,8 +1388,6 @@ class Perl6::Optimizer { } if $found { - self.convert_unicode_op_to_ascii($op); - # Pure operators can be constant folded. if nqp::can($obj, 'is-pure') { # First ensure we're not in void context; warn if so. diff --git a/src/core/Date.pm b/src/core/Date.pm index 04ad0b7f9e7..e0ba0735f9e 100644 --- a/src/core/Date.pm +++ b/src/core/Date.pm @@ -187,12 +187,18 @@ multi sub infix:<==>(Date:D $a, Date:D $b) { multi sub infix:«<=»(Date:D $a, Date:D $b) { $a.daycount <= $b.daycount } +multi sub infix:«≤»(Date:D $a, Date:D $b) { + $a.daycount ≤ $b.daycount +} multi sub infix:«<»(Date:D $a, Date:D $b) { $a.daycount < $b.daycount } multi sub infix:«>=»(Date:D $a, Date:D $b) { $a.daycount >= $b.daycount } +multi sub infix:«≥»(Date:D $a, Date:D $b) { + $a.daycount ≥ $b.daycount +} multi sub infix:«>»(Date:D $a, Date:D $b) { $a.daycount > $b.daycount } diff --git a/src/core/DateTime.pm b/src/core/DateTime.pm index b38a1711cba..3d8188a70ca 100644 --- a/src/core/DateTime.pm +++ b/src/core/DateTime.pm @@ -392,15 +392,24 @@ multi sub infix:«>»(DateTime:D \a, DateTime:D \b) { multi sub infix:«<=»(DateTime:D \a, DateTime:D \b) { a.Instant <= b.Instant } +multi sub infix:«≤»(DateTime:D \a, DateTime:D \b) { + a.Instant ≤ b.Instant +} multi sub infix:«>=»(DateTime:D \a, DateTime:D \b) { a.Instant >= b.Instant } +multi sub infix:«≥»(DateTime:D \a, DateTime:D \b) { + a.Instant ≥ b.Instant +} multi sub infix:«==»(DateTime:D \a, DateTime:D \b) { a.Instant == b.Instant } multi sub infix:«!=»(DateTime:D \a, DateTime:D \b) { a.Instant != b.Instant } +multi sub infix:«≠»(DateTime:D \a, DateTime:D \b) { + a.Instant ≠ b.Instant +} multi sub infix:«<=>»(DateTime:D \a, DateTime:D \b) { a.Instant <=> b.Instant } diff --git a/src/core/Instant.pm b/src/core/Instant.pm index 682183e4019..7d929be2814 100644 --- a/src/core/Instant.pm +++ b/src/core/Instant.pm @@ -71,6 +71,9 @@ multi sub infix:«==»(Instant:D $a, Instant:D $b) { multi sub infix:«!=»(Instant:D $a, Instant:D $b) { $a.tai != $b.tai } +multi sub infix:«≠»(Instant:D $a, Instant:D $b) { + $a.tai ≠ $b.tai +} multi sub infix:«<»(Instant:D $a, Instant:D $b) { $a.tai < $b.tai @@ -83,10 +86,16 @@ multi sub infix:«>»(Instant:D $a, Instant:D $b) { multi sub infix:«<=»(Instant:D $a, Instant:D $b) { $a.tai <= $b.tai } +multi sub infix:«≤»(Instant:D $a, Instant:D $b) { + $a.tai ≤ $b.tai +} multi sub infix:«>=»(Instant:D $a, Instant:D $b) { $a.tai >= $b.tai } +multi sub infix:«≥»(Instant:D $a, Instant:D $b) { + $a.tai ≥ $b.tai +} multi sub infix:<+>(Instant:D $a, Real:D $b) { nqp::create(Instant).SET-SELF($a.tai + $b.Rat) diff --git a/src/core/Int.pm b/src/core/Int.pm index e2cf598f196..0acb98be694 100644 --- a/src/core/Int.pm +++ b/src/core/Int.pm @@ -351,9 +351,8 @@ multi sub infix:<==>(int $a, int $b) { nqp::p6bool(nqp::iseq_i($a, $b)) } -multi sub infix:(int $a, int $b) { - nqp::p6bool(nqp::isne_i($a, $b)) -} +multi sub infix:(int $a, int $b) { nqp::p6bool(nqp::isne_i($a, $b)) } +multi sub infix:<≠> (int $a, int $b) { nqp::p6bool(nqp::isne_i($a, $b)) } multi sub infix:«<»(Int:D \a, Int:D \b) { nqp::p6bool(nqp::islt_I(nqp::decont(a), nqp::decont(b))) @@ -368,6 +367,12 @@ multi sub infix:«<=»(Int:D \a, Int:D \b) { multi sub infix:«<=»(int $a, int $b) { nqp::p6bool(nqp::isle_i($a, $b)) } +multi sub infix:«≤»(Int:D \a, Int:D \b) { + nqp::p6bool(nqp::isle_I(nqp::decont(a), nqp::decont(b))) +} +multi sub infix:«≤»(int $a, int $b) { + nqp::p6bool(nqp::isle_i($a, $b)) +} multi sub infix:«>»(Int:D \a, Int:D \b) { nqp::p6bool(nqp::isgt_I(nqp::decont(a), nqp::decont(b))) @@ -382,6 +387,12 @@ multi sub infix:«>=»(Int:D \a, Int:D \b) { multi sub infix:«>=»(int $a, int $b) { nqp::p6bool(nqp::isge_i($a, $b)) } +multi sub infix:«≥»(Int:D \a, Int:D \b) { + nqp::p6bool(nqp::isge_I(nqp::decont(a), nqp::decont(b))) +} +multi sub infix:«≥»(int $a, int $b) { + nqp::p6bool(nqp::isge_i($a, $b)) +} multi sub infix:<+|>(Int:D \a, Int:D \b) { nqp::bitor_I(nqp::decont(a), nqp::decont(b), Int) diff --git a/src/core/Num.pm b/src/core/Num.pm index 455346a75e9..1738b39d9d5 100644 --- a/src/core/Num.pm +++ b/src/core/Num.pm @@ -461,6 +461,9 @@ multi sub infix:<==>(num $a, num $b --> Bool:D) { multi sub infix:(num $a, num $b --> Bool:D) { nqp::p6bool(nqp::isne_n($a, $b)) } +multi sub infix:<≠>(num $a, num $b --> Bool:D) { + nqp::p6bool(nqp::isne_n($a, $b)) +} multi sub infix:«<»(Num:D \a, Num:D \b --> Bool:D) { nqp::p6bool(nqp::islt_n(nqp::unbox_n(a), nqp::unbox_n(b))) @@ -475,6 +478,12 @@ multi sub infix:«<=»(Num:D \a, Num:D \b --> Bool:D) { multi sub infix:«<=»(num $a, num $b --> Bool:D) { nqp::p6bool(nqp::isle_n($a, $b)) } +multi sub infix:«≤»(Num:D \a, Num:D \b --> Bool:D) { + nqp::p6bool(nqp::isle_n(nqp::unbox_n(a), nqp::unbox_n(b))) +} +multi sub infix:«≤»(num $a, num $b --> Bool:D) { + nqp::p6bool(nqp::isle_n($a, $b)) +} multi sub infix:«>»(Num:D \a, Num:D \b --> Bool:D) { nqp::p6bool(nqp::isgt_n(nqp::unbox_n(a), nqp::unbox_n(b))) @@ -489,6 +498,12 @@ multi sub infix:«>=»(Num:D \a, Num:D \b --> Bool:D) { multi sub infix:«>=»(num $a, num $b --> Bool:D) { nqp::p6bool(nqp::isge_n($a, $b)) } +multi sub infix:«≥»(Num:D \a, Num:D \b --> Bool:D) { + nqp::p6bool(nqp::isge_n(nqp::unbox_n(a), nqp::unbox_n(b))) +} +multi sub infix:«≥»(num $a, num $b --> Bool:D) { + nqp::p6bool(nqp::isge_n($a, $b)) +} sub rand(--> Num:D) { nqp::p6box_n(nqp::rand_n(1e0)); diff --git a/src/core/Numeric.pm b/src/core/Numeric.pm index b0e2233c734..49568ab78cb 100644 --- a/src/core/Numeric.pm +++ b/src/core/Numeric.pm @@ -287,27 +287,34 @@ multi sub infix:<≅>(\a, \b, :$tolerance = $*TOLERANCE) { sub infix:<=~=>(|c) { infix:<≅>(|c) } proto sub infix:(Mu $?, Mu $?) is pure { * } -multi sub infix:($?) { Bool::True } -multi sub infix:(Mu \a, Mu \b) { not a == b } -sub infix:<≠>(|c) is pure { infix:(|c) } +multi sub infix:($?) { Bool::True } +multi sub infix:(Mu \a, Mu \b) { not a == b } +proto sub infix:<≠> (Mu $?, Mu $?) is pure { * } +multi sub infix:<≠> ($?) { Bool::True } +multi sub infix:<≠> (Mu \a, Mu \b) { not a == b } proto sub infix:«<»(Mu $?, Mu $?) is pure { * } multi sub infix:«<»($?) { Bool::True } multi sub infix:«<»(\a, \b) { a.Real < b.Real } -proto sub infix:«<=»(Mu $?, Mu $?) is pure { * } -multi sub infix:«<=»($?) { Bool::True } -multi sub infix:«<=»(\a, \b) { a.Real <= b.Real } -sub infix:«≤»(|c) is pure { infix:«<=»(|c) } +proto sub infix:«<=»(Mu $?, Mu $?) is pure { * } +multi sub infix:«<=»($?) { Bool::True } +multi sub infix:«<=»(\a, \b) { a.Real <= b.Real } +proto sub infix:«≤» (Mu $?, Mu $?) is pure { * } +multi sub infix:«≤» ($?) { Bool::True } +multi sub infix:«≤» (\a, \b) { a.Real ≤ b.Real } proto sub infix:«>»(Mu $?, Mu $?) is pure { * } multi sub infix:«>»($?) { Bool::True } multi sub infix:«>»(\a, \b) { a.Real > b.Real } proto sub infix:«>=»(Mu $?, Mu $?) is pure { * } -multi sub infix:«>=»($?) { Bool::True } -multi sub infix:«>=»(\a, \b) { a.Real >= b.Real } -sub infix:«≥»(|c) is pure { infix:«>=»(|c) } +multi sub infix:«>=»($?) { Bool::True } +multi sub infix:«>=»(\a, \b) { a.Real >= b.Real } +proto sub infix:«≥» (Mu $?, Mu $?) is pure { * } +multi sub infix:«≥» ($?) { Bool::True } +multi sub infix:«≥» (\a, \b) { a.Real ≥ b.Real } + ## bitwise operators diff --git a/src/core/Rat.pm b/src/core/Rat.pm index f96ff0c1c44..c6426a5d741 100644 --- a/src/core/Rat.pm +++ b/src/core/Rat.pm @@ -265,6 +265,15 @@ multi sub infix:«<=»(Rational:D \a, Int:D \b) { multi sub infix:«<=»(Int:D \a, Rational:D \b) { a * b.denominator <= b.numerator } +multi sub infix:«≤»(Rational:D \a, Rational:D \b) { + a.numerator * b.denominator ≤ b.numerator * a.denominator +} +multi sub infix:«≤»(Rational:D \a, Int:D \b) { + a.numerator ≤ b * a.denominator +} +multi sub infix:«≤»(Int:D \a, Rational:D \b) { + a * b.denominator ≤ b.numerator +} multi sub infix:«>»(Rational:D \a, Rational:D \b) { a.numerator * b.denominator > b.numerator * a.denominator @@ -285,6 +294,15 @@ multi sub infix:«>=»(Rational:D \a, Int:D \b) { multi sub infix:«>=»(Int:D \a, Rational:D \b) { a * b.denominator >= b.numerator } +multi sub infix:«≥»(Rational:D \a, Rational:D \b) { + a.numerator * b.denominator ≥ b.numerator * a.denominator +} +multi sub infix:«≥»(Rational:D \a, Int:D \b) { + a.numerator ≥ b * a.denominator +} +multi sub infix:«≥»(Int:D \a, Rational:D \b) { + a * b.denominator ≥ b.numerator +} multi sub infix:«<=>»(Rational:D \a, Rational:D \b) { a.numerator * b.denominator <=> b.numerator * a.denominator diff --git a/src/core/Real.pm b/src/core/Real.pm index f304a046730..38087020100 100644 --- a/src/core/Real.pm +++ b/src/core/Real.pm @@ -149,10 +149,12 @@ multi sub infix:<==>(Real \a, Real \b) { a.Bridge == b.Bridge } multi sub infix:«<»(Real \a, Real \b) { a.Bridge < b.Bridge } multi sub infix:«<=»(Real \a, Real \b) { a.Bridge <= b.Bridge } +multi sub infix:«≤» (Real \a, Real \b) { a.Bridge ≤ b.Bridge } multi sub infix:«>»(Real \a, Real \b) { a.Bridge > b.Bridge } multi sub infix:«>=»(Real \a, Real \b) { a.Bridge >= b.Bridge } +multi sub infix:«≥» (Real \a, Real \b) { a.Bridge ≥ b.Bridge } multi sub prefix:<->(Real:D \a) { -a.Bridge } diff --git a/src/core/Version.pm b/src/core/Version.pm index 3db78c941a6..20c14d2dedc 100644 --- a/src/core/Version.pm +++ b/src/core/Version.pm @@ -178,9 +178,12 @@ multi sub infix:(Version:D \a, Version:D \b) { multi sub infix:«<=>»(Version:D \a, Version:D \b) { a cmp b } multi sub infix:«<» (Version:D \a, Version:D \b) { a cmp b == Less } multi sub infix:«<=» (Version:D \a, Version:D \b) { a cmp b != More } +multi sub infix:«≤» (Version:D \a, Version:D \b) { a cmp b != More } multi sub infix:«==» (Version:D \a, Version:D \b) { a cmp b == Same } multi sub infix:«!=» (Version:D \a, Version:D \b) { a cmp b != Same } +multi sub infix:«≠» (Version:D \a, Version:D \b) { a cmp b ≠ Same } multi sub infix:«>=» (Version:D \a, Version:D \b) { a cmp b != Less } +multi sub infix:«≥» (Version:D \a, Version:D \b) { a cmp b != Less } multi sub infix:«>» (Version:D \a, Version:D \b) { a cmp b == More } # vim: ft=perl6 expandtab sw=4 From 3f595acfbda26adc856a50859c69bf61a6183169 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Mon, 23 Oct 2017 00:12:15 +0200 Subject: [PATCH 534/692] Add phaser in hyper/race NYI commit to ChangeLog --- docs/ChangeLog | 1 + 1 file changed, 1 insertion(+) diff --git a/docs/ChangeLog b/docs/ChangeLog index 80f5f79a3cf..b9722bc65a2 100644 --- a/docs/ChangeLog +++ b/docs/ChangeLog @@ -51,6 +51,7 @@ New in 2017.10: [d43b3738][dfa230f7][1fdc84fe][cef4806f][ea51d19b][374ee3e2] [ad0dd8e7][41729e93][d74ba041][83676112][2580a0a6][cf1673d9] [7e9b9633][870eaa31][d37a19ea][da977785][270e7c8a][ee3f0f4f] + [a042fd92] + Various improvements to warnings and error reporting [38186fcd] [cf95ce81][66c2d05f][a845ac3d][48a84d6a][bb45791c][279bae08] [6542bb80][5747bc71][c7a82d45][fb7abf06][ac97a401][64b001a1] From 6af44f8d38a02bbd0d68cfd014165d6e33e4d89a Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Mon, 23 Oct 2017 13:12:03 +0200 Subject: [PATCH 535/692] Use a lexical instead of a state var to prevent sinking This was one of the places where the code of https://github.com/rakudo/rakudo/issues/1202 was failing. Since we know that state variables have some racing issues and a state var was not needed here, change it to a lexical to reduce the surface of potential issues. --- src/core/IO/Handle.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/IO/Handle.pm b/src/core/IO/Handle.pm index 4116641ff1c..dc66e518398 100644 --- a/src/core/IO/Handle.pm +++ b/src/core/IO/Handle.pm @@ -732,7 +732,7 @@ my class IO::Handle { nqp::elems(my $buf := self.read-internal(0x100000)), $res.append($buf))), # don't sink result of .close; it might be a failed Proc - nqp::if($close, $ = self.close), + nqp::if($close, my $ = self.close), $res) } From bd6c6403e083d88f3e8988590fa6d6fcd82ff137 Mon Sep 17 00:00:00 2001 From: Aleks-Daniel Jakimenko-Aleksejev Date: Mon, 23 Oct 2017 14:17:11 +0300 Subject: [PATCH 536/692] Fix deprecation date Definitely we cannot remove things from past releases. --- src/core/Instant.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/Instant.pm b/src/core/Instant.pm index 7d929be2814..80b2f8d11e1 100644 --- a/src/core/Instant.pm +++ b/src/core/Instant.pm @@ -133,7 +133,7 @@ Rakudo::Internals.REGISTER-DYNAMIC: '$*INIT-INSTANT', { } Rakudo::Internals.REGISTER-DYNAMIC: '$*INITTIME', { my ($file, $line) = .file, .line with callframe 3; - DEPRECATED('$*INIT-INSTANT', '2017.09.84.gb.02.da.4.d.1.a', '2017.08', + DEPRECATED('$*INIT-INSTANT', '2017.09.84.gb.02.da.4.d.1.a', '2018.08', :what<$*INITTIME>, :$file, :$line); $*INIT-INSTANT } From 50be159f202af55ed7767fc3dfd7ebfeb5888c5c Mon Sep 17 00:00:00 2001 From: Aleks-Daniel Jakimenko-Aleksejev Date: Mon, 23 Oct 2017 15:16:20 +0300 Subject: [PATCH 537/692] Tiny improvements to announcement generation MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This gets the generation in line with my monkey patching for last announcements (no trailing whitespace, more unicode, and Perl 6 with nbsp). --- tools/create-release-announcement.pl6 | 27 ++++++++++++++------------- 1 file changed, 14 insertions(+), 13 deletions(-) diff --git a/tools/create-release-announcement.pl6 b/tools/create-release-announcement.pl6 index dab91f9119b..4aab66ec0d7 100755 --- a/tools/create-release-announcement.pl6 +++ b/tools/create-release-announcement.pl6 @@ -5,12 +5,12 @@ my $template = q:to/END_TEMPLATE/; # Announce: Rakudo Perl 6 compiler, Release #«release-num» («release-name») On behalf of the Rakudo development team, I’m very happy to announce the -«month» «year» release of Rakudo Perl 6 #«release-num». Rakudo is an implementation of -Perl 6 on the Moar Virtual Machine[^1]. +«month» «year» release of Rakudo Perl 6 #«release-num». Rakudo is an implementation of +Perl 6 on the Moar Virtual Machine[^1]. -This release implements the 6.c version of the Perl 6 specifications. +This release implements the 6.c version of the Perl 6 specifications. It includes bugfixes and optimizations on top of -the 2015.12 release of Rakudo, but no new features. +the 2015.12 release of Rakudo. Upcoming releases in 2017 will include new functionality that is not part of the 6.c specification, available with a lexically scoped @@ -21,7 +21,7 @@ spec releases this year as well. The tarball for this release is available from . Please note: This announcement is not for the Rakudo Star -distribution[^2] --- it’s announcing a new release of the compiler +distribution[^2] — it’s announcing a new release of the compiler only. For the latest Rakudo Star release, see . @@ -39,8 +39,8 @@ If you would like to contribute or find out more information, visit mailing list, or ask on IRC #perl6 on freenode. Additionally, we invite you to make a donation to The Perl Foundation -to sponsor Perl 6 development: -(put "Perl 6 Core Development Fund" in the 'Purpose' text field) +to sponsor Perl 6 development: +(put “Perl 6 Core Development Fund” in the ‘Purpose’ text field) The next release of Rakudo (#«next-release-num»), is tentatively scheduled for «next-release-date». @@ -49,7 +49,7 @@ A list of the other planned release dates is available in the The development team appreciates feedback! If you’re using Rakudo, do get back to us. Questions, comments, suggestions for improvements, cool -discoveries, incredible hacks, or any other feedback -- get in touch with +discoveries, incredible hacks, or any other feedback – get in touch with us through (the above-mentioned) mailing list or IRC channel. Enjoy! Please note that recent releases have known issues running on the JVM. @@ -61,12 +61,13 @@ an estimated delivery date. [^2]: What’s the difference between the Rakudo compiler and the Rakudo Star distribution? -The Rakudo compiler is a compiler for the Perl 6 language. +The Rakudo compiler is a compiler for the Perl 6 language. Not much more. The Rakudo Star distribution is the Rakudo compiler plus a selection -of useful Perl 6 modules, a module installer, Perl 6 introductory documentation, -and other software that can be used with the Rakudo compiler to enhance its utility. +of useful Perl 6 modules, a module installer, Perl 6 introductory +documentation, and other software that can be used with the Rakudo +compiler to enhance its utility. END_TEMPLATE my @ENGLISH-MONTHS = flat Any, @@ -133,7 +134,7 @@ sub find-contributors( "--roast=$roast", |($last_release if $last_release); - $proc.out.slurp-rest(:close).lines[1..*].join: "\n"; + $proc.out.slurp-rest(:close).lines[1..*]».trim-trailing.join: "\n"; } sub find-next-release-date() { @@ -181,5 +182,5 @@ sub MAIN ( $value }, :g); - say $content; + say $content.chomp; } From 76017036aaa5364e07163398b97414299eca23a2 Mon Sep 17 00:00:00 2001 From: Aleks-Daniel Jakimenko-Aleksejev Date: Mon, 23 Oct 2017 15:26:34 +0300 Subject: [PATCH 538/692] Reflect actual date, claim next release --- docs/release_guide.pod | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/docs/release_guide.pod b/docs/release_guide.pod index f0fe868df83..6a688d690bc 100644 --- a/docs/release_guide.pod +++ b/docs/release_guide.pod @@ -22,8 +22,7 @@ Note that we are trying very hard to ensure there are no backward compatibility issues post Christmas. As such, we may end up delaying some releases to ensure any compatibility issues are resolved. - 2017-10-21 Rakudo #116 (AlexDaniel + Releasable) - 2017-11-18 Rakudo #117 + 2017-11-18 Rakudo #117 (AlexDaniel + Releasable) 2017-12-16 Rakudo #118 2018-01-20 Rakudo #119 2018-02-17 Rakudo #120 @@ -451,6 +450,7 @@ Previous releases were bundled as part of monthly Parrot releases. 2017-07-15 Rakudo #113 "2017.07" (Zoffix + NeuralAnomaly) 2017-08-21 Rakudo #114 "2017.08" (AlexDaniel + Releasable) 2017-09-18 Rakudo #115 "2017.09" (AlexDaniel + Releasable) + 2017-10-23 Rakudo #116 "2017.10" (AlexDaniel + Releasable) =head1 COPYRIGHT From 6f6e62ea02083526735c38c7ddf64ceb27474ea5 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Mon, 23 Oct 2017 14:48:00 +0200 Subject: [PATCH 539/692] Some ThreadPoolScheduler tweaks - make sure we can identify which .elems failed in stacktrace - use = instead of .= Lock like everywhere else - not sure about this one --- src/core/ThreadPoolScheduler.pm | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index b728631a0fb..04213448651 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -295,7 +295,7 @@ my class ThreadPoolScheduler does Scheduler { has Int $.max_threads; # All of the worker and queue state below is guarded by this lock. - has Lock $!state-lock .= new; + has Lock $!state-lock = Lock.new; # The general queue and timer queue, if created. has Queue $!general-queue; @@ -547,7 +547,10 @@ my class ThreadPoolScheduler does Scheduler { } method !total-workers() { - $!general-workers.elems + $!timer-workers.elems + $!affinity-workers.elems + my int $a = $!general-workers.elems; + my int $b = $!timer-workers.elems; + my int $c = $!affinity-workers.elems; + $a + $b + $c } submethod BUILD( From e70969e34246da77cce62269c9a5690e713a9535 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Mon, 23 Oct 2017 14:26:57 +0000 Subject: [PATCH 540/692] Use lexical instead of state var when we can Same reasoning as in https://github.com/rakudo/rakudo/commit/6af44f8d38a02bbd0d68cfd014165d6e33e4d89a --- src/core/Exception.pm | 4 ++-- src/core/IO/CatHandle.pm | 6 +++--- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/core/Exception.pm b/src/core/Exception.pm index e98a4f4cb50..10714c5d311 100644 --- a/src/core/Exception.pm +++ b/src/core/Exception.pm @@ -2508,8 +2508,8 @@ my class X::Multi::NoMatch is Exception { my @un-rw-cand; if first / 'is rw' /, @cand { my $rw-capture = Capture.new( - :list( $!capture.list.map({ $ = $_ }) ), - :hash( $!capture.hash.map({ .key => $ = .value }).hash ), + :list( $!capture.list.map({ my $ = $_ }) ), + :hash( $!capture.hash.map({ .key => my $ = .value }).hash ), ); @un-rw-cand = $.dispatcher.dispatchees».signature.grep({ $rw-capture ~~ $^cand diff --git a/src/core/IO/CatHandle.pm b/src/core/IO/CatHandle.pm index 2901dc78715..8aae64497af 100644 --- a/src/core/IO/CatHandle.pm +++ b/src/core/IO/CatHandle.pm @@ -50,7 +50,7 @@ my class IO::CatHandle is IO::Handle { (my $old-handle is default(Nil) = $!active-handle), nqp::if( nqp::defined($!active-handle), - ($ = $!active-handle.close)), # don't sink the result, since it might + (my $ = $!active-handle.close)), # don't sink the result, since it might # .. be an IO::Pipe that returns a Proc that might throw nqp::if( nqp::elems($!handles), @@ -259,14 +259,14 @@ my class IO::CatHandle is IO::Handle { nqp::stmts( nqp::if( nqp::defined($!active-handle), - $ = $!active-handle.close), + my $ = $!active-handle.close), (my int $i = -1), (my int $els = nqp::elems($!handles)), nqp::while( nqp::isgt_i($els, $i = nqp::add_i($i, 1)), nqp::if( nqp::istype(($_ := nqp::atpos($!handles, $i)), IO::Handle), - $ = .close)), + my $ = .close)), ($!handles := nqp::list), ($!active-handle = Nil)) } From 50324bb004e120a0f82363bf8ff4222dc2cfa014 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Mon, 23 Oct 2017 16:33:45 +0200 Subject: [PATCH 541/692] Threadsafe List.reify-until-lazy a bit This is a bandaid for the 2017.10 release. It fixes the most common place where https://github.com/rakudo/rakudo/issues/1202 goes awry. The result is fewer crashes, and if they crash, it's because MoarVM itself go thoroughly corrupted. --- src/core/List.pm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/core/List.pm b/src/core/List.pm index f4472dbc13a..ee68fa0c7a6 100644 --- a/src/core/List.pm +++ b/src/core/List.pm @@ -111,7 +111,7 @@ my class List does Iterable does Positional { # declared in BOOTSTRAP ($!future.DEFINITE && nqp::not_i($!current-iter.DEFINITE)), nqp::stmts( nqp::while( - nqp::elems($!future), + $!future.DEFINITE && nqp::elems($!future), nqp::if( (nqp::istype((my $current := nqp::shift($!future)),Slip) && nqp::isconcrete($current)), @@ -129,8 +129,8 @@ my class List does Iterable does Positional { # declared in BOOTSTRAP $!reification-target.push($current) ) ), - nqp::unless( - nqp::elems($!future), + nqp::if( + $!future.DEFINITE && nqp::not_i(nqp::elems($!future)), $!future := Mu ) ) From e4a5bb17c9b16a6e2b2e7ec973c09bc8918a41e0 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Mon, 23 Oct 2017 17:32:47 +0000 Subject: [PATCH 542/692] Improve/Fix Int.new - Don't use p6bindattrinvres with `bigint` attributes; it's questionable if it should work and fails on JVM (part of #1201) - Make Int.new: int candidate properly give a new object instead of a cached constant --- src/core/Int.pm | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/src/core/Int.pm b/src/core/Int.pm index 0acb98be694..bc818bdea4f 100644 --- a/src/core/Int.pm +++ b/src/core/Int.pm @@ -25,11 +25,14 @@ my class Int does Real { # declared in BOOTSTRAP } proto method new(|) {*} - multi method new( \value) { self.new: value.Int } - multi method new(int \value) { nqp::box_i(value,self.WHAT) } + multi method new( \value) { self.new: value.Int } + multi method new(int \value) { + # rebox the value, so we get rid of any potential mixins + nqp::div_I(nqp::decont(value), 1, self) + } multi method new(Int:D \value = 0) { - nqp::p6bindattrinvres(self.bless, Int,'$!value', - nqp::getattr(nqp::decont(value),Int,'$!value')) + # rebox the value, so we get rid of any potential mixins + nqp::div_I(nqp::decont(value), 1, self) } multi method perl(Int:D:) { From 30462d766e9216c9f5beed0f501d9251cc245430 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Tue, 24 Oct 2017 13:44:06 +0200 Subject: [PATCH 543/692] HLL-fix for issue 1202 - more info: see https://github.com/rakudo/rakudo/issues/1202 - changes all use of Lists for worker list to IterationBuffer - these have fewer concurrency issues - specifically, List.elems *could* change internal state of a List - this appears to make the sample code much more stable - a crash is now typically something inside of Moar, such as: - MoarVM panic: Heap corruption detected: pointer 0xdeadbeef to past fromspace So, I think there is at least one more gremlin living inside MoarVM related to this issue. --- src/core/ThreadPoolScheduler.pm | 146 +++++++++++++++++++++++--------- 1 file changed, 105 insertions(+), 41 deletions(-) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index 04213448651..55b22000759 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -303,9 +303,9 @@ my class ThreadPoolScheduler does Scheduler { # The current lists of workers. Immutable lists; new ones are produced # upon changes. - has List $!general-workers = (); - has List $!timer-workers = (); - has List $!affinity-workers = (); + has $!general-workers; + has $!timer-workers; + has $!affinity-workers; # The supervisor thread, if started. has Thread $!supervisor; @@ -316,10 +316,15 @@ my class ThreadPoolScheduler does Scheduler { unless $!general-queue.DEFINITE { # We don't have any workers yet, so start one. $!general-queue := nqp::create(Queue); - $!general-workers = (GeneralWorker.new( + my $workers := nqp::create(IterationBuffer); + nqp::push( + $workers, + GeneralWorker.new( queue => $!general-queue, scheduler => self - ),); + ) + ); + $!general-workers := $workers; scheduler-debug "Created initial general worker thread"; self!maybe-start-supervisor(); } @@ -334,10 +339,15 @@ my class ThreadPoolScheduler does Scheduler { unless $!timer-queue.DEFINITE { # We don't have any workers yet, so start one. $!timer-queue := nqp::create(Queue); - $!timer-workers = (TimerWorker.new( + my $workers := nqp::create(IterationBuffer); + nqp::push( + $workers, + TimerWorker.new( queue => $!timer-queue, scheduler => self - ),); + ) + ); + $!timer-workers := $workers; scheduler-debug "Created initial timer worker thread"; self!maybe-start-supervisor(); } @@ -355,9 +365,14 @@ my class ThreadPoolScheduler does Scheduler { if $!affinity-workers.elems == 0 { # We don't have any affinity workers yet, so start one # and return its queue. - $!affinity-workers := (AffinityWorker.new( + my $workers := nqp::create(IterationBuffer); + nqp::push( + $workers, + AffinityWorker.new( scheduler => self - ),); + ) + ); + $!affinity-workers := $workers; scheduler-debug "Created initial affinity worker thread"; self!maybe-start-supervisor(); return $!affinity-workers[0].queue; @@ -370,18 +385,25 @@ my class ThreadPoolScheduler does Scheduler { # and approximate, but enough to help us avoid a busy worker). If we # find an empty queue, return it immediately. my $most-free-worker; - $cur-affinity-workers.map: -> $cand { - if $most-free-worker.DEFINITE { - my $queue := $cand.queue; - return $queue if $queue.elems == 0; - if $cand.elems < $most-free-worker.queue.elems { - $most-free-worker := $cand; - } - } - else { - $most-free-worker := $cand; - } - } + my int $i = -1; + nqp::while( + nqp::islt_i(($i = nqp::add_i($i,1)),nqp::elems($cur-affinity-workers)), + nqp::if( + $most-free-worker.DEFINITE, + nqp::stmts( + (my $cand := nqp::atpos($cur-affinity-workers,$i)), + nqp::unless( + (my $queue := $cand.queue).elems, + (return $queue) + ), + nqp::if( + nqp::islt_i($cand.elems,$most-free-worker.queue.elems), + $most-free-worker := $cand + ) + ), + ($most-free-worker := nqp::atpos($cur-affinity-workers,$i)) + ) + ); # Otherwise, check if the queue beats the threshold to add another # worker thread. @@ -400,7 +422,9 @@ my class ThreadPoolScheduler does Scheduler { return $chosen-queue; } my $new-worker := AffinityWorker.new(scheduler => self); - $!affinity-workers := (|$!affinity-workers, $new-worker); + my $workers := nqp::clone($!affinity-workers); + nqp::push($workers, $new-worker); + $!affinity-workers := $workers; scheduler-debug "Added an affinity worker thread"; $new-worker.queue } @@ -419,19 +443,29 @@ my class ThreadPoolScheduler does Scheduler { $!supervisor = Thread.start(:app_lifetime, { sub add-general-worker() { $!state-lock.protect: { - $!general-workers := (|$!general-workers, GeneralWorker.new( + my $workers := nqp::clone($!general-workers); + nqp::push( + $workers, + GeneralWorker.new( queue => $!general-queue, scheduler => self - )); + ) + ); + $!general-workers := $workers; } scheduler-debug "Added a general worker thread"; } sub add-timer-worker() { $!state-lock.protect: { - $!timer-workers := (|$!timer-workers, TimerWorker.new( + my $workers := nqp::clone($!timer-workers); + nqp::push( + $workers, + TimerWorker.new( queue => $!timer-queue, scheduler => self - )); + ) + ); + $!timer-workers := $workers; } scheduler-debug "Added a timer worker thread"; } @@ -504,11 +538,24 @@ my class ThreadPoolScheduler does Scheduler { # don't need to add one. my int $total-completed; my int $total-times-nothing-completed; - worker-list.map: { - return unless .working; - $total-completed += .take-completed; - $total-times-nothing-completed += .times-nothing-completed; - } + my int $i = -1; + nqp::while( + nqp::islt_i(($i = nqp::add_i($i,1)),nqp::elems(worker-list)), + nqp::if( + (my $worker := nqp::atpos(worker-list,$i)).working, + nqp::stmts( + ($total-completed = nqp::add_i( + $total-completed, + $worker.take-completed + )), + ($total-times-nothing-completed = nqp::add_i( + $total-times-nothing-completed, + $worker.times-nothing-completed + )) + ), + return + ) + ); # If we didn't complete anything, then consider adding more threads. my int $total-workers = self!total-workers(); @@ -547,10 +594,7 @@ my class ThreadPoolScheduler does Scheduler { } method !total-workers() { - my int $a = $!general-workers.elems; - my int $b = $!timer-workers.elems; - my int $c = $!affinity-workers.elems; - $a + $b + $c + $!general-workers.elems + $!timer-workers.elems + $!affinity-workers.elems } submethod BUILD( @@ -560,17 +604,29 @@ my class ThreadPoolScheduler does Scheduler { ) { die "Initial thread pool threads ($!initial_threads) must be less than or equal to maximum threads ($!max_threads)" if $!initial_threads > $!max_threads; + + $!general-workers := nqp::create(IterationBuffer); + $!timer-workers := nqp::create(IterationBuffer); + $!affinity-workers := nqp::create(IterationBuffer); + if $!initial_threads > 0 { # We've been asked to make some initial threads; we interpret this # as general workers. self!general-queue(); # Starts one worker if $!initial_threads > 1 { - $!general-workers := (|$!general-workers, |( + my $workers := nqp::clone($!general-workers); + my int $i = -1; + nqp::while( + nqp::islt_i(($i = nqp::add_i($i,1)),$!initial_threads), + nqp::push( + $workers, GeneralWorker.new( queue => $!general-queue, scheduler => self - ) xx $!initial_threads - 1 - )); + ) + ) + ); + $!general-workers := $workers; } } } @@ -663,9 +719,17 @@ my class ThreadPoolScheduler does Scheduler { } method loads() { - [+] ($!general-queue ?? $!general-queue.elems !! 0), - ($!timer-queue ?? $!timer-queue.elems !! 0), - |($!affinity-workers.map(*.queue.elems)) + my int $loads = 0; + $loads = $loads + $!general-queue.elems if $!general-queue; + $loads = $loads + $!timer-queue.elems if $!timer-queue; + + my int $i = -1; + nqp::while( + nqp::islt_i(($i = nqp::add_i($i,1)),nqp::elems($!affinity-workers)), + $loads = $loads + nqp::atpos($!affinity-workers,$i).queue.elems + ); + + $loads } } From b19e352eca61c040bea27036f2fca5ff175df2da Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Tue, 24 Oct 2017 14:23:16 +0200 Subject: [PATCH 544/692] Revert "Threadsafe List.reify-until-lazy a bit" - This reverts commit 50324bb004e120a0f82363bf8ff4222dc2cfa014. - No longer needed because of 30462d766e9216c9f5beed - Removes small overhead the commit caused --- src/core/List.pm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/core/List.pm b/src/core/List.pm index ee68fa0c7a6..f4472dbc13a 100644 --- a/src/core/List.pm +++ b/src/core/List.pm @@ -111,7 +111,7 @@ my class List does Iterable does Positional { # declared in BOOTSTRAP ($!future.DEFINITE && nqp::not_i($!current-iter.DEFINITE)), nqp::stmts( nqp::while( - $!future.DEFINITE && nqp::elems($!future), + nqp::elems($!future), nqp::if( (nqp::istype((my $current := nqp::shift($!future)),Slip) && nqp::isconcrete($current)), @@ -129,8 +129,8 @@ my class List does Iterable does Positional { # declared in BOOTSTRAP $!reification-target.push($current) ) ), - nqp::if( - $!future.DEFINITE && nqp::not_i(nqp::elems($!future)), + nqp::unless( + nqp::elems($!future), $!future := Mu ) ) From eb1febd5658377a345395ebafa526f6dcd7b13d2 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Tue, 24 Oct 2017 21:57:33 +0000 Subject: [PATCH 545/692] Bump NQP --- tools/build/NQP_REVISION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/build/NQP_REVISION b/tools/build/NQP_REVISION index 71d4b4c4baa..431f47f25b0 100644 --- a/tools/build/NQP_REVISION +++ b/tools/build/NQP_REVISION @@ -1 +1 @@ -2017.09-119-g4494e7049 +2017.09-136-g8fa082b From 176a6fae076a8b7bbfe05b7a5fea03d95e795ee8 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Wed, 25 Oct 2017 04:02:26 +0000 Subject: [PATCH 546/692] Fix incorrect queue size measurement We're mistakenly calling .elems on the AffinityWorker, which will just return 1, messing up our measures of which worker is less busy. Use its .queue instead; we already grabbed it into a var a few lines up. --- src/core/ThreadPoolScheduler.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index 55b22000759..fd263cfa497 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -397,7 +397,7 @@ my class ThreadPoolScheduler does Scheduler { (return $queue) ), nqp::if( - nqp::islt_i($cand.elems,$most-free-worker.queue.elems), + nqp::islt_i($queue.elems,$most-free-worker.queue.elems), $most-free-worker := $cand ) ), From ce7e5444a2c4aa69c2e4421f02a287241199318e Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Wed, 25 Oct 2017 04:32:16 +0000 Subject: [PATCH 547/692] Add hackish fix deadlock for supply in a sock https://github.com/tokuhirom/p6-WebSocket/issues/15#issuecomment-339120879 RT #132343 Test: https://github.com/perl6/roast/commit/74445ddf8a Just pop in another worker in a case where we have just one and whose queue is empty. This fixes the bug demonstrated by the test, but it doesn't address the core cause as I don't understand it. Need proper fixin'. --- src/core/ThreadPoolScheduler.pm | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index fd263cfa497..e343acdc98d 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -411,7 +411,11 @@ my class ThreadPoolScheduler does Scheduler { my $threshold = @affinity-add-thresholds[ ($cur-affinity-workers.elems min @affinity-add-thresholds) - 1 ]; - if $chosen-queue.elems > $threshold { + + # If we got up to here with an empty queue, we have just one worker, + # so fire off another one because otherwise there seems to be a hang + # in some cases https://irclog.perlgeek.de/perl6-dev/2017-10-25#i_15349923 + if not $chosen-queue.elems or $chosen-queue.elems > $threshold { # Add another one, unless another thread did too. $!state-lock.protect: { if self!total-workers() >= $!max_threads { From 794235a38161af3cb20a33a8913b0b68b38bf716 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Wed, 25 Oct 2017 11:02:05 +0000 Subject: [PATCH 548/692] Revert "Add hackish fix deadlock for supply in a sock" This reverts commit ce7e5444a2c4aa69c2e4421f02a287241199318e. This commit is pointless and doesn't fix the bug in real-life code. --- src/core/ThreadPoolScheduler.pm | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index e343acdc98d..fd263cfa497 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -411,11 +411,7 @@ my class ThreadPoolScheduler does Scheduler { my $threshold = @affinity-add-thresholds[ ($cur-affinity-workers.elems min @affinity-add-thresholds) - 1 ]; - - # If we got up to here with an empty queue, we have just one worker, - # so fire off another one because otherwise there seems to be a hang - # in some cases https://irclog.perlgeek.de/perl6-dev/2017-10-25#i_15349923 - if not $chosen-queue.elems or $chosen-queue.elems > $threshold { + if $chosen-queue.elems > $threshold { # Add another one, unless another thread did too. $!state-lock.protect: { if self!total-workers() >= $!max_threads { From 97b11edd614b28dba1ab2d9a1f279ebe41fca8a7 Mon Sep 17 00:00:00 2001 From: pmurias Date: Wed, 25 Oct 2017 16:26:34 +0200 Subject: [PATCH 549/692] Use nqp::bitneg_i instead of a nqp::bitxor_i and a mask --- src/core/Buf.pm | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/core/Buf.pm b/src/core/Buf.pm index 782880f20fb..dcaa14c44ff 100644 --- a/src/core/Buf.pm +++ b/src/core/Buf.pm @@ -731,8 +731,7 @@ multi sub prefix:<~^>(Blob:D \a) { nqp::setelems($a,$elems); my int $i = -1; - my uint64 $mask = 0xFFFFFFFFFFFFFFFF; - nqp::bindpos_i($r,$i,nqp::bitxor_i(nqp::atpos_i($a,$i),$mask)) + nqp::bindpos_i($r,$i,nqp::bitneg_i(nqp::atpos_i($a,$i))) while nqp::islt_i(++$i,$elems); $r From a92950fb4fbedd04827d5ffefa96a56b0c7204c7 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Wed, 25 Oct 2017 17:55:30 +0000 Subject: [PATCH 550/692] Fix poor error with some slurpies with defaults Bug find: https://irclog.perlgeek.de/perl6-dev/2017-10-25#i_15352740 --- src/Perl6/Actions.nqp | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Perl6/Actions.nqp b/src/Perl6/Actions.nqp index ef9469ffcd8..53d346ef5a5 100644 --- a/src/Perl6/Actions.nqp +++ b/src/Perl6/Actions.nqp @@ -4982,7 +4982,8 @@ class Perl6::Actions is HLL::Actions does STDActions { my $quant := $; if $ { my $name := %*PARAM_INFO // ''; - if $quant eq '*' || $quant eq '|' { + if $quant eq '*' || $quant eq '|' + || $quant eq '**' || $quant eq '+' { $/.typed_sorry('X::Parameter::Default', how => 'slurpy', parameter => $name); } From 43b7cfde31a299fbea7d881bb693ee855376d54d Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Wed, 25 Oct 2017 21:18:51 +0000 Subject: [PATCH 551/692] Fix deadlock with affinity workers Fixes https://github.com/tokuhirom/p6-WebSocket/issues/15#issuecomment-339120879 and RT#132343: https://rt.perl.org/Ticket/Display.html?id=132343 Make supervisor keep an eye on affinity workers and if we spot any that are working and haven't completed anything for a while, steal their queue into general queue. Per: https://irclog.perlgeek.de/perl6-dev/2017-10-25#i_15352262 --- src/core/ThreadPoolScheduler.pm | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index fd263cfa497..ab51f4245e8 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -511,6 +511,9 @@ my class ThreadPoolScheduler does Scheduler { self!tweak-workers: $!timer-queue, $!timer-workers, &add-timer-worker, $cpu-cores, $smooth-per-core-util; } + self!prod-affinity-workers: $!affinity-workers + if $!affinity-workers.DEFINITE; + CATCH { default { scheduler-debug .gist; @@ -521,6 +524,31 @@ my class ThreadPoolScheduler does Scheduler { } } + method !prod-affinity-workers (\worker-list) { + nqp::if( + nqp::elems(worker-list), + nqp::stmts( + (my int $i = -1), + nqp::while( + nqp::islt_i(($i = nqp::add_i($i,1)),nqp::elems(worker-list)), + nqp::if( + (my $worker := nqp::atpos(worker-list,$i)).working, + nqp::stmts( + $worker.take-completed, + nqp::if( + nqp::isgt_i($worker.times-nothing-completed, 10), + $!state-lock.protect: { + # an affinity worker completed nothing for some time; + # steal its queue, moving it to general queue. This + # resolves deadlocks in certain cases. + scheduler-debug "Stealing queue from affinity worker"; + my $worker-queue := $worker.queue; + nqp::while( + nqp::elems($worker-queue), + nqp::push($!general-queue, nqp::shift($worker-queue))) + })))))) + } + method !getrusage-total() { my \rusage = nqp::getrusage(); nqp::atpos_i(rusage, nqp::const::RUSAGE_UTIME_SEC) * 1000000 + From 59bfa5ab37eb6d58ce451f41d99d238d38b86746 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Wed, 25 Oct 2017 22:33:14 +0000 Subject: [PATCH 552/692] Polish off affinity worker prodder Per https://irclog.perlgeek.de/perl6-dev/2017-10-25#i_15353842 - Improve readability - Steal only one item from the queue - Prevent potential supervisor deadlock from elems'ing the queue and having a race empty it and for nqp::shift() to block --- src/core/ThreadPoolScheduler.pm | 37 +++++++++++++-------------------- 1 file changed, 15 insertions(+), 22 deletions(-) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index ab51f4245e8..19c454e00ae 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -525,28 +525,21 @@ my class ThreadPoolScheduler does Scheduler { } method !prod-affinity-workers (\worker-list) { - nqp::if( - nqp::elems(worker-list), - nqp::stmts( - (my int $i = -1), - nqp::while( - nqp::islt_i(($i = nqp::add_i($i,1)),nqp::elems(worker-list)), - nqp::if( - (my $worker := nqp::atpos(worker-list,$i)).working, - nqp::stmts( - $worker.take-completed, - nqp::if( - nqp::isgt_i($worker.times-nothing-completed, 10), - $!state-lock.protect: { - # an affinity worker completed nothing for some time; - # steal its queue, moving it to general queue. This - # resolves deadlocks in certain cases. - scheduler-debug "Stealing queue from affinity worker"; - my $worker-queue := $worker.queue; - nqp::while( - nqp::elems($worker-queue), - nqp::push($!general-queue, nqp::shift($worker-queue))) - })))))) + for ^worker-list.elems { + my $worker := worker-list[$_]; + if $worker.working { + $worker.take-completed; + + # If an affinity worker completed nothing for some time, + # steal an item from its queue, moving it to general queue. + # This resolves deadlocks in certain cases. + if $worker.times-nothing-completed > 10 { + scheduler-debug "Stealing queue from affinity worker"; + my $item := nqp::queuepoll($worker.queue); + nqp::push($!general-queue, $item) unless nqp::isnull($item); + } + } + } } method !getrusage-total() { From 27590e8bc746e3c8d8789d6f22e926cebc8ac391 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Wed, 25 Oct 2017 23:47:55 +0000 Subject: [PATCH 553/692] Make supervisor per-core-util calculator 2.8x faster Most of this is from rewriteing &push to .push so it doesn't go through slippy candidate --- src/core/ThreadPoolScheduler.pm | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index 19c454e00ae..9b6669fa150 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -438,6 +438,7 @@ my class ThreadPoolScheduler does Scheduler { # it takes stock of the current situation and decides whether or not to # add threads. my constant SUPERVISION_INTERVAL = 0.01; + my constant LAST_UTILS_NUM = 5; method !maybe-start-supervisor() { unless $!supervisor.DEFINITE { $!supervisor = Thread.start(:app_lifetime, { @@ -473,7 +474,7 @@ my class ThreadPoolScheduler does Scheduler { scheduler-debug "Supervisor started"; my num $last-rusage-time = nqp::time_n; my int $last-usage = self!getrusage-total(); - my num @last-utils; + my num @last-utils = 0e0 xx LAST_UTILS_NUM; my int $cpu-cores = nqp::cpucores(); scheduler-debug "Supervisor thinks there are $cpu-cores CPU cores"; loop { @@ -496,11 +497,11 @@ my class ThreadPoolScheduler does Scheduler { my num $per-core = $normalized-delta / $cpu-cores; my num $per-core-util = 100 * ($per-core / 1000000); - # Since those values are noisy, average the last 5 to get - # a smoothed value. - @last-utils.shift if @last-utils == 5; - push @last-utils, $per-core-util; - my $smooth-per-core-util = [+](@last-utils) / @last-utils; + # Since those values are noisy, average the last + # LAST_UTILS_NUM values to get a smoothed value. + @last-utils.shift; + @last-utils.push: $per-core-util; + my $smooth-per-core-util = @last-utils.sum / LAST_UTILS_NUM; scheduler-debug-status "Per-core utilization (approx): $smooth-per-core-util%"; if $!general-queue.DEFINITE { From e95eb42c91ccdff23e3ee9052296ebd758149540 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Thu, 26 Oct 2017 00:40:00 +0000 Subject: [PATCH 554/692] Test for deadlock heuristic more Check for deadlock even if we have some completed jobs but still have a ton of total uncompleted ones. t/spec/S17-channel/stress.t on 4-core/4GB RAM VM takes: - On 2017.09, 7s to run - on HEAD, effectively hangs: eats up all the RAM before enough workers are available, unless the box is busy doing something else. The program itself does not generate enough CPU usage to trigger worker addition - with this commit: takes 27s to run the second part of the test file completes fast now but first one is still 2x slower; looking closer at that seems to be slower just due to new scheduler mechanics rather than some bug --- src/core/ThreadPoolScheduler.pm | 26 +++++++++++++++++++------- 1 file changed, 19 insertions(+), 7 deletions(-) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index 9b6669fa150..b7805c22b39 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -579,6 +579,15 @@ my class ThreadPoolScheduler does Scheduler { ) ); + sub heuristic-check-for-deadlock { + my int $average-times-nothing-completed + = $total-times-nothing-completed div (worker-list.elems || 1); + if $average-times-nothing-completed > 20 { + scheduler-debug "Heuristic queue progress deadlock situation detected"; + add-worker(); + } + } + # If we didn't complete anything, then consider adding more threads. my int $total-workers = self!total-workers(); if $total-completed == 0 { @@ -601,16 +610,19 @@ my class ThreadPoolScheduler does Scheduler { # number of iterations since nothing was completed by any # worker will grow. else { - my int $average-times-nothing-completed = - $total-times-nothing-completed div (worker-list.elems || 1); - if $average-times-nothing-completed > 20 { - scheduler-debug "Heuristic queue progress deadlock situation detected"; - add-worker(); - } + heuristic-check-for-deadlock } } else { - scheduler-debug "Will not add extra worker; hit $!max_threads thread limit"; + scheduler-debug "Will not add extra worker; hit $!max_threads thread limit [branch with 0 total completed]"; + } + } + elsif $total-times-nothing-completed > 20*$cores { + if $total-workers < $!max_threads { + heuristic-check-for-deadlock + } + else { + scheduler-debug "Will not add extra worker; hit $!max_threads thread limit [branch with some total completed]"; } } } From f3b497c85e4d8bf2244039a406b30194bd685749 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Thu, 26 Oct 2017 02:02:58 +0000 Subject: [PATCH 555/692] Fix accidentally-edited auto-generated part The auto-generated part was accidentallyu edited[^1] directly. Propagate the change to generator script. I'm only assuming the same change was needed (or at least is not detrimental) to other types that are now included. [1] https://github.com/rakudo/rakudo/commit/714c188d4aa0c5ca59d98dfb0c64c2ea889ab144 --- src/core/native_array.pm | 8 ++++---- tools/build/makeNATIVE_ARRAY.pl6 | 4 ++-- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/core/native_array.pm b/src/core/native_array.pm index 7637ee3b8d6..7472427f21b 100644 --- a/src/core/native_array.pm +++ b/src/core/native_array.pm @@ -128,8 +128,8 @@ my class array does Iterable { nqp::push_s(self, $value); self } - multi method append(strarray:D: str @values) { - nqp::splice(self,@values,nqp::elems(self),0) + multi method append(strarray:D: strarray:D $values) is default { + nqp::splice(self,$values,nqp::elems(self),0) } multi method append(strarray:D: @values) { fail X::Cannot::Lazy.new(:action, :what(self.^name)) @@ -739,8 +739,8 @@ my class array does Iterable { nqp::push_n(self, $value); self } - multi method append(numarray:D: num @values) { - nqp::splice(self,@values,nqp::elems(self),0) + multi method append(numarray:D: numarray:D $values) is default { + nqp::splice(self,$values,nqp::elems(self),0) } multi method append(numarray:D: @values) { fail X::Cannot::Lazy.new(:action, :what(self.^name)) diff --git a/tools/build/makeNATIVE_ARRAY.pl6 b/tools/build/makeNATIVE_ARRAY.pl6 index 6fd1c8b547e..e28789ebe6e 100644 --- a/tools/build/makeNATIVE_ARRAY.pl6 +++ b/tools/build/makeNATIVE_ARRAY.pl6 @@ -115,8 +115,8 @@ for $*IN.lines -> $line { nqp::push_#postfix#(self, $value); self } - multi method append(#type#array:D: #type# @values) { - nqp::splice(self,@values,nqp::elems(self),0) + multi method append(#type#array:D: #type#array:D $values) is default { + nqp::splice(self,$values,nqp::elems(self),0) } multi method append(#type#array:D: @values) { fail X::Cannot::Lazy.new(:action, :what(self.^name)) From a85c8d486c47efc6f7d3b237a416355b1eec3fa7 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Thu, 26 Oct 2017 02:05:20 +0000 Subject: [PATCH 556/692] Fix .STORE leaving behind elements on native arrays - Occurs when non-Iterable value is assigned - Occurs when native-Iterable is assigned --- src/core/native_array.pm | 18 ++++++++++++------ tools/build/makeNATIVE_ARRAY.pl6 | 4 +++- 2 files changed, 15 insertions(+), 7 deletions(-) diff --git a/src/core/native_array.pm b/src/core/native_array.pm index 7472427f21b..bb998ffadf3 100644 --- a/src/core/native_array.pm +++ b/src/core/native_array.pm @@ -57,7 +57,7 @@ my class array does Iterable { my role strarray[::T] does Positional[T] is array_type(T) { #- start of generated part of strarray role ----------------------------------- -#- Generated on 2017-04-09T22:40:33+02:00 by tools/build/makeNATIVE_ARRAY.pl6 +#- Generated on 2017-10-26T01:53:35Z by tools/build/makeNATIVE_ARRAY.pl6 #- PLEASE DON'T CHANGE ANYTHING BELOW THIS LINE multi method AT-POS(strarray:D: int $idx) is raw { @@ -88,11 +88,13 @@ my class array does Iterable { } multi method STORE(strarray:D: $value) { + nqp::setelems(self,1); nqp::bindpos_s(self, 0, nqp::unbox_s($value)); self } multi method STORE(strarray:D: str @values) { - nqp::splice(self,@values,0,0) + nqp::setelems(self,@values.elems); + nqp::splice(self,@values,0,@values.elems) } multi method STORE(strarray:D: @values) { my int $elems = @values.elems; @@ -353,7 +355,7 @@ my class array does Iterable { my role intarray[::T] does Positional[T] is array_type(T) { #- start of generated part of intarray role ----------------------------------- -#- Generated on 2017-04-09T22:40:33+02:00 by tools/build/makeNATIVE_ARRAY.pl6 +#- Generated on 2017-10-26T01:53:35Z by tools/build/makeNATIVE_ARRAY.pl6 #- PLEASE DON'T CHANGE ANYTHING BELOW THIS LINE multi method AT-POS(intarray:D: int $idx) is raw { @@ -384,11 +386,13 @@ my class array does Iterable { } multi method STORE(intarray:D: $value) { + nqp::setelems(self,1); nqp::bindpos_i(self, 0, nqp::unbox_i($value)); self } multi method STORE(intarray:D: int @values) { - nqp::splice(self,@values,0,0) + nqp::setelems(self,@values.elems); + nqp::splice(self,@values,0,@values.elems) } multi method STORE(intarray:D: @values) { my int $elems = @values.elems; @@ -668,7 +672,7 @@ my class array does Iterable { my role numarray[::T] does Positional[T] is array_type(T) { #- start of generated part of numarray role ----------------------------------- -#- Generated on 2017-04-09T22:40:33+02:00 by tools/build/makeNATIVE_ARRAY.pl6 +#- Generated on 2017-10-26T01:53:35Z by tools/build/makeNATIVE_ARRAY.pl6 #- PLEASE DON'T CHANGE ANYTHING BELOW THIS LINE multi method AT-POS(numarray:D: int $idx) is raw { @@ -699,11 +703,13 @@ my class array does Iterable { } multi method STORE(numarray:D: $value) { + nqp::setelems(self,1); nqp::bindpos_n(self, 0, nqp::unbox_n($value)); self } multi method STORE(numarray:D: num @values) { - nqp::splice(self,@values,0,0) + nqp::setelems(self,@values.elems); + nqp::splice(self,@values,0,@values.elems) } multi method STORE(numarray:D: @values) { my int $elems = @values.elems; diff --git a/tools/build/makeNATIVE_ARRAY.pl6 b/tools/build/makeNATIVE_ARRAY.pl6 index e28789ebe6e..37cb26e2f86 100644 --- a/tools/build/makeNATIVE_ARRAY.pl6 +++ b/tools/build/makeNATIVE_ARRAY.pl6 @@ -75,11 +75,13 @@ for $*IN.lines -> $line { } multi method STORE(#type#array:D: $value) { + nqp::setelems(self,1); nqp::bindpos_#postfix#(self, 0, nqp::unbox_#postfix#($value)); self } multi method STORE(#type#array:D: #type# @values) { - nqp::splice(self,@values,0,0) + nqp::setelems(self,@values.elems); + nqp::splice(self,@values,0,@values.elems) } multi method STORE(#type#array:D: @values) { my int $elems = @values.elems; From 5a5482e77d02568017a124b7b323f7d128a4e583 Mon Sep 17 00:00:00 2001 From: Nick Logan Date: Wed, 25 Oct 2017 23:07:37 -0400 Subject: [PATCH 557/692] Fix multiple options passed to include specs Previously passing multiple options would result in the first option set (in %options) containing all the values for all the keys. --- src/core/CompUnit/RepositoryRegistry.pm | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/src/core/CompUnit/RepositoryRegistry.pm b/src/core/CompUnit/RepositoryRegistry.pm index d13c5579ffd..82366b1b5ab 100644 --- a/src/core/CompUnit/RepositoryRegistry.pm +++ b/src/core/CompUnit/RepositoryRegistry.pm @@ -341,22 +341,19 @@ class CompUnit::RepositoryRegistry { #?endif sub parse-include-spec(Str:D $spec, Str:D $default-short-id = 'file') { - my %options; - # something we understand if $spec ~~ /^ [ $=[ <.ident>+ % '::' ] - [ '#' $=\w+ - <[ < ( [ { ]> $=<[\w-]>+ <[ > ) \] } ]> - { %options{$} = ~$ } + [ '#' $=\w+ + <[ < ( [ { ]> $=<[\w-]>+? <[ > ) \] } ]> ]* '#' ]? $=.* $/ { - ( $ ?? ~$ !! $default-short-id, %options, ~$ ); + ( ~($ // $default-short-id), %($>>.Str Z=> $>>.Str), ~$ ); } } From 2c4868b859fb8aa14950e83edd41dcde5c0b06bf Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Thu, 26 Oct 2017 10:41:56 +0200 Subject: [PATCH 558/692] Remove one division from supervisor loop Since the number of elements sampled is now always constant, we can factor that into the per-core calculation at compile time, so that we only need to sum it at runtime. --- src/core/ThreadPoolScheduler.pm | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index b7805c22b39..2866f983087 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -495,13 +495,14 @@ my class ThreadPoolScheduler does Scheduler { # into a per-core utilization percentage. my num $normalized-delta = $usage-delta / $rusage-period; my num $per-core = $normalized-delta / $cpu-cores; - my num $per-core-util = 100 * ($per-core / 1000000); + my num $per-core-util = + 100 * ($per-core / (1000000 * LAST_UTILS_NUM)); # Since those values are noisy, average the last # LAST_UTILS_NUM values to get a smoothed value. @last-utils.shift; @last-utils.push: $per-core-util; - my $smooth-per-core-util = @last-utils.sum / LAST_UTILS_NUM; + my $smooth-per-core-util = @last-utils.sum; scheduler-debug-status "Per-core utilization (approx): $smooth-per-core-util%"; if $!general-queue.DEFINITE { From 9554a97c509cf6fb8e1c8687190d98b9e9c9e688 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Thu, 26 Oct 2017 10:37:09 +0000 Subject: [PATCH 559/692] Throw useful error with .new with no args on natives This form never worked, so we don't need to bother passing it via deprecation period. Just start throwing same error all forms will be throwing once deprecation period expires. --- src/Perl6/Metamodel/NativeHOW.nqp | 2 +- t/05-messages/01-errors.t | 14 +++++++++++++- 2 files changed, 14 insertions(+), 2 deletions(-) diff --git a/src/Perl6/Metamodel/NativeHOW.nqp b/src/Perl6/Metamodel/NativeHOW.nqp index 88127b8af27..669add3bea2 100644 --- a/src/Perl6/Metamodel/NativeHOW.nqp +++ b/src/Perl6/Metamodel/NativeHOW.nqp @@ -116,7 +116,7 @@ class Perl6::Metamodel::NativeHOW method method_table($obj) { nqp::hash('new', nqp::getstaticcode(sub (*@_,*%_) { - # nqp::die('Cannot instantiate a native type'); + @_[1] // nqp::die('Cannot instantiate a native type'); nqp::getlexcaller('&DEPRECATED')( '(my ' ~ @_[0].HOW.name(@_[0]) ~ ' $ = ' ~ @_[1].perl() ~ ')', '2017.09.403', diff --git a/t/05-messages/01-errors.t b/t/05-messages/01-errors.t index d4a0aed3b5a..42e66f45a56 100644 --- a/t/05-messages/01-errors.t +++ b/t/05-messages/01-errors.t @@ -262,7 +262,7 @@ throws-like 「callframe.callframe(1).my.perl」, X::NYI, subtest '.new on native types works (deprecated; will die)' => { - plan 9; + plan 18; die "Time to remove deprecation and make .new on ints die" if $*PERL.compiler.version after v2017.12.50; @@ -286,6 +286,18 @@ subtest '.new on native types works (deprecated; will die)' => { is-deeply str.new('x'), 'x', 'str'; + throws-like { int .new }, Exception, :message{.contains: "Cannot instantiate"}, 'int no args'; + throws-like { int8 .new }, Exception, :message{.contains: "Cannot instantiate"}, 'int8 no args'; + throws-like { int16.new }, Exception, :message{.contains: "Cannot instantiate"}, 'int16 no args'; + throws-like { int32.new }, Exception, :message{.contains: "Cannot instantiate"}, 'int32 no args'; + throws-like { int64.new }, Exception, :message{.contains: "Cannot instantiate"}, 'int64 no args'; + + throws-like { num .new }, Exception, :message{.contains: "Cannot instantiate"}, 'num no args'; + throws-like { num32.new }, Exception, :message{.contains: "Cannot instantiate"}, 'num32 no args'; + throws-like { num64.new }, Exception, :message{.contains: "Cannot instantiate"}, 'num64 no args'; + + throws-like { str.new }, Exception, :message{.contains: "Cannot instantiate"}, 'str no args'; + # throws-like { int .new: 4 }, Exception, 'int'; # throws-like { int8 .new: 4 }, Exception, 'int8'; # throws-like { int16.new: 4 }, Exception, 'int16'; From 5d4ca586b0a3e0015b8658ffeaca69c369ef5851 Mon Sep 17 00:00:00 2001 From: Aleks-Daniel Jakimenko-Aleksejev Date: Thu, 26 Oct 2017 13:52:48 +0300 Subject: [PATCH 560/692] Remaining ChangeLog entries Deliberately not logged: 7277aa54 d10d6977 3f595acf 50be159f 76017036 50324bb0 b19e352e eb1febd5 ce7e5444 794235a3 f3b497c8 --- docs/ChangeLog | 19 +++++++++++++------ 1 file changed, 13 insertions(+), 6 deletions(-) diff --git a/docs/ChangeLog b/docs/ChangeLog index b9722bc65a2..074394e6f36 100644 --- a/docs/ChangeLog +++ b/docs/ChangeLog @@ -43,10 +43,14 @@ New in 2017.10: + Fixed location of errors coming from Channel [82a38c29] + Fixed lockup when scheduling with degenerate delays [df01ad97][031f8cf7] + Fixed segfault in getlexdyn [4f5fc520][4c370072] + + Fixed poor error with some slurpies with defaults [a92950fb] + + Fixed Int.new to properly give a new object [e4a5bb17] + + Fixed .STORE leaving behind elements on native arrays [a85c8d48] + Various async improvements [633a15b8][ef4d16fe][f53d3963] [26a9c313][9d903408][0d600a0c][54783920][e0e5e6fa][b16aba01] [d8890a82][73aeee6c][2a826238][3deda842][f58ac999][40c2d0cd] - [c46de00f][e5c17462][6e42b37e][80f883bc] + [c46de00f][e5c17462][6e42b37e][80f883bc][6af44f8d][e70969e3] + [30462d76][97b11edd] + Various fixes and improvements to hyper/race [cc2a0643][2352efe5] [d43b3738][dfa230f7][1fdc84fe][cef4806f][ea51d19b][374ee3e2] [ad0dd8e7][41729e93][d74ba041][83676112][2580a0a6][cf1673d9] @@ -56,7 +60,7 @@ New in 2017.10: [cf95ce81][66c2d05f][a845ac3d][48a84d6a][bb45791c][279bae08] [6542bb80][5747bc71][c7a82d45][fb7abf06][ac97a401][64b001a1] [1ea3297b][56eef696][25c87d0d][5d3ebc09][de2b9ff7][084078e1] - [3acde358][b3bb8c40][e611978f][12774237][33e113a2] + [3acde358][b3bb8c40][e611978f][12774237][33e113a2][9554a97c] + Additions: + Improved .Capture semantics on all core types [4ba12ff1] [bad9fefd][cd5864cf] @@ -81,7 +85,8 @@ New in 2017.10: + Removals: + Removed $*MAIN-ALLOW-NAMED-ANYWHERE [9cb4b167] + Removed support for ornate parenthesis from quoting constructs [9ce896d8] - + Renamed $*INITTIME to $*INIT-INSTANT according to the spec [6bdb2dd3] + + Renamed $*INITTIME to $*INIT-INSTANT according to the spec + [6bdb2dd3][bd6c6403] + Build system: + Reworked REPL tests [be4d57de][338a0972][7c8a2739][f8edb829][1ce3a36d] + Various changes related to v6.d prep [7d830d5c][6cb810d2][36bc8e2d] @@ -91,7 +96,7 @@ New in 2017.10: + Made startup time up to 5 ms faster [48406db6][a09f5f21][bb5583ae] + Made chained ops up to 36x faster [a92d0369] + Made ≥, ≤, and ≠ unicode ops as fast as ascii equivalents - [6ec21cb4][1af2a745][43c348a8][9ff2f98f] + [6ec21cb4][1af2a745][43c348a8][9ff2f98f][6ad06fad] + Made &infix: with Version:Ds 7.2x faster [1d9553f0] + Made &DEPRECATED 27% faster when vfrom is too large [145e3156] + Made Blob.gist 26x faster [20a99fc3] @@ -99,8 +104,8 @@ New in 2017.10: + Made @a[42..*] 4.2x faster [456358e3] + Various NativeCall speedups [a06ebaf2][269fe7db][80d6b425] + Significantly faster interpolation of variables into regexes - [1761540e][0a68a18f][d73d500b][1775259a][e8003c87] - [4d3ccd83][04b171bd][317ae16c][dd880cad][2262cc47] + [1761540e][0a68a18f][d73d500b][1775259a][e8003c87] + [4d3ccd83][04b171bd][317ae16c][dd880cad][2262cc47] + Other small optimizations [9d4a833b][6902c590][fb4eb666] [b9c98531][4fae0711][921db910][c91c4011][98fae3d8] [a462d0a2][16c2a157][5f6896bd][397692ac][476741e7] @@ -108,6 +113,8 @@ New in 2017.10: + New JIT [2724a851][ff063e7b] + Better scheduler [d2eb7423][80b49320][340d8ed3][c50d35a9][9af5607d] [683037be][7c18112c][c285b489][b5605c2d][3b98fb9e][596611c8] + [6f6e62ea][176a6fae][43b7cfde][59bfa5ab][27590e8b][e95eb42c] + [2c4868b8] + Added RAKUDO_SCHEDULER_DEBUG_STATUS env var [de311f46] + Bumped libuv to the latest version [198b8497] + Reworked BUILDALL method autogeneration [9837687d][63cf246f] From 5f73579b23f2a10a6a95e127047c1bbc63074a2e Mon Sep 17 00:00:00 2001 From: Aleks-Daniel Jakimenko-Aleksejev Date: Thu, 26 Oct 2017 14:56:55 +0300 Subject: [PATCH 561/692] Generated announcement and fixed date --- docs/announce/2017.10.md | 199 +++++++++++++++++++++++++++++++++++++++ docs/release_guide.pod | 2 +- 2 files changed, 200 insertions(+), 1 deletion(-) create mode 100644 docs/announce/2017.10.md diff --git a/docs/announce/2017.10.md b/docs/announce/2017.10.md new file mode 100644 index 00000000000..0d94cc4ec1e --- /dev/null +++ b/docs/announce/2017.10.md @@ -0,0 +1,199 @@ +# Announce: Rakudo Perl 6 compiler, Release #116 (2017.10) + +On behalf of the Rakudo development team, I’m very happy to announce the +October 2017 release of Rakudo Perl 6 #116. Rakudo is an implementation of +Perl 6 on the Moar Virtual Machine[^1]. + +This release implements the 6.c version of the Perl 6 specifications. +It includes bugfixes and optimizations on top of +the 2015.12 release of Rakudo. + +Upcoming releases in 2017 will include new functionality that is not +part of the 6.c specification, available with a lexically scoped +pragma. Our goal is to ensure that anything that is tested as part of the +6.c specification will continue to work unchanged. There may be incremental +spec releases this year as well. + +The tarball for this release is available from . + +Please note: This announcement is not for the Rakudo Star +distribution[^2] — it’s announcing a new release of the compiler +only. For the latest Rakudo Star release, see +. + +The changes in this release are outlined below: + +New in 2017.10: + + SPECIAL NOTES: + + This release includes fixes to || alternation in :ratchet + mode. Code that was unintentionally relying on buggy behavior + (backtracking in :ratchet mode) may now produce unwanted + results (namely will fail to match) [963a0f06] + + Security: + + Restricted dynamic lookup metasyntax in rx EVAL [1d63dfd2][2448195d] + + Deprecations: + + Deprecated .new on native types [9d9c7f9c][cc6c0558] + + Deprecated :buffer `open` arg in favor of :out-buffer [f9c10c21] + + Fixes: + + Fixed Hash.perl to include Scalar indicators [47d6c66e] + + Fixed :delete with lazy Arrays [0385b2aa] + + Fixed sanitization of on-demand Supplies [93a66d75] + + Fixed duplicate done/quit messages [9e179355] + + Fixed non-blocking `react { await blah() }` [29863a0b] + + Fixed issues with Int.new [dff7d9b2][0d2ca0d7][0834036d] + + Fixed isa method on a subset [cee1be22] + + Fixed Supply.zip to eager-shift its values [f9400d9a] + + Fixed two utf8-c8 bugs [963a0f06] + + Fixed infinite loop in .^roles of a class that does Rational [0961abe8] + + Changed uniname to give better strings for non-unique names [9dba498f] + + Fixed .push-all/.skip-all on SlippyIterators [41896b7b] + + Fixed and improved `**` regex quantifier [681d6be9][4ca1fc3c] + + Made cmp-ok to try harder to give useful description [8479a1ba] + + Made List.ACCEPTS non-fatal for lazy iterables [1b9638e2] + + Fixed some unspace parsing cases [11070e0f] + + Fixed &chdir failing to respect :CWD attribute [4906a1de] + + Fixed Blob.gist to trim its guts to 100 elements [ac8e5f43] + + Improved .perl and .gist methods on Maps and Hashes [aad8991e] + [39461368][381c4c3b] + + Fixed explosion in IO::CatHandle.nl-out [83008443] + + Fixed .pick and .roll on object hashes [12fcece4] + + Made cmp-ok take its arguments raw [3684384d] + + Fixed `is default(Mu)` on attributes [54507ac9] + + Made Array.List fill holes with Nil [e1351219] + + Fixed BagHash.grab with large values [975fcf6c] + + Fixed .tail with large values [43e7b893] + + Improved .gist of nodal methods [b6982e68][bb1df2cb] + + Fixed IO::Pipe.close not always returning the Proc [74328278] + + Fixed handling of type objects in set operators [8a88d149] + + Fixed location of errors coming from Channel [82a38c29] + + Fixed lockup when scheduling with degenerate delays [df01ad97][031f8cf7] + + Fixed segfault in getlexdyn [4f5fc520][4c370072] + + Fixed poor error with some slurpies with defaults [a92950fb] + + Fixed Int.new to properly give a new object [e4a5bb17] + + Fixed .STORE leaving behind elements on native arrays [a85c8d48] + + Various async improvements [633a15b8][ef4d16fe][f53d3963] + [26a9c313][9d903408][0d600a0c][54783920][e0e5e6fa][b16aba01] + [d8890a82][73aeee6c][2a826238][3deda842][f58ac999][40c2d0cd] + [c46de00f][e5c17462][6e42b37e][80f883bc][6af44f8d][e70969e3] + [30462d76][97b11edd] + + Various fixes and improvements to hyper/race [cc2a0643][2352efe5] + [d43b3738][dfa230f7][1fdc84fe][cef4806f][ea51d19b][374ee3e2] + [ad0dd8e7][41729e93][d74ba041][83676112][2580a0a6][cf1673d9] + [7e9b9633][870eaa31][d37a19ea][da977785][270e7c8a][ee3f0f4f] + [a042fd92] + + Various improvements to warnings and error reporting [38186fcd] + [cf95ce81][66c2d05f][a845ac3d][48a84d6a][bb45791c][279bae08] + [6542bb80][5747bc71][c7a82d45][fb7abf06][ac97a401][64b001a1] + [1ea3297b][56eef696][25c87d0d][5d3ebc09][de2b9ff7][084078e1] + [3acde358][b3bb8c40][e611978f][12774237][33e113a2][9554a97c] + + Additions: + + Improved .Capture semantics on all core types [4ba12ff1] + [bad9fefd][cd5864cf] + + Added trim* subroutines taking Cool instance [5a19dffa] + [691f8b7b][e01e5bc3] + + Added Lock::Async [53dd776c][4a8038c2][85bdd38a][38896402][6170cb9d] + + Added atomic reference op support on JVM backend [32e4a1de][59c4117f] + + Added $*USAGE [0b15f672] + + Added :bin parameter to IO::Handle.slurp [e2ec569b] + + Added support for Bufs in &EVAL/&EVALFILE [6c928d61] + + Added warning on typical precedence errors with infix:<..> [26bdc95c] + + Added --repl-mode command line option [9ce896d8][20518454] + [5c7bbea0][93e599db][de0533c4] + + Implemented typed pointer increment and array dereference + [3ca6554f][bc5fbfcb][2fba0ba0] + + Added X::Numeric::CannotConvert exception type [2e726528] + [b377de1c][f04bd1d6] + + Added IO::Handle.out-buffer for controlling the buffer size + [f9c10c21][765dd694] + + Added IO::Path.parent(Int) for getting up more than one level + [7bea3a2d][78d8d509] + + Removals: + + Removed $*MAIN-ALLOW-NAMED-ANYWHERE [9cb4b167] + + Removed support for ornate parenthesis from quoting constructs [9ce896d8] + + Renamed $*INITTIME to $*INIT-INSTANT according to the spec + [6bdb2dd3][bd6c6403] + + Build system: + + Reworked REPL tests [be4d57de][338a0972][7c8a2739][f8edb829][1ce3a36d] + + Various changes related to v6.d prep [7d830d5c][6cb810d2][36bc8e2d] + [31cbdada][16f64182][50d2013d][f62950dc][dd8a6102] + [36122f15][2a512f0c][03b1febc][edce8f53][c6ff787a] + + Efficiency: + + Made startup time up to 5 ms faster [48406db6][a09f5f21][bb5583ae] + + Made chained ops up to 36x faster [a92d0369] + + Made ≥, ≤, and ≠ unicode ops as fast as ascii equivalents + [6ec21cb4][1af2a745][43c348a8][9ff2f98f][6ad06fad] + + Made &infix: with Version:Ds 7.2x faster [1d9553f0] + + Made &DEPRECATED 27% faster when vfrom is too large [145e3156] + + Made Blob.gist 26x faster [20a99fc3] + + Made Hash.gist 24% faster [69af24c4] + + Made @a[42..*] 4.2x faster [456358e3] + + Various NativeCall speedups [a06ebaf2][269fe7db][80d6b425] + + Significantly faster interpolation of variables into regexes + [1761540e][0a68a18f][d73d500b][1775259a][e8003c87] + [4d3ccd83][04b171bd][317ae16c][dd880cad][2262cc47] + + Other small optimizations [9d4a833b][6902c590][fb4eb666] + [b9c98531][4fae0711][921db910][c91c4011][98fae3d8] + [a462d0a2][16c2a157][5f6896bd][397692ac][476741e7] + + Internal: + + New JIT [2724a851][ff063e7b] + + Better scheduler [d2eb7423][80b49320][340d8ed3][c50d35a9][9af5607d] + [683037be][7c18112c][c285b489][b5605c2d][3b98fb9e][596611c8] + [6f6e62ea][176a6fae][43b7cfde][59bfa5ab][27590e8b][e95eb42c] + [2c4868b8] + + Added RAKUDO_SCHEDULER_DEBUG_STATUS env var [de311f46] + + Bumped libuv to the latest version [198b8497] + + Reworked BUILDALL method autogeneration [9837687d][63cf246f] + [5ad2fffe][31a03a41][eb9c3d4d][346dfeff][70ca505a][af2ab751] + [5cd9197f][6824e192][7363f898][4959df3f][dd943ede][d3c48185] + [371befe8][4d0ead24][92f239b5][7fa707db][d76af6aa][e513b857] + [f80a8461][fcbd8adb][21788c89][e2f8a57d][b58bd8fb][0dd6af71] + [f946bd35][cef3bf3e][92e51c3d][5144216f][ebd6440c] + + +The following people contributed to this release: + +Zoffix Znet, Elizabeth Mattijsen, Pawel Murias, Jonathan Worthington, +Aleks-Daniel Jakimenko-Aleksejev, Will "Coke" Coleda, Tom Browder, +Christian Bartolomäus, Samantha McVey, Daniel Green, Steve Mynott, +Patrick Spek, Stefan Seifert, Luca Ferrari, Brian S. Julin, +Rafael Schipiura, Timo Paulssen, Alex Chen, David Warring, Cuong Manh Le, +Naoum Hankache, Alex Wander, Nick Logan, Wenzel P. P. Peppmeyer, 陈梓立, +Jeremy Studer, Brian Duggan, Larry Wall, Jan-Olof Hendig, Jonathan Stowe, +Christopher Bottoms, Itsuki Toyota, Dan Zwell, Philippe Bruhat (BooK), gerd, +lefth, Viacheslav Lotsmanov, Robert Lemmen, Shlomi Fish, Altai-man, +Jarkko Haapalainen + +If you would like to contribute or find out more information, visit +, , ask on the + mailing list, or ask on IRC #perl6 on freenode. + +Additionally, we invite you to make a donation to The Perl Foundation +to sponsor Perl 6 development: +(put “Perl 6 Core Development Fund” in the ‘Purpose’ text field) + +The next release of Rakudo (#117), is tentatively scheduled for 2017-11-18. + +A list of the other planned release dates is available in the +“docs/release_guide.pod” file. + +The development team appreciates feedback! If you’re using Rakudo, do +get back to us. Questions, comments, suggestions for improvements, cool +discoveries, incredible hacks, or any other feedback – get in touch with +us through (the above-mentioned) mailing list or IRC channel. Enjoy! + +Please note that recent releases have known issues running on the JVM. +We are working to get the JVM backend working again but do not yet have +an estimated delivery date. + +[^1]: See + +[^2]: What’s the difference between the Rakudo compiler and the Rakudo +Star distribution? + +The Rakudo compiler is a compiler for the Perl 6 language. +Not much more. + +The Rakudo Star distribution is the Rakudo compiler plus a selection +of useful Perl 6 modules, a module installer, Perl 6 introductory +documentation, and other software that can be used with the Rakudo +compiler to enhance its utility. diff --git a/docs/release_guide.pod b/docs/release_guide.pod index 6a688d690bc..717158b7623 100644 --- a/docs/release_guide.pod +++ b/docs/release_guide.pod @@ -450,7 +450,7 @@ Previous releases were bundled as part of monthly Parrot releases. 2017-07-15 Rakudo #113 "2017.07" (Zoffix + NeuralAnomaly) 2017-08-21 Rakudo #114 "2017.08" (AlexDaniel + Releasable) 2017-09-18 Rakudo #115 "2017.09" (AlexDaniel + Releasable) - 2017-10-23 Rakudo #116 "2017.10" (AlexDaniel + Releasable) + 2017-10-26 Rakudo #116 "2017.10" (AlexDaniel + Releasable) =head1 COPYRIGHT From 10e7af0091836db30e99f7f08ed00b4133b38033 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Thu, 26 Oct 2017 08:05:06 -0400 Subject: [PATCH 562/692] Zoffix isn't speshul anymore --- tools/contributors.pl6 | 1 - 1 file changed, 1 deletion(-) diff --git a/tools/contributors.pl6 b/tools/contributors.pl6 index 5b5c35152f4..6309451567f 100644 --- a/tools/contributors.pl6 +++ b/tools/contributors.pl6 @@ -33,7 +33,6 @@ sub MAIN ( my @contributors = @repos.map({ |get-committers($_,$last_release) }).unique(:as(*.key))».value.Bag.sort(-*.value)».key; - @contributors .= rotate if @contributors.head eq 'Zoffix Znet'; for @contributors -> $name is rw { state $length = 0; From 4b60df8f84fdf2ed8f5eab1426247fbc649d062c Mon Sep 17 00:00:00 2001 From: pmurias Date: Thu, 26 Oct 2017 14:09:19 +0200 Subject: [PATCH 563/692] Parameterize using type objects instead of native ints Native int pointer equality in parameterization depends on int caches and as such is fragile. --- src/Perl6/Metamodel/DefiniteHOW.nqp | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/src/Perl6/Metamodel/DefiniteHOW.nqp b/src/Perl6/Metamodel/DefiniteHOW.nqp index e75c738e11e..8e2ebb6caf5 100644 --- a/src/Perl6/Metamodel/DefiniteHOW.nqp +++ b/src/Perl6/Metamodel/DefiniteHOW.nqp @@ -30,9 +30,12 @@ class Perl6::Metamodel::DefiniteHOW #~ has @!mro; + my class Definite { } + my class NotDefinite { } + method new_type(:$base_type!, :$definite!) { my $root := nqp::parameterizetype((Perl6::Metamodel::DefiniteHOW.WHO), - [$base_type, $definite]); + [$base_type, $definite ?? Definite !! NotDefinite]); nqp::setdebugtypename($root, self.name($root)); } @@ -43,7 +46,7 @@ class Perl6::Metamodel::DefiniteHOW else { my $base_type := nqp::typeparameterat($definite_type, 0); my $definite := nqp::typeparameterat($definite_type, 1); - $base_type.HOW.name($base_type) ~ ':' ~ ($definite ?? 'D' !! 'U') + $base_type.HOW.name($base_type) ~ ':' ~ (nqp::eqaddr($definite, Definite) ?? 'D' !! 'U') } } @@ -54,7 +57,7 @@ class Perl6::Metamodel::DefiniteHOW else { my $base_type := nqp::typeparameterat($definite_type, 0); my $definite := nqp::typeparameterat($definite_type, 1); - $base_type.HOW.shortname($base_type) ~ ':' ~ ($definite ?? 'D' !! 'U') + $base_type.HOW.shortname($base_type) ~ ':' ~ (nqp::eqaddr($definite, Definite) ?? 'D' !! 'U') } } @@ -70,7 +73,7 @@ class Perl6::Metamodel::DefiniteHOW method definite($definite_type) { check_instantiated($definite_type); - nqp::typeparameterat($definite_type, 1) + nqp::eqaddr(nqp::typeparameterat($definite_type, 1), Definite) ?? 1 !! 0 } #~ # Our MRO is just that of base type. From 6eb576ba70544b72691dd006eacf53bcd044a417 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Thu, 26 Oct 2017 17:00:58 +0200 Subject: [PATCH 564/692] Make sure we don't use nqp::clone - as that's guaranteed to not be threadsafe after all - instead, introduce a "push-worker" sub - which copies the workers safely *and* adds the given worker --- src/core/ThreadPoolScheduler.pm | 44 ++++++++++++++++++++++----------- 1 file changed, 29 insertions(+), 15 deletions(-) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index 2866f983087..9e4e22fc5b0 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -422,9 +422,7 @@ my class ThreadPoolScheduler does Scheduler { return $chosen-queue; } my $new-worker := AffinityWorker.new(scheduler => self); - my $workers := nqp::clone($!affinity-workers); - nqp::push($workers, $new-worker); - $!affinity-workers := $workers; + $!affinity-workers := push-worker($!affinity-workers,$new-worker); scheduler-debug "Added an affinity worker thread"; $new-worker.queue } @@ -434,6 +432,23 @@ my class ThreadPoolScheduler does Scheduler { } } + # Since the worker lists can be changed during copying, we need to + # just take whatever we can get and assume that it may be gone by + # the time we get to it. + sub push-worker(\workers, \to-push) is raw { + my int $i = -1; + my $new-workers := nqp::create(IterationBuffer); + nqp::while( + nqp::islt_i(($i = nqp::add_i($i,1)),nqp::elems(workers)), + nqp::unless( + nqp::isnull(my $job := nqp::atpos(workers,$i)), + nqp::push($new-workers,$job) + ) + ); + nqp::push($new-workers,to-push); + $new-workers + } + # The supervisor sits in a loop, mostly sleeping. Each time it wakes up, # it takes stock of the current situation and decides whether or not to # add threads. @@ -444,29 +459,26 @@ my class ThreadPoolScheduler does Scheduler { $!supervisor = Thread.start(:app_lifetime, { sub add-general-worker() { $!state-lock.protect: { - my $workers := nqp::clone($!general-workers); - nqp::push( - $workers, + $!general-workers := push-worker( + $!general-workers, GeneralWorker.new( queue => $!general-queue, scheduler => self ) ); - $!general-workers := $workers; + } scheduler-debug "Added a general worker thread"; } sub add-timer-worker() { $!state-lock.protect: { - my $workers := nqp::clone($!timer-workers); - nqp::push( - $workers, + $!timer-workers := push-worker( + $!timer-workers, TimerWorker.new( queue => $!timer-queue, scheduler => self ) ); - $!timer-workers := $workers; } scheduler-debug "Added a timer worker thread"; } @@ -640,16 +652,15 @@ my class ThreadPoolScheduler does Scheduler { die "Initial thread pool threads ($!initial_threads) must be less than or equal to maximum threads ($!max_threads)" if $!initial_threads > $!max_threads; - $!general-workers := nqp::create(IterationBuffer); - $!timer-workers := nqp::create(IterationBuffer); - $!affinity-workers := nqp::create(IterationBuffer); + $!timer-workers := nqp::create(IterationBuffer); + $!affinity-workers := nqp::create(IterationBuffer); if $!initial_threads > 0 { # We've been asked to make some initial threads; we interpret this # as general workers. self!general-queue(); # Starts one worker if $!initial_threads > 1 { - my $workers := nqp::clone($!general-workers); + my $workers := nqp::create(IterationBuffer); my int $i = -1; nqp::while( nqp::islt_i(($i = nqp::add_i($i,1)),$!initial_threads), @@ -664,6 +675,9 @@ my class ThreadPoolScheduler does Scheduler { $!general-workers := $workers; } } + else { + $!general-workers := nqp::create(IterationBuffer); + } } method queue(Bool :$hint-time-sensitive, :$hint-affinity) { From 2aaa32c961e1760ba865846440a2a6552665119f Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Thu, 26 Oct 2017 17:12:58 +0200 Subject: [PATCH 565/692] Turns out we can nqp::clone after all - but keep the nice helper function :-) --- src/core/ThreadPoolScheduler.pm | 10 +--------- 1 file changed, 1 insertion(+), 9 deletions(-) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index 9e4e22fc5b0..56b737ff5fa 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -436,15 +436,7 @@ my class ThreadPoolScheduler does Scheduler { # just take whatever we can get and assume that it may be gone by # the time we get to it. sub push-worker(\workers, \to-push) is raw { - my int $i = -1; - my $new-workers := nqp::create(IterationBuffer); - nqp::while( - nqp::islt_i(($i = nqp::add_i($i,1)),nqp::elems(workers)), - nqp::unless( - nqp::isnull(my $job := nqp::atpos(workers,$i)), - nqp::push($new-workers,$job) - ) - ); + my $new-workers := nqp::clone(workers); nqp::push($new-workers,to-push); $new-workers } From f32033e385159a7eb37ab6ac6681fff3677adf19 Mon Sep 17 00:00:00 2001 From: Aleks-Daniel Jakimenko-Aleksejev Date: Fri, 27 Oct 2017 01:03:46 +0300 Subject: [PATCH 566/692] [release] Bump NQP revision to 2017.10 --- tools/build/NQP_REVISION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/build/NQP_REVISION b/tools/build/NQP_REVISION index 431f47f25b0..fdb5ef63666 100644 --- a/tools/build/NQP_REVISION +++ b/tools/build/NQP_REVISION @@ -1 +1 @@ -2017.09-136-g8fa082b +2017.10 From e6c6ed2b5b40642ad20a1a2adf58ba397d36cfce Mon Sep 17 00:00:00 2001 From: Aleks-Daniel Jakimenko-Aleksejev Date: Fri, 27 Oct 2017 01:03:47 +0300 Subject: [PATCH 567/692] [release] Bump VERSION to 2017.10 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index eae7db5dd46..fdb5ef63666 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -2017.09 +2017.10 From f40babb81e6bf8a33b0ef1cfb489bfd00801fbe1 Mon Sep 17 00:00:00 2001 From: Aleks-Daniel Jakimenko-Aleksejev Date: Fri, 27 Oct 2017 02:31:43 +0300 Subject: [PATCH 568/692] =?UTF-8?q?=E2=9A=A0=20=E2=80=9Cnom=E2=80=9D=20?= =?UTF-8?q?=E2=86=92=20=E2=80=9Cmaster=E2=80=9D?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit language_versions.md has a very interesting definition of “nom” and “master”, for now “master” is replaced with “some branch”. --- .travis.yml | 2 +- README.md | 4 ++-- appveyor.yml | 2 +- docs/architecture.svg | 4 ++-- docs/language_versions.md | 18 ++++++++---------- docs/release_guide.pod | 2 +- 6 files changed, 15 insertions(+), 17 deletions(-) diff --git a/.travis.yml b/.travis.yml index 5c8bf0514bc..c7264e5c68a 100644 --- a/.travis.yml +++ b/.travis.yml @@ -28,7 +28,7 @@ script: branches: only: - - nom + - master - /smoke-me/ notifications: diff --git a/README.md b/README.md index bf235ac1afc..e2dff8f9934 100644 --- a/README.md +++ b/README.md @@ -21,7 +21,7 @@ text file. ## Building and Installing Rakudo -[![Build Status](https://travis-ci.org/rakudo/rakudo.svg?branch=nom)](https://travis-ci.org/rakudo/rakudo) [![Build status](https://ci.appveyor.com/api/projects/status/github/rakudo/rakudo?svg=true)](https://ci.appveyor.com/project/rakudo/rakudo/branch/nom) +[![Build Status](https://travis-ci.org/rakudo/rakudo.svg?branch=master)](https://travis-ci.org/rakudo/rakudo) [![Build status](https://ci.appveyor.com/api/projects/status/github/rakudo/rakudo?svg=true)](https://ci.appveyor.com/project/rakudo/rakudo/branch/master) See the INSTALL.txt file for detailed prerequisites and build and installation instructions. @@ -117,7 +117,7 @@ Rakudo, its components, and the Perl 6 language specification. If you have a patch that fixes a bug or adds a new feature, please create a pull request using github's pull request infrastructure. -See [our contribution guidelines](https://github.com/rakudo/rakudo/blob/nom/CONTRIBUTING.md) for more information. +See [our contribution guidelines](https://github.com/rakudo/rakudo/blob/master/CONTRIBUTING.md) for more information. ## Line editing and tab completion diff --git a/appveyor.yml b/appveyor.yml index 9d8679b6a3b..74efbb20151 100644 --- a/appveyor.yml +++ b/appveyor.yml @@ -19,7 +19,7 @@ configuration: # Monitored branches branches: only: - - nom + - master - /smoke-me/ # To stop automatic build of VS solution files diff --git a/docs/architecture.svg b/docs/architecture.svg index 8ad9ea0b351..21a433dee63 100644 --- a/docs/architecture.svg +++ b/docs/architecture.svg @@ -47,8 +47,8 @@ The Perl Foundation - https://raw.github.com/rakudo/rakudo/nom/docs/architecture.svg - https://raw.github.com/rakudo/rakudo/nom/docs/architecture.html + https://raw.github.com/rakudo/rakudo/master/docs/architecture.svg + https://raw.github.com/rakudo/rakudo/master/docs/architecture.html en-US diff --git a/docs/language_versions.md b/docs/language_versions.md index 75e69199155..5884186d447 100644 --- a/docs/language_versions.md +++ b/docs/language_versions.md @@ -9,15 +9,13 @@ We want to provide a little more stability than we attain today in terms of releases, but at the same time don't want to slow down development notably. Therefore: -* Development work will continue on the nom branch (which we might rename, - but it'll end up bikeshed to death and it's in muscle memory, so we'll - probably leave it as is.) -* Commit policy on "nom" is pretty much as today -* The camelia bot will build from "nom" -* A "master" branch will be created and will become the default branch +* Development work will continue on the master branch +* Commit policy on "master" is pretty much as today +* The camelia bot will build from "master" +* Some other branch will be created and will become the default branch people pull, that things like rakudobrew build if asked to get the latest non-release, and that we release from -* An automated process will fast-forward master to catch up with nom at +* An automated process will fast-forward master to catch up with master at regular intervals, provided it meets a bunch of automated quality checks These automated quality checks are as follows: @@ -38,16 +36,16 @@ mistakes. ## Releases -Releases will be cut from master. The release manager will have the advantage +Releases will be cut from some branch. The release manager will have the advantage of knowing they are releasing something that has already passed a bunch of automated quality checks. The release process will be something like: -* Create a release branch based off master +* Create a release branch based off some branch * Do release-related commits in the branch (announcement, last change log updates, bump VERSION, etc.) * Cut the release (produce the tarball, etc.) * Tag the released commit -* Merge the release branch into nom (so it will end up merged into master +* Merge the release branch into master (so it will end up merged into some branch also later) We can script some of this (the branch creation, stubbing announcement, diff --git a/docs/release_guide.pod b/docs/release_guide.pod index 717158b7623..4846e3557d2 100644 --- a/docs/release_guide.pod +++ b/docs/release_guide.pod @@ -4,7 +4,7 @@ B<< NOTE: this guide is for a manual release process. You may want to use the automated process described in -L >> +L >> Rakudo’s development release cycle is the third Saturday of each month. From 6cb7ebfb9f8d1c0784ade7d4481bac389ef8860a Mon Sep 17 00:00:00 2001 From: MasterDuke17 Date: Thu, 26 Oct 2017 23:20:53 -0400 Subject: [PATCH 569/692] Use the new nqp::fromI_I in Int.new The op will create a new Int using the value of the given Int, but remove any mix-ins. --- src/core/Int.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/Int.pm b/src/core/Int.pm index bc818bdea4f..220e0d53135 100644 --- a/src/core/Int.pm +++ b/src/core/Int.pm @@ -28,11 +28,11 @@ my class Int does Real { # declared in BOOTSTRAP multi method new( \value) { self.new: value.Int } multi method new(int \value) { # rebox the value, so we get rid of any potential mixins - nqp::div_I(nqp::decont(value), 1, self) + nqp::fromI_I(nqp::decont(value), self) } multi method new(Int:D \value = 0) { # rebox the value, so we get rid of any potential mixins - nqp::div_I(nqp::decont(value), 1, self) + nqp::fromI_I(nqp::decont(value), self) } multi method perl(Int:D:) { From c15e80de19329b67b642fd5ce0e666eb298a1b4f Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Fri, 27 Oct 2017 10:14:17 +0200 Subject: [PATCH 570/692] Streamline IterationBuffer a bit - .elems and .push are no longer multis - give AT-POS its own proto just like BIND-POS - no other AT-POS will work anyway - make sure AT-POS/BIND-POS only take definite Ints --- src/core/IterationBuffer.pm | 13 +++++-------- 1 file changed, 5 insertions(+), 8 deletions(-) diff --git a/src/core/IterationBuffer.pm b/src/core/IterationBuffer.pm index d066b1e05be..b32fef5c213 100644 --- a/src/core/IterationBuffer.pm +++ b/src/core/IterationBuffer.pm @@ -15,18 +15,15 @@ my class IterationBuffer { nqp::setelems(self, 0) } - multi method elems(IterationBuffer:D:) { - nqp::elems(self) - } + method elems() { nqp::elems(self) } - multi method push(IterationBuffer:D: Mu \value) { - nqp::push(self, value) - } + method push(Mu \value) { nqp::push(self, value) } + proto method AT-POS(|) { * } multi method AT-POS(IterationBuffer:D: int $pos) is raw { nqp::atpos(self, $pos) } - multi method AT-POS(IterationBuffer:D: Int $pos) is raw { + multi method AT-POS(IterationBuffer:D: Int:D $pos) is raw { nqp::atpos(self, $pos) } @@ -34,7 +31,7 @@ my class IterationBuffer { multi method BIND-POS(IterationBuffer:D: int $pos, Mu \value) { nqp::bindpos(self, $pos, value) } - multi method BIND-POS(IterationBuffer:D: Int $pos, Mu \value) { + multi method BIND-POS(IterationBuffer:D: Int:D $pos, Mu \value) { nqp::bindpos(self, $pos, value) } From b849622ee2ef00c47d50365a6775a92b2c0a78eb Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Fri, 27 Oct 2017 10:43:28 +0200 Subject: [PATCH 571/692] Make .sum on native num arrays about 11x faster - on a 5 element num array - could not do that for native int arrays, as ints can overflow - should make the ThreadPoolScheduler supervisor leaner - as it calls .sum on a native num array about 100x / sec --- src/core/native_array.pm | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/src/core/native_array.pm b/src/core/native_array.pm index bb998ffadf3..f7085bc63c2 100644 --- a/src/core/native_array.pm +++ b/src/core/native_array.pm @@ -955,6 +955,21 @@ my class array does Iterable { #- PLEASE DON'T CHANGE ANYTHING ABOVE THIS LINE #- end of generated part of numarray role ------------------------------------- + method sum(numarray:D:) { + nqp::if( + (my int $elems = nqp::elems(self)), + nqp::stmts( + (my num $sum = nqp::atpos_n(self,0)), + (my int $i), + nqp::while( + nqp::islt_i(($i = nqp::add_i($i,1)),$elems), + $sum = nqp::add_n($sum,nqp::atpos_n(self,$i)) + ), + $sum + ), + 0e0 + ) + } multi method STORE(numarray:D: Range:D $range) { my num $val = $range.min; $val = $val + 1 if $range.excludes-min; From e513f19dfeb68162dd98132301059d80c1c91da5 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Fri, 27 Oct 2017 11:20:51 +0200 Subject: [PATCH 572/692] Streamline ThreadPoolScheduler!total-workers - make sure we don't box/unbox unneccesarily - add "is raw" so that we don't box/unbox on return - this appears to make the return from sub about 20% faster - when assigning to a native --- src/core/ThreadPoolScheduler.pm | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index 56b737ff5fa..bb919b8bc0e 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -632,8 +632,14 @@ my class ThreadPoolScheduler does Scheduler { } } - method !total-workers() { - $!general-workers.elems + $!timer-workers.elems + $!affinity-workers.elems + method !total-workers() is raw { + nqp::add_i( + nqp::elems($!general-workers), + nqp::add_i( + nqp::elems($!timer-workers), + nqp::elems($!affinity-workers) + ) + ) } submethod BUILD( From c9360203eb7874b3fcfaa4ec698a643cf617c3eb Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Fri, 27 Oct 2017 16:48:08 +0000 Subject: [PATCH 573/692] Improve X::ControlFlow::Return error Don't say we're outside of "any routine" when we're inside of one and the error is 'cause we're out of dyn scope. Fixes #1216 --- src/Perl6/Metamodel/BOOTSTRAP.nqp | 2 +- src/core/Exception.pm | 16 +++++++++++++--- 2 files changed, 14 insertions(+), 4 deletions(-) diff --git a/src/Perl6/Metamodel/BOOTSTRAP.nqp b/src/Perl6/Metamodel/BOOTSTRAP.nqp index 6c1d716403e..6c25eefe2ea 100644 --- a/src/Perl6/Metamodel/BOOTSTRAP.nqp +++ b/src/Perl6/Metamodel/BOOTSTRAP.nqp @@ -3340,7 +3340,7 @@ nqp::sethllconfig('perl6', nqp::hash( if $cat == nqp::const::CONTROL_RETURN { my %ex := nqp::gethllsym('perl6', 'P6EX'); if !nqp::isnull(%ex) && nqp::existskey(%ex,'X::ControlFlow::Return') { - nqp::atkey(%ex, 'X::ControlFlow::Return')(); + nqp::atkey(%ex, 'X::ControlFlow::Return')($out_of_dyn_scope); } nqp::die('Attempt to return outside of any Routine'); } diff --git a/src/core/Exception.pm b/src/core/Exception.pm index 10714c5d311..29cc05016d7 100644 --- a/src/core/Exception.pm +++ b/src/core/Exception.pm @@ -2132,9 +2132,19 @@ my class X::ControlFlow is Exception { method message() { "$.illegal without $.enclosing" } } my class X::ControlFlow::Return is X::ControlFlow { + has Bool $.out-of-dynamic-scope; + submethod BUILD(Bool() :$!out-of-dynamic-scope) {} + method illegal() { 'return' } method enclosing() { 'Routine' } - method message() { 'Attempt to return outside of any Routine' } + method message() { + 'Attempt to return outside of ' ~ ( + $!out-of-dynamic-scope + ?? 'immediatelly-enclosing Routine (i.e. `return` execution is' + ~ ' outside the dynamic scope of the Routine where `return` was used)' + !! 'any Routine' + ) + } } my class X::Composition::NotComposable does X::Comp { @@ -2627,8 +2637,8 @@ nqp::bindcurhllsym('P6EX', BEGIN nqp::hash( X::Assignment::RO.new(:$value).throw; }, 'X::ControlFlow::Return', - { - X::ControlFlow::Return.new().throw; + -> $out-of-dynamic-scope = False { + X::ControlFlow::Return.new(:$out-of-dynamic-scope).throw; }, 'X::NoDispatcher', -> $redispatcher { From 6ac53e4276a788a6bcdfa98bc30c7a7c9f6f07a5 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Fri, 27 Oct 2017 19:34:53 +0200 Subject: [PATCH 574/692] Mark all subs/methods not returning anything - hopefully allowing optimizers to do their thing --- src/core/ThreadPoolScheduler.pm | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index bb919b8bc0e..a1c246c9668 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -7,12 +7,12 @@ my class ThreadPoolScheduler does Scheduler { # Scheduler debug, controlled by an environment variable. my $scheduler-debug = so %*ENV; my $scheduler-debug-status = so %*ENV; - sub scheduler-debug($message) { + sub scheduler-debug($message --> Nil) { if $scheduler-debug { note "[SCHEDULER] $message"; } } - sub scheduler-debug-status($message) { + sub scheduler-debug-status($message --> Nil) { if $scheduler-debug-status { note "[SCHEDULER] $message"; } @@ -219,7 +219,7 @@ my class ThreadPoolScheduler does Scheduler { $taken } - method !run-one(\task) { + method !run-one(\task --> Nil) { $!working = 1; nqp::continuationreset(THREAD_POOL_PROMPT, { if nqp::istype(task, List) { @@ -446,10 +446,10 @@ my class ThreadPoolScheduler does Scheduler { # add threads. my constant SUPERVISION_INTERVAL = 0.01; my constant LAST_UTILS_NUM = 5; - method !maybe-start-supervisor() { + method !maybe-start-supervisor(--> Nil) { unless $!supervisor.DEFINITE { $!supervisor = Thread.start(:app_lifetime, { - sub add-general-worker() { + sub add-general-worker(--> Nil) { $!state-lock.protect: { $!general-workers := push-worker( $!general-workers, @@ -462,7 +462,7 @@ my class ThreadPoolScheduler does Scheduler { } scheduler-debug "Added a general worker thread"; } - sub add-timer-worker() { + sub add-timer-worker(--> Nil) { $!state-lock.protect: { $!timer-workers := push-worker( $!timer-workers, @@ -530,7 +530,7 @@ my class ThreadPoolScheduler does Scheduler { } } - method !prod-affinity-workers (\worker-list) { + method !prod-affinity-workers (\worker-list --> Nil) { for ^worker-list.elems { my $worker := worker-list[$_]; if $worker.working { @@ -584,7 +584,7 @@ my class ThreadPoolScheduler does Scheduler { ) ); - sub heuristic-check-for-deadlock { + sub heuristic-check-for-deadlock(--> Nil) { my int $average-times-nothing-completed = $total-times-nothing-completed div (worker-list.elems || 1); if $average-times-nothing-completed > 20 { From 2cd568f989346b1d3d6d7af37eaedb80b2abb841 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Fri, 27 Oct 2017 20:37:52 +0200 Subject: [PATCH 575/692] Get some more mileage out of push-worker() - should improve readability --- src/core/ThreadPoolScheduler.pm | 12 ++++-------- 1 file changed, 4 insertions(+), 8 deletions(-) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index a1c246c9668..ee9861febd3 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -339,15 +339,13 @@ my class ThreadPoolScheduler does Scheduler { unless $!timer-queue.DEFINITE { # We don't have any workers yet, so start one. $!timer-queue := nqp::create(Queue); - my $workers := nqp::create(IterationBuffer); - nqp::push( - $workers, + $!timer-workers := push-worker( + nqp::create(IterationBuffer), TimerWorker.new( queue => $!timer-queue, scheduler => self ) ); - $!timer-workers := $workers; scheduler-debug "Created initial timer worker thread"; self!maybe-start-supervisor(); } @@ -365,14 +363,12 @@ my class ThreadPoolScheduler does Scheduler { if $!affinity-workers.elems == 0 { # We don't have any affinity workers yet, so start one # and return its queue. - my $workers := nqp::create(IterationBuffer); - nqp::push( - $workers, + $!affinity-workers := push-worker( + nqp::create(IterationBuffer), AffinityWorker.new( scheduler => self ) ); - $!affinity-workers := $workers; scheduler-debug "Created initial affinity worker thread"; self!maybe-start-supervisor(); return $!affinity-workers[0].queue; From 6bf5892125ddc19cfa123767813fd0b73a42f6dc Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Fri, 27 Oct 2017 21:10:32 +0200 Subject: [PATCH 576/692] Only tweak-workers if there's something to tweak - tweak-workers should now only be called if there's something in the queue - by moving the test outside, we don't need to call tweak-workers - makes test-t 20 race about 3% faster --- src/core/ThreadPoolScheduler.pm | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index ee9861febd3..5b53d5f2ca7 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -505,11 +505,11 @@ my class ThreadPoolScheduler does Scheduler { my $smooth-per-core-util = @last-utils.sum; scheduler-debug-status "Per-core utilization (approx): $smooth-per-core-util%"; - if $!general-queue.DEFINITE { + if $!general-queue.DEFINITE && $!general-queue.elems { self!tweak-workers: $!general-queue, $!general-workers, &add-general-worker, $cpu-cores, $smooth-per-core-util; } - if $!timer-queue.DEFINITE { + if $!timer-queue.DEFINITE && $!timer-queue.elems { self!tweak-workers: $!timer-queue, $!timer-workers, &add-timer-worker, $cpu-cores, $smooth-per-core-util; } @@ -552,12 +552,11 @@ my class ThreadPoolScheduler does Scheduler { nqp::atpos_i(rusage, nqp::const::RUSAGE_STIME_MSEC) } + # Tweak workers for non-empty queues method !tweak-workers(\queue, \worker-list, &add-worker, $cores, $per-core-util) { - # If there's nothing in the queue, nothing could need an extra worker. - return if queue.elems == 0; # Go through the worker list. If something is not working, then there - # is at lesat one worker free to process things in the queue, so we + # is at least one worker free to process things in the queue, so we # don't need to add one. my int $total-completed; my int $total-times-nothing-completed; From 6de66df71923a0b926098a0af47099861b056988 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Fri, 27 Oct 2017 21:55:58 +0200 Subject: [PATCH 577/692] Don't shift/push the samples array - just index % 5 into it since we have a fixed size array - rename LAST_UTILS_NUM to NUM_SAMPLES for more readability --- src/core/ThreadPoolScheduler.pm | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index 5b53d5f2ca7..9fb45cd00fe 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -441,7 +441,7 @@ my class ThreadPoolScheduler does Scheduler { # it takes stock of the current situation and decides whether or not to # add threads. my constant SUPERVISION_INTERVAL = 0.01; - my constant LAST_UTILS_NUM = 5; + my constant NUM_SAMPLES = 5; method !maybe-start-supervisor(--> Nil) { unless $!supervisor.DEFINITE { $!supervisor = Thread.start(:app_lifetime, { @@ -474,7 +474,8 @@ my class ThreadPoolScheduler does Scheduler { scheduler-debug "Supervisor started"; my num $last-rusage-time = nqp::time_n; my int $last-usage = self!getrusage-total(); - my num @last-utils = 0e0 xx LAST_UTILS_NUM; + my num @last-utils = 0e0 xx NUM_SAMPLES; + my int $sampled; my int $cpu-cores = nqp::cpucores(); scheduler-debug "Supervisor thinks there are $cpu-cores CPU cores"; loop { @@ -496,12 +497,11 @@ my class ThreadPoolScheduler does Scheduler { my num $normalized-delta = $usage-delta / $rusage-period; my num $per-core = $normalized-delta / $cpu-cores; my num $per-core-util = - 100 * ($per-core / (1000000 * LAST_UTILS_NUM)); + 100 * ($per-core / (1000000 * NUM_SAMPLES)); # Since those values are noisy, average the last - # LAST_UTILS_NUM values to get a smoothed value. - @last-utils.shift; - @last-utils.push: $per-core-util; + # NUM_SAMPLES values to get a smoothed value. + @last-utils[++$sampled % NUM_SAMPLES] = $per-core-util; my $smooth-per-core-util = @last-utils.sum; scheduler-debug-status "Per-core utilization (approx): $smooth-per-core-util%"; From 6aa150db03536603c401a05711ab45244b90f2cf Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Fri, 27 Oct 2017 23:31:20 +0200 Subject: [PATCH 578/692] Use shift/push again - but as nqp::shift/nqp::push, timotimo++ for pointing out - don't think it suffers too much in readability from the original shift/push - indexing solution was about 2x as fast as the original shift/push - this is again 4x faster than the indexing solution - shaves off about 1% of test-t 20 race --- src/core/ThreadPoolScheduler.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index 9fb45cd00fe..db548cd10e2 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -475,7 +475,6 @@ my class ThreadPoolScheduler does Scheduler { my num $last-rusage-time = nqp::time_n; my int $last-usage = self!getrusage-total(); my num @last-utils = 0e0 xx NUM_SAMPLES; - my int $sampled; my int $cpu-cores = nqp::cpucores(); scheduler-debug "Supervisor thinks there are $cpu-cores CPU cores"; loop { @@ -501,7 +500,8 @@ my class ThreadPoolScheduler does Scheduler { # Since those values are noisy, average the last # NUM_SAMPLES values to get a smoothed value. - @last-utils[++$sampled % NUM_SAMPLES] = $per-core-util; + nqp::shift_n(@last-utils); + nqp::push_n(@last-utils,$per-core-util); my $smooth-per-core-util = @last-utils.sum; scheduler-debug-status "Per-core utilization (approx): $smooth-per-core-util%"; From 09e038cd886861a575a7b205197a90b398b53d9c Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Fri, 27 Oct 2017 23:58:44 +0200 Subject: [PATCH 579/692] Make getrusage-total a sub - we only need it in the supervisor loop - and it doesn't do anything with self - more for readability and scoping than anything else --- src/core/ThreadPoolScheduler.pm | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index db548cd10e2..84c8480468e 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -471,9 +471,17 @@ my class ThreadPoolScheduler does Scheduler { scheduler-debug "Added a timer worker thread"; } + sub getrusage-total() is raw { + my \rusage = nqp::getrusage(); + nqp::atpos_i(rusage, nqp::const::RUSAGE_UTIME_SEC) * 1000000 + + nqp::atpos_i(rusage, nqp::const::RUSAGE_UTIME_MSEC) + + nqp::atpos_i(rusage, nqp::const::RUSAGE_STIME_SEC) * 1000000 + + nqp::atpos_i(rusage, nqp::const::RUSAGE_STIME_MSEC) + } + scheduler-debug "Supervisor started"; my num $last-rusage-time = nqp::time_n; - my int $last-usage = self!getrusage-total(); + my int $last-usage = getrusage-total; my num @last-utils = 0e0 xx NUM_SAMPLES; my int $cpu-cores = nqp::cpucores(); scheduler-debug "Supervisor thinks there are $cpu-cores CPU cores"; @@ -487,7 +495,7 @@ my class ThreadPoolScheduler does Scheduler { my num $now = nqp::time_n; my num $rusage-period = $now - $last-rusage-time; $last-rusage-time = $now; - my int $current-usage = self!getrusage-total(); + my int $current-usage = getrusage-total(); my int $usage-delta = $current-usage - $last-usage; $last-usage = $current-usage; @@ -544,14 +552,6 @@ my class ThreadPoolScheduler does Scheduler { } } - method !getrusage-total() { - my \rusage = nqp::getrusage(); - nqp::atpos_i(rusage, nqp::const::RUSAGE_UTIME_SEC) * 1000000 + - nqp::atpos_i(rusage, nqp::const::RUSAGE_UTIME_MSEC) + - nqp::atpos_i(rusage, nqp::const::RUSAGE_STIME_SEC) * 1000000 + - nqp::atpos_i(rusage, nqp::const::RUSAGE_STIME_MSEC) - } - # Tweak workers for non-empty queues method !tweak-workers(\queue, \worker-list, &add-worker, $cores, $per-core-util) { From 322dcc9795e0c4c2982bc3803f69e6376443290b Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sat, 28 Oct 2017 00:36:10 +0200 Subject: [PATCH 580/692] Bump NQP to get GC fix in Moar - related to cas() issues under stress, but no definite fix yet :-( - also seems to stability of GH #1202 code --- tools/build/NQP_REVISION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/build/NQP_REVISION b/tools/build/NQP_REVISION index fdb5ef63666..d5ffb35af8b 100644 --- a/tools/build/NQP_REVISION +++ b/tools/build/NQP_REVISION @@ -1 +1 @@ -2017.10 +2017.10-1-g8b21489 From ad16c6fb8635e081f92135c5ce4e0a0f41aed63a Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 28 Oct 2017 04:09:12 +0000 Subject: [PATCH 581/692] Fix quote lang cache regression Fixes RT#132262: https://rt.perl.org/Ticket/Display.html?id=132262 After the Big Slang Refactor, the quote lang cache started to fail to notice when the cached lang was mutated (e.g. by defining a new prefix op). This caused failure to parse new ops, such as behaviour in the ticket, since the new quoted block still used the old pre-op-mixin lang. Fix by adding the name of the lang object to key the cache on. --- src/Perl6/Grammar.nqp | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Perl6/Grammar.nqp b/src/Perl6/Grammar.nqp index b58b684e3eb..7b8e4106144 100644 --- a/src/Perl6/Grammar.nqp +++ b/src/Perl6/Grammar.nqp @@ -65,7 +65,9 @@ role STD { method quote_lang($l, $start, $stop, @base_tweaks?, @extra_tweaks?) { sub lang_key() { my $stopstr := nqp::istype($stop,VMArray) ?? nqp::join(' ',$stop) !! $stop; - my @keybits := [$l.HOW.name($l), $start, $stopstr]; + my @keybits := [ + self.HOW.name(self), $l.HOW.name($l), $start, $stopstr + ]; for @base_tweaks { @keybits.push($_); } From 9dba8e5bc38ae3ad12327722d64c0ba6b0c05c4f Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 28 Oct 2017 04:16:54 +0000 Subject: [PATCH 582/692] Bump NQP --- tools/build/NQP_REVISION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/build/NQP_REVISION b/tools/build/NQP_REVISION index d5ffb35af8b..14839fe8bc9 100644 --- a/tools/build/NQP_REVISION +++ b/tools/build/NQP_REVISION @@ -1 +1 @@ -2017.10-1-g8b21489 +2017.10-2-ge5849c4 From 6a6cea38568826f29adf03b3a6c24e9a7cf7b2a0 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sat, 28 Oct 2017 12:08:23 +0200 Subject: [PATCH 583/692] Bump NQP for the latest MoarVM goodies --- tools/build/NQP_REVISION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/build/NQP_REVISION b/tools/build/NQP_REVISION index 14839fe8bc9..6ebee41e8c9 100644 --- a/tools/build/NQP_REVISION +++ b/tools/build/NQP_REVISION @@ -1 +1 @@ -2017.10-2-ge5849c4 +2017.10-3-g8f18b6a From a7972a0ce45da73ac346f73946b02fe14c857c7f Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sat, 28 Oct 2017 12:29:39 +0200 Subject: [PATCH 584/692] Make sure we have a general queue when stealing - although unlikely, it is possible to have no general queue at that point --- src/core/ThreadPoolScheduler.pm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index 84c8480468e..7b2050ee265 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -546,7 +546,8 @@ my class ThreadPoolScheduler does Scheduler { if $worker.times-nothing-completed > 10 { scheduler-debug "Stealing queue from affinity worker"; my $item := nqp::queuepoll($worker.queue); - nqp::push($!general-queue, $item) unless nqp::isnull($item); + nqp::push(self!general-queue, $item) + unless nqp::isnull($item); } } } From a1866b7b3339099c06ffb7ee28e721d16558f0a1 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sat, 28 Oct 2017 13:35:50 +0200 Subject: [PATCH 585/692] Always set up $*PID - needed it earlier for debugging message - seems to have a stabilizing effect wrt GH #1202, at least on MacOS - registering the cheap dynamic was probably relatively expensive anyway --- src/core/Process.pm | 4 ---- src/core/ThreadPoolScheduler.pm | 9 +++++++-- 2 files changed, 7 insertions(+), 6 deletions(-) diff --git a/src/core/Process.pm b/src/core/Process.pm index e9085759281..2b4e7a92367 100644 --- a/src/core/Process.pm +++ b/src/core/Process.pm @@ -9,10 +9,6 @@ Rakudo::Internals.REGISTER-DYNAMIC: '$*RAKUDO_MODULE_DEBUG', { !! False } -Rakudo::Internals.REGISTER-DYNAMIC: '$*PID', { - PROCESS::<$PID> := nqp::p6box_i(nqp::getpid()); -} - Rakudo::Internals.REGISTER-DYNAMIC: '$*EXECUTABLE', { PROCESS::<$EXECUTABLE> := ( #?if jvm diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index 7b2050ee265..f4cd88e557d 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -4,17 +4,22 @@ my class ThreadPoolScheduler does Scheduler { method elems() { nqp::elems(self) } } + # Initialize $*PID here, as we need it for the debug message + # anyway *and* it appears to have a positive effect on stability + # specifically wrt GH #1202. + PROCESS::<$PID> := nqp::p6box_i(my $pid := nqp::getpid); + # Scheduler debug, controlled by an environment variable. my $scheduler-debug = so %*ENV; my $scheduler-debug-status = so %*ENV; sub scheduler-debug($message --> Nil) { if $scheduler-debug { - note "[SCHEDULER] $message"; + note "[SCHEDULER $pid] $message"; } } sub scheduler-debug-status($message --> Nil) { if $scheduler-debug-status { - note "[SCHEDULER] $message"; + note "[SCHEDULER $pid] $message"; } } From 260e4a3a27149b65d15f80a9e98791d946165695 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sat, 28 Oct 2017 14:04:42 +0200 Subject: [PATCH 586/692] Only call debug status sub if debug status set - this is the only place so far where debug status is called - it's inside the hot loop, so makes sense to not always take the call overhead - makes the supervisor idle overhead drop from 37 to 33 msec / second --- src/core/ThreadPoolScheduler.pm | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index f4cd88e557d..45ca977e382 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -10,8 +10,8 @@ my class ThreadPoolScheduler does Scheduler { PROCESS::<$PID> := nqp::p6box_i(my $pid := nqp::getpid); # Scheduler debug, controlled by an environment variable. - my $scheduler-debug = so %*ENV; - my $scheduler-debug-status = so %*ENV; + my int $scheduler-debug = so %*ENV; + my int $scheduler-debug-status = so %*ENV; sub scheduler-debug($message --> Nil) { if $scheduler-debug { note "[SCHEDULER $pid] $message"; @@ -516,7 +516,8 @@ my class ThreadPoolScheduler does Scheduler { nqp::shift_n(@last-utils); nqp::push_n(@last-utils,$per-core-util); my $smooth-per-core-util = @last-utils.sum; - scheduler-debug-status "Per-core utilization (approx): $smooth-per-core-util%"; + scheduler-debug-status "Per-core utilization (approx): $smooth-per-core-util%" + if $scheduler-debug-status; if $!general-queue.DEFINITE && $!general-queue.elems { self!tweak-workers: $!general-queue, $!general-workers, From 3bd756f549ddeda77871b72aeef4efc146d808f6 Mon Sep 17 00:00:00 2001 From: Stefan Seifert Date: Sat, 28 Oct 2017 15:43:26 +0200 Subject: [PATCH 587/692] Support rw integer arguments of JIT compiled native subs After the call to the native function, we need to read back the changed values from the args buffer. We can't use the param_* ops there because we don't set up a call frame for the native call. Thus the param_* ops would read the HLL sub's arguments instead of the native function's. We use the new getarg_i op instead to get the changed value and assign it to the lexicalref for the rw parameter. --- lib/NativeCall.pm6 | 49 +++++++++++++++++++++++++++++++++++----- tools/build/NQP_REVISION | 2 +- 2 files changed, 44 insertions(+), 7 deletions(-) diff --git a/lib/NativeCall.pm6 b/lib/NativeCall.pm6 index 5497b5b71e9..9044300c0d9 100644 --- a/lib/NativeCall.pm6 +++ b/lib/NativeCall.pm6 @@ -331,10 +331,11 @@ our role Native[Routine $r, $libname where Str|Callable|List|IO::Path|Distributi method !create-jit-compiled-function-body(Routine $r) { my $block := QAST::Block.new(:name($r.name), :arity($!arity), :blocktype('declaration_static')); my $locals = 0; - my @deconts; - my @params; + my $args = 0; + my (@params, @assigns); for $r.signature.params { next if nqp::istype($r, Method) && ($_.name // '') eq '%_'; + $args++; my $name = $_.name || '__anonymous_param__' ~ $++; my $lowered_param_name = '__lowered_param__' ~ $locals; my $lowered_name = '__lowered__' ~ $locals++; @@ -350,13 +351,27 @@ our role Native[Routine $r, $libname where Str|Callable|List|IO::Path|Distributi ), ); @params.push: QAST::Var.new(:scope, :name($lowered_name)); - @deconts.push: QAST::Var.new( + $block.push: QAST::Var.new( :name($lowered_param_name), :scope, :decl, :slurpy($_.slurpy ?? 1 !! 0), ); - @deconts.push: QAST::Op.new( + if $_.rw and nqp::objprimspec($_.type) > 0 { + $block.push: QAST::Var.new( + :name($name), + :scope, + :decl, + :returns($_.type), + ); + $block.push: + QAST::Op.new( + :op, + QAST::Var.new(:scope, :name($name)), + QAST::Var.new(:scope, :name($lowered_param_name)), + ); + } + $block.push: QAST::Op.new( :op, QAST::Op.new( :op, @@ -379,8 +394,15 @@ our role Native[Routine $r, $libname where Str|Callable|List|IO::Path|Distributi !! QAST::IVal.new(:value(0)) ), ); + + if $_.rw and nqp::objprimspec($_.type) > 0 { + @assigns.push: QAST::Op.new( + :op, + QAST::Var.new(:scope, :name($name)), + QAST::Op.new(:op, QAST::IVal.new(:value($args - 1))), + ); + } } - $block.push: nqp::decont($_) for @deconts; # do not interrupt the locals definitions $!rettype := nqp::decont(map_return_type($r.returns)) unless $!rettype; my $invoke_op := QAST::Op.new( :op, @@ -388,7 +410,22 @@ our role Native[Routine $r, $libname where Str|Callable|List|IO::Path|Distributi QAST::WVal.new(:value($!rettype)), ); $invoke_op.push: nqp::decont($_) for @params; - $block.push: $invoke_op; + if @assigns { + $block.push: QAST::Op.new( + :op, + QAST::Var.new( + :name, + :scope, + :decl, + ), + $invoke_op + ); + $block.push: nqp::decont($_) for @assigns; + $block.push: QAST::Var.new(:name, :scope); + } + else { + $block.push: $invoke_op; + } $block } diff --git a/tools/build/NQP_REVISION b/tools/build/NQP_REVISION index 6ebee41e8c9..97927452b17 100644 --- a/tools/build/NQP_REVISION +++ b/tools/build/NQP_REVISION @@ -1 +1 @@ -2017.10-3-g8f18b6a +2017.10-4-g225fdfce3 From 0a029db60cf39358a008f43b59df699abe953a52 Mon Sep 17 00:00:00 2001 From: Stefan Seifert Date: Sat, 28 Oct 2017 16:50:07 +0200 Subject: [PATCH 588/692] Treat undefined strings correctly in JIT compiled native subs --- lib/NativeCall.pm6 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/NativeCall.pm6 b/lib/NativeCall.pm6 index 9044300c0d9..6206d250bc9 100644 --- a/lib/NativeCall.pm6 +++ b/lib/NativeCall.pm6 @@ -388,7 +388,7 @@ our role Native[Routine $r, $libname where Str|Callable|List|IO::Path|Distributi QAST::Op.new( :op, QAST::Var.new(:scope, :name($lowered_name)), - $_.type ~~ Str ?? QAST::SVal.new() + $_.type ~~ Str ?? Str !! $_.type ~~ Int ?? QAST::IVal.new(:value(0)) !! $_.type ~~ Num ?? QAST::NVal.new(:value(0)) !! QAST::IVal.new(:value(0)) From d05e61df95446c3cbc0aad6d3803fa4657e12e32 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sat, 28 Oct 2017 17:08:03 +0200 Subject: [PATCH 589/692] Bump NQP to get latest Moar gc fixes. --- tools/build/NQP_REVISION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/build/NQP_REVISION b/tools/build/NQP_REVISION index 97927452b17..97b0fb4b6e0 100644 --- a/tools/build/NQP_REVISION +++ b/tools/build/NQP_REVISION @@ -1 +1 @@ -2017.10-4-g225fdfce3 +2017.10-5-g9fc2e1f From 8203073db0615399e741718b06461fe597cc1caa Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sat, 28 Oct 2017 18:50:31 +0200 Subject: [PATCH 590/692] Get the latest MoarVM again --- tools/build/NQP_REVISION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/build/NQP_REVISION b/tools/build/NQP_REVISION index 97b0fb4b6e0..6145bcb719b 100644 --- a/tools/build/NQP_REVISION +++ b/tools/build/NQP_REVISION @@ -1 +1 @@ -2017.10-5-g9fc2e1f +2017.10-6-ge5c0926 From a9b8854a2531dc8d867ca08b0d39cd709fcd3b5e Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sat, 28 Oct 2017 20:36:56 +0200 Subject: [PATCH 591/692] Make Queue.elems and .loads about 1.8x faster Apparently when assigning to native from a sub returning a native adding "is raw" makes it about 1.8x as fast. Probably because it sees it doesn't need to box/unbox. --- src/core/ThreadPoolScheduler.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index 45ca977e382..803155cc33a 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -1,7 +1,7 @@ my class ThreadPoolScheduler does Scheduler { # A concurrent, blocking-on-receive queue. my class Queue is repr('ConcBlockingQueue') { - method elems() { nqp::elems(self) } + method elems() is raw { nqp::elems(self) } } # Initialize $*PID here, as we need it for the debug message @@ -767,7 +767,7 @@ my class ThreadPoolScheduler does Scheduler { -> { code(); CATCH { default { catch($_) } } } } - method loads() { + method loads() is raw { my int $loads = 0; $loads = $loads + $!general-queue.elems if $!general-queue; $loads = $loads + $!timer-queue.elems if $!timer-queue; From 61af87bcd9145382d0d0e97069405e76777021b3 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sat, 28 Oct 2017 20:57:06 +0200 Subject: [PATCH 592/692] Introducing Kernel.cpu-cores - callable as class and instance method - no documentation yet - no tests yet --- src/core/Kernel.pm | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/core/Kernel.pm b/src/core/Kernel.pm index f0ef6086bde..2031e44056d 100644 --- a/src/core/Kernel.pm +++ b/src/core/Kernel.pm @@ -168,6 +168,8 @@ class Kernel does Systemic { multi method signal(Kernel:D: Signal:D \signal --> Int:D) { signal.value } multi method signal(Kernel:D: Int:D \signal --> Int:D) { signal } + + method cpu-cores() is raw { nqp::cpucores } } Rakudo::Internals.REGISTER-DYNAMIC: '$*KERNEL', { From cbd4f212a45861179efe46ab9ed09aa11952f284 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sat, 28 Oct 2017 21:45:30 +0200 Subject: [PATCH 593/692] Introducing Usage (name to be bikeshedded) - exposing nqp::getrusage information - methods: cpu, cpu-user, cpu-sys providing microsecond accuracy - method: interval, returning CPU microseconds since last call - can all be called as class and as instance method - also provides infix:<->(Usage,Usage) for convenience --- src/core/Usage.pm | 56 +++++++++++++++++++++++++++++++++++ tools/build/jvm_core_sources | 1 + tools/build/moar_core_sources | 1 + 3 files changed, 58 insertions(+) create mode 100644 src/core/Usage.pm diff --git a/src/core/Usage.pm b/src/core/Usage.pm new file mode 100644 index 00000000000..b279069a8c2 --- /dev/null +++ b/src/core/Usage.pm @@ -0,0 +1,56 @@ +# An attempt at providing an API to nqp::getrusage. + +class Usage { + has int $!cpu-user; + has int $!cpu-sys; + + submethod BUILD(--> Nil) { + my \rusage = nqp::getrusage; + $!cpu-user = nqp::atpos_i(rusage, nqp::const::RUSAGE_UTIME_SEC) * 1000000 + + nqp::atpos_i(rusage, nqp::const::RUSAGE_UTIME_MSEC); + $!cpu-sys = nqp::atpos_i(rusage, nqp::const::RUSAGE_STIME_SEC) * 1000000 + + nqp::atpos_i(rusage, nqp::const::RUSAGE_STIME_MSEC); + } + + proto method cpu() { * } + multi method cpu(Usage:U:) is raw { + my \rusage = nqp::getrusage; + nqp::atpos_i(rusage, nqp::const::RUSAGE_UTIME_SEC) * 1000000 + + nqp::atpos_i(rusage, nqp::const::RUSAGE_UTIME_MSEC) + + nqp::atpos_i(rusage, nqp::const::RUSAGE_STIME_SEC) * 1000000 + + nqp::atpos_i(rusage, nqp::const::RUSAGE_STIME_MSEC) + } + multi method cpu(Usage:D:) is raw { + nqp::add_i($!cpu-user,$!cpu-sys) + } + + proto method cpu-user() { * } + multi method cpu-user(Usage:U:) is raw { + my \rusage = nqp::getrusage; + nqp::atpos_i(rusage, nqp::const::RUSAGE_UTIME_SEC) * 1000000 + + nqp::atpos_i(rusage, nqp::const::RUSAGE_UTIME_MSEC) + } + multi method cpu-user(Usage:D:) is raw { $!cpu-user } + + proto method cpu-sys() { * } + multi method cpu-sys(Usage:U:) is raw { + my \rusage = nqp::getrusage; + nqp::atpos_i(rusage, nqp::const::RUSAGE_STIME_SEC) * 1000000 + + nqp::atpos_i(rusage, nqp::const::RUSAGE_STIME_MSEC) + } + multi method cpu-sys(Usage:D:) is raw { $!cpu-sys } + + proto method interval() { * } + multi method interval(Usage:U \SELF:) is raw { SELF = SELF.new; 0 } + multi method interval(Usage:D \SELF:) is raw { + my int $cpu = (my $new := Usage.new) - SELF; + SELF = $new; + $cpu; + } +} + +multi sub infix:<->(Usage $a, Usage $b) { + $a.cpu - $b.cpu +} + +# vim: ft=perl6 expandtab sw=4 diff --git a/tools/build/jvm_core_sources b/tools/build/jvm_core_sources index 6bdb4c1b5c1..c2acf01bcde 100644 --- a/tools/build/jvm_core_sources +++ b/tools/build/jvm_core_sources @@ -161,6 +161,7 @@ src/core/Awaitable.pm src/core/Awaiter.pm src/core/Scheduler.pm src/core/Env.pm +src/core/Usage.pm src/core/ThreadPoolScheduler.pm src/core/CurrentThreadScheduler.pm src/core/Promise.pm diff --git a/tools/build/moar_core_sources b/tools/build/moar_core_sources index 2658253189e..7172f72f345 100644 --- a/tools/build/moar_core_sources +++ b/tools/build/moar_core_sources @@ -164,6 +164,7 @@ src/core/Awaiter.pm src/core/Scheduler.pm src/core/Env.pm src/core/atomicops.pm +src/core/Usage.pm src/core/ThreadPoolScheduler.pm src/core/CurrentThreadScheduler.pm src/core/Promise.pm From 273168d7b2fa6afad99a194deaa6985eb5936a50 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sun, 29 Oct 2017 00:18:07 +0200 Subject: [PATCH 594/692] Usage -> Telemetry + more changes - now also includes wallclock information - Telemetry class is just a class with "standard" methods - cpu, cpu-user, cpu-sys, wallclock - can not be created with parameters, .new snapshots current state - Telemetry::Period is just a class with the same standard methods - same methods as Telemetry - but *can* be created with given values for cpu-user,cpu-sys,wallclock - Telemetry.Period is a special method which: - stores new Telemetry object if called on a containerized type object - snapshots the current state again on instantiated object - returns a Telemetry::Period object with the difference - added .gist/.Str/.perl methods for convenience --- src/core/Telemetry.pm | 122 ++++++++++++++++++++++++++++++++++ src/core/Usage.pm | 56 ---------------- tools/build/jvm_core_sources | 2 +- tools/build/moar_core_sources | 2 +- 4 files changed, 124 insertions(+), 58 deletions(-) create mode 100644 src/core/Telemetry.pm delete mode 100644 src/core/Usage.pm diff --git a/src/core/Telemetry.pm b/src/core/Telemetry.pm new file mode 100644 index 00000000000..3542b76b5bb --- /dev/null +++ b/src/core/Telemetry.pm @@ -0,0 +1,122 @@ +# An attempt at providing an API to nqp::getrusage. + +class Telemetry::Period { ... } + +class Telemetry { + has int $!cpu-user; + has int $!cpu-sys; + has int $!wallclock; + + multi method new(Telemetry:) { nqp::create(self).SET-SELF } + + method SET-SELF() { + my \rusage = nqp::getrusage; + $!cpu-user = nqp::atpos_i(rusage, nqp::const::RUSAGE_UTIME_SEC) * 1000000 + + nqp::atpos_i(rusage, nqp::const::RUSAGE_UTIME_MSEC); + $!cpu-sys = nqp::atpos_i(rusage, nqp::const::RUSAGE_STIME_SEC) * 1000000 + + nqp::atpos_i(rusage, nqp::const::RUSAGE_STIME_MSEC); + $!wallclock = nqp::fromnum_I(1000000 * nqp::time_n,Int); + self + } + + proto method cpu() { * } + multi method cpu(Telemetry:U:) is raw { + my \rusage = nqp::getrusage; + nqp::atpos_i(rusage, nqp::const::RUSAGE_UTIME_SEC) * 1000000 + + nqp::atpos_i(rusage, nqp::const::RUSAGE_UTIME_MSEC) + + nqp::atpos_i(rusage, nqp::const::RUSAGE_STIME_SEC) * 1000000 + + nqp::atpos_i(rusage, nqp::const::RUSAGE_STIME_MSEC) + } + multi method cpu(Telemetry:D:) is raw { + nqp::add_i($!cpu-user,$!cpu-sys) + } + + proto method cpu-user() { * } + multi method cpu-user(Telemetry:U:) is raw { + my \rusage = nqp::getrusage; + nqp::atpos_i(rusage, nqp::const::RUSAGE_UTIME_SEC) * 1000000 + + nqp::atpos_i(rusage, nqp::const::RUSAGE_UTIME_MSEC) + } + multi method cpu-user(Telemetry:D:) is raw { $!cpu-user } + + proto method cpu-sys() { * } + multi method cpu-sys(Telemetry:U:) is raw { + my \rusage = nqp::getrusage; + nqp::atpos_i(rusage, nqp::const::RUSAGE_STIME_SEC) * 1000000 + + nqp::atpos_i(rusage, nqp::const::RUSAGE_STIME_MSEC) + } + multi method cpu-sys(Telemetry:D:) is raw { $!cpu-sys } + + proto method wallclock() { * } + multi method wallclock(Telemetry:U:) is raw { + nqp::fromnum_I(1000000 * nqp::time_n,Int) + } + multi method wallclock(Telemetry:D:) is raw { $!wallclock } + + proto method Period() { * } + multi method Period(Telemetry:U \SELF:) is raw { + if nqp::iscont(SELF) { + SELF = SELF.new; + nqp::create(Telemetry::Period) + } + else { + die "Must use container of type Telemetry" + } + } + multi method Period(Telemetry:D:) is raw { + my int $cpu-user = $!cpu-user; + my int $cpu-sys = $!cpu-sys; + my int $wallclock = $!wallclock; + self.SET-SELF; + + Telemetry::Period.new( + nqp::sub_i($!cpu-user,$cpu-user), + nqp::sub_i($!cpu-sys,$cpu-sys), + nqp::sub_i($!wallclock,$wallclock) + ) + } + + multi method Str(Telemetry:D:) { + $!wallclock ?? "$.cpu / $!wallclock" !! "cpu / wallclock" + } + multi method gist(Telemetry:D:) { + $!wallclock ?? "$.cpu / $!wallclock" !! "cpu / wallclock" + } +} + +class Telemetry::Period is Telemetry { + multi method new(Telemetry::Period: + int :$cpu-user, + int :$cpu-sys, + int :$wallclock + ) { + self.new($cpu-user, $cpu-sys, $wallclock) + } + multi method new(Telemetry::Period: + int $cpu-user, + int $cpu-sys, + int $wallclock + ) { + my $period := nqp::create(Telemetry::Period); + nqp::bindattr_i($period,Telemetry,'$!cpu-user', $cpu-user); + nqp::bindattr_i($period,Telemetry,'$!cpu-sys', $cpu-sys); + nqp::bindattr_i($period,Telemetry,'$!wallclock',$wallclock); + $period + } + + multi method perl(Telemetry::Period:) { + "Telemetry::Period.new(:cpu-user({ + nqp::getattr_i(self,Telemetry,'$!cpu-user') + }), :cpu-sys({ + nqp::getattr_i(self,Telemetry,'$!cpu-sys') + }), :wallclock({ + nqp::getattr_i(self,Telemetry,'$!wallclock') + }))" + } +} + +multi sub infix:<->(Telemetry $a, Telemetry $b) { + $a.cpu - $b.cpu +} + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Usage.pm b/src/core/Usage.pm deleted file mode 100644 index b279069a8c2..00000000000 --- a/src/core/Usage.pm +++ /dev/null @@ -1,56 +0,0 @@ -# An attempt at providing an API to nqp::getrusage. - -class Usage { - has int $!cpu-user; - has int $!cpu-sys; - - submethod BUILD(--> Nil) { - my \rusage = nqp::getrusage; - $!cpu-user = nqp::atpos_i(rusage, nqp::const::RUSAGE_UTIME_SEC) * 1000000 - + nqp::atpos_i(rusage, nqp::const::RUSAGE_UTIME_MSEC); - $!cpu-sys = nqp::atpos_i(rusage, nqp::const::RUSAGE_STIME_SEC) * 1000000 - + nqp::atpos_i(rusage, nqp::const::RUSAGE_STIME_MSEC); - } - - proto method cpu() { * } - multi method cpu(Usage:U:) is raw { - my \rusage = nqp::getrusage; - nqp::atpos_i(rusage, nqp::const::RUSAGE_UTIME_SEC) * 1000000 - + nqp::atpos_i(rusage, nqp::const::RUSAGE_UTIME_MSEC) - + nqp::atpos_i(rusage, nqp::const::RUSAGE_STIME_SEC) * 1000000 - + nqp::atpos_i(rusage, nqp::const::RUSAGE_STIME_MSEC) - } - multi method cpu(Usage:D:) is raw { - nqp::add_i($!cpu-user,$!cpu-sys) - } - - proto method cpu-user() { * } - multi method cpu-user(Usage:U:) is raw { - my \rusage = nqp::getrusage; - nqp::atpos_i(rusage, nqp::const::RUSAGE_UTIME_SEC) * 1000000 - + nqp::atpos_i(rusage, nqp::const::RUSAGE_UTIME_MSEC) - } - multi method cpu-user(Usage:D:) is raw { $!cpu-user } - - proto method cpu-sys() { * } - multi method cpu-sys(Usage:U:) is raw { - my \rusage = nqp::getrusage; - nqp::atpos_i(rusage, nqp::const::RUSAGE_STIME_SEC) * 1000000 - + nqp::atpos_i(rusage, nqp::const::RUSAGE_STIME_MSEC) - } - multi method cpu-sys(Usage:D:) is raw { $!cpu-sys } - - proto method interval() { * } - multi method interval(Usage:U \SELF:) is raw { SELF = SELF.new; 0 } - multi method interval(Usage:D \SELF:) is raw { - my int $cpu = (my $new := Usage.new) - SELF; - SELF = $new; - $cpu; - } -} - -multi sub infix:<->(Usage $a, Usage $b) { - $a.cpu - $b.cpu -} - -# vim: ft=perl6 expandtab sw=4 diff --git a/tools/build/jvm_core_sources b/tools/build/jvm_core_sources index c2acf01bcde..75803dec95f 100644 --- a/tools/build/jvm_core_sources +++ b/tools/build/jvm_core_sources @@ -161,7 +161,7 @@ src/core/Awaitable.pm src/core/Awaiter.pm src/core/Scheduler.pm src/core/Env.pm -src/core/Usage.pm +src/core/Telemetry.pm src/core/ThreadPoolScheduler.pm src/core/CurrentThreadScheduler.pm src/core/Promise.pm diff --git a/tools/build/moar_core_sources b/tools/build/moar_core_sources index 7172f72f345..a879297d0c1 100644 --- a/tools/build/moar_core_sources +++ b/tools/build/moar_core_sources @@ -164,7 +164,7 @@ src/core/Awaiter.pm src/core/Scheduler.pm src/core/Env.pm src/core/atomicops.pm -src/core/Usage.pm +src/core/Telemetry.pm src/core/ThreadPoolScheduler.pm src/core/CurrentThreadScheduler.pm src/core/Promise.pm From 3e175c833bc09c9226d97c5d761a1443ec73aea3 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sun, 29 Oct 2017 00:38:44 +0200 Subject: [PATCH 595/692] Make sure Telemetry - Telemetry returns a T::Period - also fix Telemetry::Period.perl invocant check --- src/core/Telemetry.pm | 17 +++++++++++++++-- 1 file changed, 15 insertions(+), 2 deletions(-) diff --git a/src/core/Telemetry.pm b/src/core/Telemetry.pm index 3542b76b5bb..b98b470e1e5 100644 --- a/src/core/Telemetry.pm +++ b/src/core/Telemetry.pm @@ -104,7 +104,7 @@ class Telemetry::Period is Telemetry { $period } - multi method perl(Telemetry::Period:) { + multi method perl(Telemetry::Period:D:) { "Telemetry::Period.new(:cpu-user({ nqp::getattr_i(self,Telemetry,'$!cpu-user') }), :cpu-sys({ @@ -116,7 +116,20 @@ class Telemetry::Period is Telemetry { } multi sub infix:<->(Telemetry $a, Telemetry $b) { - $a.cpu - $b.cpu + Telemetry::Period.new( + nqp::sub_i( + nqp::getattr_i(nqp::decont($a),Telemetry,'$!cpu-user'), + nqp::getattr_i(nqp::decont($b),Telemetry,'$!cpu-user') + ), + nqp::sub_i( + nqp::getattr_i(nqp::decont($a),Telemetry,'$!cpu-sys'), + nqp::getattr_i(nqp::decont($b),Telemetry,'$!cpu-sys') + ), + nqp::sub_i( + nqp::getattr_i(nqp::decont($a),Telemetry,'$!wallclock'), + nqp::getattr_i(nqp::decont($b),Telemetry,'$!wallclock') + ) + ) } # vim: ft=perl6 expandtab sw=4 From 7f154fe22e1d6fc29ce9fe50440b30523d4e263c Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sun, 29 Oct 2017 00:48:02 +0200 Subject: [PATCH 596/692] Handle all permutations of infix:<->(Telemetry,Telemetry) --- src/core/Telemetry.pm | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/core/Telemetry.pm b/src/core/Telemetry.pm index b98b470e1e5..cd1552ea24c 100644 --- a/src/core/Telemetry.pm +++ b/src/core/Telemetry.pm @@ -115,7 +115,12 @@ class Telemetry::Period is Telemetry { } } -multi sub infix:<->(Telemetry $a, Telemetry $b) { +multi sub infix:<->(Telemetry:U $a, Telemetry:U $b) { + Telemetry::Period.new(0,0,0) +} +multi sub infix:<->(Telemetry:D $a, Telemetry:U $b) { $a - $b.new } +multi sub infix:<->(Telemetry:U $a, Telemetry:D $b) { $a.new - $b } +multi sub infix:<->(Telemetry:D $a, Telemetry:D $b) { Telemetry::Period.new( nqp::sub_i( nqp::getattr_i(nqp::decont($a),Telemetry,'$!cpu-user'), From e00f705d69e6dd40b04c3c89261e50c0202fd530 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sun, 29 Oct 2017 12:36:00 +0100 Subject: [PATCH 597/692] We're returning a native: "is raw" makes that a bit faster --- src/core/Rakudo/Internals.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/Rakudo/Internals.pm b/src/core/Rakudo/Internals.pm index ee13be1d589..6a70a294469 100644 --- a/src/core/Rakudo/Internals.pm +++ b/src/core/Rakudo/Internals.pm @@ -635,7 +635,7 @@ my class Rakudo::Internals { } my num $init-time-num = nqp::time_n; - method INITTIME() { $init-time-num } + method INITTIME() is raw { $init-time-num } my $init-thread := nqp::currentthread(); method INITTHREAD() { $init-thread } From 3dfaa2aedde4fb76b54db93e8f5ed209286b1a70 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sun, 29 Oct 2017 12:51:51 +0100 Subject: [PATCH 598/692] Make sure we actually record since start of program Instead of number of microseconds since epoch. --- src/core/Telemetry.pm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/core/Telemetry.pm b/src/core/Telemetry.pm index cd1552ea24c..d53cbe7b75d 100644 --- a/src/core/Telemetry.pm +++ b/src/core/Telemetry.pm @@ -7,6 +7,8 @@ class Telemetry { has int $!cpu-sys; has int $!wallclock; + my num $start = Rakudo::Internals.INITTIME; + multi method new(Telemetry:) { nqp::create(self).SET-SELF } method SET-SELF() { @@ -15,7 +17,7 @@ class Telemetry { + nqp::atpos_i(rusage, nqp::const::RUSAGE_UTIME_MSEC); $!cpu-sys = nqp::atpos_i(rusage, nqp::const::RUSAGE_STIME_SEC) * 1000000 + nqp::atpos_i(rusage, nqp::const::RUSAGE_STIME_MSEC); - $!wallclock = nqp::fromnum_I(1000000 * nqp::time_n,Int); + $!wallclock = nqp::fromnum_I(1000000*nqp::sub_n(nqp::time_n,$start),Int); self } From 59a59be8a5c263ab0c116d14ab00d9ff1344ae8d Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sun, 29 Oct 2017 13:21:22 +0100 Subject: [PATCH 599/692] Move Telemetry out of the setting - move it to lib, so you will have to do "use Telemetry" - add a snap() sub, to huffmanize Telemetry.new --- src/core/Telemetry.pm => lib/Telemetry.pm6 | 12 ++++++++---- tools/build/install-core-dist.pl | 1 + tools/build/jvm_core_sources | 1 - tools/build/moar_core_sources | 1 - 4 files changed, 9 insertions(+), 6 deletions(-) rename src/core/Telemetry.pm => lib/Telemetry.pm6 (92%) diff --git a/src/core/Telemetry.pm b/lib/Telemetry.pm6 similarity index 92% rename from src/core/Telemetry.pm rename to lib/Telemetry.pm6 index d53cbe7b75d..258472fb59d 100644 --- a/src/core/Telemetry.pm +++ b/lib/Telemetry.pm6 @@ -1,5 +1,7 @@ # An attempt at providing an API to nqp::getrusage. +use nqp; + class Telemetry::Period { ... } class Telemetry { @@ -117,12 +119,12 @@ class Telemetry::Period is Telemetry { } } -multi sub infix:<->(Telemetry:U $a, Telemetry:U $b) { +multi sub infix:<->(Telemetry:U $a, Telemetry:U $b) is export { Telemetry::Period.new(0,0,0) } -multi sub infix:<->(Telemetry:D $a, Telemetry:U $b) { $a - $b.new } -multi sub infix:<->(Telemetry:U $a, Telemetry:D $b) { $a.new - $b } -multi sub infix:<->(Telemetry:D $a, Telemetry:D $b) { +multi sub infix:<->(Telemetry:D $a, Telemetry:U $b) is export { $a - $b.new } +multi sub infix:<->(Telemetry:U $a, Telemetry:D $b) is export { $a.new - $b } +multi sub infix:<->(Telemetry:D $a, Telemetry:D $b) is export { Telemetry::Period.new( nqp::sub_i( nqp::getattr_i(nqp::decont($a),Telemetry,'$!cpu-user'), @@ -139,4 +141,6 @@ multi sub infix:<->(Telemetry:D $a, Telemetry:D $b) { ) } +sub snap() is export { Telemetry.new } + # vim: ft=perl6 expandtab sw=4 diff --git a/tools/build/install-core-dist.pl b/tools/build/install-core-dist.pl index 6efca168cc7..1b67cafdeab 100644 --- a/tools/build/install-core-dist.pl +++ b/tools/build/install-core-dist.pl @@ -10,6 +10,7 @@ "newline" => "lib/newline.pm6", "experimental" => "lib/experimental.pm6", "CompUnit::Repository::Staging" => "lib/CompUnit/Repository/Staging.pm", + "Telemetry" => "lib/Telemetry.pm6", ; PROCESS::<$REPO> := CompUnit::Repository::Staging.new( diff --git a/tools/build/jvm_core_sources b/tools/build/jvm_core_sources index 75803dec95f..6bdb4c1b5c1 100644 --- a/tools/build/jvm_core_sources +++ b/tools/build/jvm_core_sources @@ -161,7 +161,6 @@ src/core/Awaitable.pm src/core/Awaiter.pm src/core/Scheduler.pm src/core/Env.pm -src/core/Telemetry.pm src/core/ThreadPoolScheduler.pm src/core/CurrentThreadScheduler.pm src/core/Promise.pm diff --git a/tools/build/moar_core_sources b/tools/build/moar_core_sources index a879297d0c1..2658253189e 100644 --- a/tools/build/moar_core_sources +++ b/tools/build/moar_core_sources @@ -164,7 +164,6 @@ src/core/Awaiter.pm src/core/Scheduler.pm src/core/Env.pm src/core/atomicops.pm -src/core/Telemetry.pm src/core/ThreadPoolScheduler.pm src/core/CurrentThreadScheduler.pm src/core/Promise.pm From 52440486188faf0ad1310f87ff5c2acdd4169498 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sun, 29 Oct 2017 14:08:26 +0100 Subject: [PATCH 600/692] Remove Telemetry.Period, it was too magical to some - fix Telemetry.wallclock: it shouldn't return since epoch - improved snap() subroutine, now also allows pushing to a given array - added periods() subroutine, for generating a Seq of Telemetry::Period objects --- lib/Telemetry.pm6 | 44 +++++++++++++++----------------------------- 1 file changed, 15 insertions(+), 29 deletions(-) diff --git a/lib/Telemetry.pm6 b/lib/Telemetry.pm6 index 258472fb59d..a6b24e76018 100644 --- a/lib/Telemetry.pm6 +++ b/lib/Telemetry.pm6 @@ -11,16 +11,13 @@ class Telemetry { my num $start = Rakudo::Internals.INITTIME; - multi method new(Telemetry:) { nqp::create(self).SET-SELF } - - method SET-SELF() { + submethod BUILD() { my \rusage = nqp::getrusage; $!cpu-user = nqp::atpos_i(rusage, nqp::const::RUSAGE_UTIME_SEC) * 1000000 + nqp::atpos_i(rusage, nqp::const::RUSAGE_UTIME_MSEC); $!cpu-sys = nqp::atpos_i(rusage, nqp::const::RUSAGE_STIME_SEC) * 1000000 + nqp::atpos_i(rusage, nqp::const::RUSAGE_STIME_MSEC); $!wallclock = nqp::fromnum_I(1000000*nqp::sub_n(nqp::time_n,$start),Int); - self } proto method cpu() { * } @@ -53,33 +50,10 @@ class Telemetry { proto method wallclock() { * } multi method wallclock(Telemetry:U:) is raw { - nqp::fromnum_I(1000000 * nqp::time_n,Int) + nqp::fromnum_I(1000000 * nqp::sub_n(nqp::time_n,$start),Int) } multi method wallclock(Telemetry:D:) is raw { $!wallclock } - proto method Period() { * } - multi method Period(Telemetry:U \SELF:) is raw { - if nqp::iscont(SELF) { - SELF = SELF.new; - nqp::create(Telemetry::Period) - } - else { - die "Must use container of type Telemetry" - } - } - multi method Period(Telemetry:D:) is raw { - my int $cpu-user = $!cpu-user; - my int $cpu-sys = $!cpu-sys; - my int $wallclock = $!wallclock; - self.SET-SELF; - - Telemetry::Period.new( - nqp::sub_i($!cpu-user,$cpu-user), - nqp::sub_i($!cpu-sys,$cpu-sys), - nqp::sub_i($!wallclock,$wallclock) - ) - } - multi method Str(Telemetry:D:) { $!wallclock ?? "$.cpu / $!wallclock" !! "cpu / wallclock" } @@ -141,6 +115,18 @@ multi sub infix:<->(Telemetry:D $a, Telemetry:D $b) is export { ) } -sub snap() is export { Telemetry.new } +my @snaps; +proto sub snap(|) is export { * } +multi sub snap(--> Nil) { @snaps.push(Telemetry.new) } +multi sub snap(@s --> Nil) { @s.push(Telemetry.new) } + +proto sub periods(|) is export { * } +multi sub periods() { + (1..^@snaps).map: { + LAST @snaps = (); + @snaps[$_] - @snaps[$_ - 1] + } +} +multi sub periods(@s) { (1..^@s).map: { @s[$_] - @s[$_ - 1] } } # vim: ft=perl6 expandtab sw=4 From b30916f353a7d4a8ee2d253580faadba0a5796f3 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sun, 29 Oct 2017 14:52:25 +0100 Subject: [PATCH 601/692] Add Telemetry::Period.cpus/utilization - cpus returns string indicating how many CPU's were used - utilization returns a string indicating % of CPU power used --- lib/Telemetry.pm6 | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/lib/Telemetry.pm6 b/lib/Telemetry.pm6 index a6b24e76018..8b642ac3172 100644 --- a/lib/Telemetry.pm6 +++ b/lib/Telemetry.pm6 @@ -91,6 +91,16 @@ class Telemetry::Period is Telemetry { nqp::getattr_i(self,Telemetry,'$!wallclock') }))" } + + method cpus() { + nqp::add_i( + nqp::getattr_i(self,Telemetry,'$!cpu-user'), + nqp::getattr_i(self,Telemetry,'$!cpu-sys') + ) / nqp::getattr_i(self,Telemetry,'$!wallclock') + } + + my $factor = 100 / Kernel.cpu-cores; + method utilization() { $factor * self.cpus } } multi sub infix:<->(Telemetry:U $a, Telemetry:U $b) is export { From f7d21b5d6c680a10c2e5a8aadb5a5cff6e444eb5 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sun, 29 Oct 2017 15:20:07 +0100 Subject: [PATCH 602/692] periods() adds an extra snap() if only one was done - also, if there are still snaps from snap(), the say periods before exiting - this allows for simple timing info on a single or more snaps --- lib/Telemetry.pm6 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/lib/Telemetry.pm6 b/lib/Telemetry.pm6 index 8b642ac3172..873daac00ad 100644 --- a/lib/Telemetry.pm6 +++ b/lib/Telemetry.pm6 @@ -132,6 +132,7 @@ multi sub snap(@s --> Nil) { @s.push(Telemetry.new) } proto sub periods(|) is export { * } multi sub periods() { + @snaps.push(Telemetry.new) if @snaps == 1; (1..^@snaps).map: { LAST @snaps = (); @snaps[$_] - @snaps[$_ - 1] @@ -139,4 +140,6 @@ multi sub periods() { } multi sub periods(@s) { (1..^@s).map: { @s[$_] - @s[$_ - 1] } } +END { if @snaps { .say for periods } } + # vim: ft=perl6 expandtab sw=4 From 3c4041eab5eaedb7eb58b26aeec33f308903b0fc Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sun, 29 Oct 2017 17:23:20 +0000 Subject: [PATCH 603/692] Implement hypered nodality for all methodcall variations MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Fixes RT#130721: https://rt.perl.org/Ticket/Display.html?id=130721 Depending on dispatch variant, the actual method call we're hypering might differ than what the original code assumes to be the name (and that name would be `dispatch:`). Fix by raking the QASTs for the actual name. In addition to just grabbing the name the extra `dispatch` is gonna call, we also need to check if the new name we found is an additional `dispatch` call (e.g. `».?&elems` would have a hyper to `dispatch:<.?>` that calls `dispatch:`). Lastly, the nested `dispatch` tree could have a method name coming from a string with a code block. We need to ensure that code block runs just once, instead of each time we call the hypered method, so we grab the name into the variable and give that to the nodality figure-outer as well as pass it to the actual nested dispatch call. --- src/Perl6/Actions.nqp | 49 ++++++++++++++++++++++++++++++++++++++++--- src/core/Mu.pm | 23 ++++++++++++-------- 2 files changed, 60 insertions(+), 12 deletions(-) diff --git a/src/Perl6/Actions.nqp b/src/Perl6/Actions.nqp index 53d346ef5a5..a9894d1a88b 100644 --- a/src/Perl6/Actions.nqp +++ b/src/Perl6/Actions.nqp @@ -7448,14 +7448,57 @@ class Perl6::Actions is HLL::Actions does STDActions { make QAST::Op.new(:op, :name('&postfix:<ⁿ>'), $*W.add_numeric_constant($/, 'Int', $power)); } + method hyper-nodal-name-tweak ($past) { + unless my $name := $past.name { + $past.unshift: QAST::SVal.new: :value(''); + return; + } + $past.unshift: QAST::SVal.new: :value($name); + + unless nqp::eqat($name, 'dispatch:<', 0) && ( + $name eq 'dispatch:' || $name eq 'dispatch:<.*>' + || $name eq 'dispatch:<.+>' || $name eq 'dispatch:<.?>' + || $name eq 'dispatch:<::>' + ) { + $past.unshift: QAST::SVal.new: :value(''); + return; + } + + # the call we're hypering is another `dispatch:<` call, so we need + # to figure out what's the actual method name we'll call, inside that + # dispatch, so we can pass it to our hyper call for nodality calculation + my $nodal-name := $past[1]; + + if $nodal-name.isa(QAST::Want) && nqp::elems($nodal-name) == 3 + && $nodal-name[2].isa(QAST::SVal) { + # the new nodal name might be another level of + # dispatch:<...>; dig one level deeper for real name + $nodal-name := $past[2] + if $nodal-name[2].value eq 'dispatch:' + || $nodal-name[2].value eq 'dispatch:<::>'; + } + else { + # at this point, we could have method name in a string that + # has a code block to run. We need to ensure the code runs just + # once, so we'll store the result in a variable, to use for the + # logic that figures out nodality. We'll also stick that variable + # into the second `dispatch` call, to use as a name there. + my $name-var := $*W.cur_lexpad.unique: 'nodal-name'; + $nodal-name := QAST::Op.new: :op, + QAST::Var.new(:name($name-var), :scope, :decl), + $past[1]; + $past[1] := QAST::Var.new: :name($name-var), :scope; + } + + $past.unshift: $nodal-name; + } + method postfixish($/) { if $ { my $past := $.ast || QAST::Op.new( :name('&postfix' ~ $*W.canonicalize_pair('', $.Str)), :op ); if $past.isa(QAST::Op) && $past.op() eq 'callmethod' { - if $past.name -> $name { - $past.unshift(QAST::SVal.new( :value($name) )); - } + self.hyper-nodal-name-tweak($past); $past.name('dispatch:'); } elsif $past.isa(QAST::Op) && $past.op() eq 'call' { diff --git a/src/core/Mu.pm b/src/core/Mu.pm index dfc726a9738..6d5d14c66be 100644 --- a/src/core/Mu.pm +++ b/src/core/Mu.pm @@ -852,20 +852,25 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" nqp::p6bindattrinvres(nqp::create(List),List,'$!reified',$results) } - method dispatch:(Mu \SELF: Str() $name, |c) { + method dispatch:(Mu \SELF: $nodality, Str $meth-name, |c) { nqp::if( - nqp::can(List,$name) && nqp::can(List.can($name).AT-POS(0),"nodal"), + nqp::if( + nqp::istype($nodality,Str), + nqp::if( + $nodality, + nqp::can(List,$nodality) + && nqp::can(List.can($nodality ).AT-POS(0),'nodal'), + nqp::can(List,$meth-name) + && nqp::can(List.can($meth-name).AT-POS(0),'nodal')), + nqp::can($nodality, 'nodal')), nqp::if( c, - HYPER( sub (\obj) is nodal { obj."$name"(|c) }, SELF ), - HYPER( sub (\obj) is nodal { obj."$name"() }, SELF ) - ), + HYPER( sub (\obj) is nodal { obj."$meth-name"(|c) }, SELF ), + HYPER( sub (\obj) is nodal { obj."$meth-name"() }, SELF )), nqp::if( c, - HYPER( -> \obj { obj."$name"(|c) }, SELF ), - HYPER( -> \obj { obj."$name"() }, SELF ) - ) - ) + HYPER( -> \obj { obj."$meth-name"(|c) }, SELF ), + HYPER( -> \obj { obj."$meth-name"( ) }, SELF ))) } method WALK(:$name!, :$canonical, :$ascendant, :$descendant, :$preorder, :$breadth, From af3624d45d5d9e20751c22f34490385d14fcc0ce Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sun, 29 Oct 2017 23:26:39 +0100 Subject: [PATCH 604/692] Correct (Set|SetHash).perl An empty Set/SetHash was shown as "Set()"/"SetHash()", which would create a Set/SetHash with Any as the only element when EVALled. --- src/core/Setty.pm | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/src/core/Setty.pm b/src/core/Setty.pm index 115054f90dc..77b4df9b1b6 100644 --- a/src/core/Setty.pm +++ b/src/core/Setty.pm @@ -158,16 +158,16 @@ my role Setty does QuantHash { ) } multi method perl(Setty:D $ : --> Str:D) { - nqp::concat( + nqp::if( + nqp::eqaddr(self,set()), + 'set()', nqp::concat( - nqp::if( - nqp::istype(self,Set), - 'set(', - nqp::concat(self.^name,'(') - ), - nqp::join(",",Rakudo::QuantHash.RAW-VALUES-MAP(self, *.perl)) - ), - ')' + nqp::concat(self.^name,'.new('), + nqp::concat( + nqp::join(",",Rakudo::QuantHash.RAW-VALUES-MAP(self, *.perl)), + ')' + ) + ) ) } From 1949a2bc13085f05c21f4a6b627d2f435f76182a Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sun, 29 Oct 2017 23:39:54 +0100 Subject: [PATCH 605/692] Make 'my %h is Set(|Hash) = ...;' DWIM - in response to RT #132352 and RT #132353 - make also sure we can initialize Sets only once --- src/core/Set.pm | 15 +++++++++++++++ src/core/SetHash.pm | 15 +++++++++++++++ 2 files changed, 30 insertions(+) diff --git a/src/core/Set.pm b/src/core/Set.pm index 4bd6769ab85..d760e6e9735 100644 --- a/src/core/Set.pm +++ b/src/core/Set.pm @@ -11,6 +11,21 @@ my class Set does Setty { set() ) } + method STORE(*@pairs --> Set:D) { + nqp::if( + (my $iterator := @pairs.iterator).is-lazy, + Failure.new(X::Cannot::Lazy.new(:action,:what(self.^name))), + nqp::if( + $!elems || nqp::eqaddr(self,set()), + X::Immutable.new( method => 'STORE', typename => self.^name ).throw, + self.SET-SELF( + Rakudo::QuantHash.ADD-PAIRS-TO-SET( + nqp::create(Rakudo::Internals::IterationSet), $iterator + ) + ) + ) + ) + } multi method new(Set:_:) { nqp::if( nqp::eqaddr(self.WHAT,Set), diff --git a/src/core/SetHash.pm b/src/core/SetHash.pm index 2400d5a6f85..1dacb10b5ae 100644 --- a/src/core/SetHash.pm +++ b/src/core/SetHash.pm @@ -10,6 +10,21 @@ my class SetHash does Setty { ) } + method STORE(*@pairs --> SetHash:D) { + nqp::if( + (my $iterator := @pairs.iterator).is-lazy, + Failure.new(X::Cannot::Lazy.new(:action,:what(self.^name))), + nqp::stmts( + nqp::bindattr(self,::?CLASS,'$!elems', + Rakudo::QuantHash.ADD-PAIRS-TO-SET( + nqp::create(Rakudo::Internals::IterationSet), $iterator + ) + ), + self + ) + ) + } + #--- selector methods multi method grab(SetHash:D:) { From 948af00b59c19f43a9dc2c8ca03782c97d9a7034 Mon Sep 17 00:00:00 2001 From: Stefan Seifert Date: Mon, 30 Oct 2017 09:12:42 +0100 Subject: [PATCH 606/692] Pass type objects to the VM for arguments of native functions The VM may need this information for making decisions about how to build a native call site, e.g. if it's possible to create JIT compiled code or whether it needs to refresh a CArray's elements after a call. Fixes GH #1220 --- lib/NativeCall.pm6 | 10 +++++----- tools/build/NQP_REVISION | 2 +- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/lib/NativeCall.pm6 b/lib/NativeCall.pm6 index 6206d250bc9..5ecf43679f8 100644 --- a/lib/NativeCall.pm6 +++ b/lib/NativeCall.pm6 @@ -61,10 +61,10 @@ sub string_encoding_to_nci_type(\encoding) { } # Builds a hash of type information for the specified parameter. -sub param_hash_for(Parameter $p, :$with-typeobj) { +sub param_hash_for(Parameter $p) { my Mu $result := nqp::hash(); my $type := $p.type(); - nqp::bindkey($result, 'typeobj', nqp::decont($type)) if $with-typeobj; + nqp::bindkey($result, 'typeobj', nqp::decont($type)); nqp::bindkey($result, 'rw', nqp::unbox_i(1)) if $p.rw; if $type ~~ Str { my $enc := $p.?native_call_encoded() || 'utf8'; @@ -73,7 +73,7 @@ sub param_hash_for(Parameter $p, :$with-typeobj) { } elsif $type ~~ Callable { nqp::bindkey($result, 'type', nqp::unbox_s(type_code_for($type))); - my $info := param_list_for($p.sub_signature, :with-typeobj); + my $info := param_list_for($p.sub_signature); nqp::unshift($info, return_hash_for($p.sub_signature, :with-typeobj)); nqp::bindkey($result, 'callback_args', $info); } @@ -84,7 +84,7 @@ sub param_hash_for(Parameter $p, :$with-typeobj) { } # Builds the list of parameter information for a callback argument. -sub param_list_for(Signature $sig, &r?, :$with-typeobj) { +sub param_list_for(Signature $sig, &r?) { my $params := nqp::getattr($sig.params,List,'$!reified'); my int $elems = nqp::elems($params); @@ -97,7 +97,7 @@ sub param_list_for(Signature $sig, &r?, :$with-typeobj) { my $result := nqp::setelems(nqp::list,$elems); my int $i = -1; nqp::bindpos($result,$i, - param_hash_for(nqp::atpos($params,$i),:$with-typeobj) + param_hash_for(nqp::atpos($params,$i)) ) while nqp::islt_i($i = nqp::add_i($i,1),$elems); $result diff --git a/tools/build/NQP_REVISION b/tools/build/NQP_REVISION index 6145bcb719b..5cf66d791e5 100644 --- a/tools/build/NQP_REVISION +++ b/tools/build/NQP_REVISION @@ -1 +1 @@ -2017.10-6-ge5c0926 +2017.10-10-g626ea0206 From 6ac2b15cfac01ca90aceea967b040ea7fd2d7afc Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Mon, 30 Oct 2017 10:52:33 +0100 Subject: [PATCH 607/692] Revert "Make 'my %h is Set(|Hash) = ...;' DWIM" This reverts commit 1949a2bc13085f05c21f4a6b627d2f435f76182a. --- src/core/Set.pm | 15 --------------- src/core/SetHash.pm | 15 --------------- 2 files changed, 30 deletions(-) diff --git a/src/core/Set.pm b/src/core/Set.pm index d760e6e9735..4bd6769ab85 100644 --- a/src/core/Set.pm +++ b/src/core/Set.pm @@ -11,21 +11,6 @@ my class Set does Setty { set() ) } - method STORE(*@pairs --> Set:D) { - nqp::if( - (my $iterator := @pairs.iterator).is-lazy, - Failure.new(X::Cannot::Lazy.new(:action,:what(self.^name))), - nqp::if( - $!elems || nqp::eqaddr(self,set()), - X::Immutable.new( method => 'STORE', typename => self.^name ).throw, - self.SET-SELF( - Rakudo::QuantHash.ADD-PAIRS-TO-SET( - nqp::create(Rakudo::Internals::IterationSet), $iterator - ) - ) - ) - ) - } multi method new(Set:_:) { nqp::if( nqp::eqaddr(self.WHAT,Set), diff --git a/src/core/SetHash.pm b/src/core/SetHash.pm index 1dacb10b5ae..2400d5a6f85 100644 --- a/src/core/SetHash.pm +++ b/src/core/SetHash.pm @@ -10,21 +10,6 @@ my class SetHash does Setty { ) } - method STORE(*@pairs --> SetHash:D) { - nqp::if( - (my $iterator := @pairs.iterator).is-lazy, - Failure.new(X::Cannot::Lazy.new(:action,:what(self.^name))), - nqp::stmts( - nqp::bindattr(self,::?CLASS,'$!elems', - Rakudo::QuantHash.ADD-PAIRS-TO-SET( - nqp::create(Rakudo::Internals::IterationSet), $iterator - ) - ), - self - ) - ) - } - #--- selector methods multi method grab(SetHash:D:) { From aab2b98305f04ec7819d8673e7964c6cba677c59 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Mon, 30 Oct 2017 12:44:59 +0100 Subject: [PATCH 608/692] Set|Bag|Mix.new() no longer return set()|bag()|mix() - to pave the way for making "my %h is Set|Bag|Mix" work - Set|Bag|Mix.new() returning sentinels not considered worthwhile having --- src/core/Bag.pm | 20 -------------------- src/core/BagHash.pm | 3 --- src/core/Baggy.pm | 9 --------- src/core/Iterable.pm | 30 ++++++++++++++++++++++++------ src/core/Mix.pm | 20 -------------------- src/core/QuantHash.pm | 11 +++++++++++ src/core/Set.pm | 18 ------------------ src/core/SetHash.pm | 10 ---------- 8 files changed, 35 insertions(+), 86 deletions(-) diff --git a/src/core/Bag.pm b/src/core/Bag.pm index e7de21a69b1..ddf3fce4720 100644 --- a/src/core/Bag.pm +++ b/src/core/Bag.pm @@ -22,27 +22,7 @@ my class Bag does Baggy { ) } -#--- object creation methods - multi method new(Bag:_:) { - nqp::if( - nqp::eqaddr(self.WHAT,Bag), - bag(), - nqp::create(self) - ) - } - #--- interface methods - method SET-SELF(Bag:D: \elems) { - nqp::if( - nqp::elems(elems), - nqp::stmts( - nqp::bindattr(self,::?CLASS,'$!elems',elems), - self - ), - bag() - ) - } - multi method DELETE-KEY(Bag:D: \k) { X::Immutable.new(method => 'DELETE-KEY', typename => self.^name).throw; } diff --git a/src/core/BagHash.pm b/src/core/BagHash.pm index 2508549fba5..50cbd3063d3 100644 --- a/src/core/BagHash.pm +++ b/src/core/BagHash.pm @@ -55,9 +55,6 @@ my class BagHash does Baggy { ) } -#--- object creation methods - multi method new(BagHash:_:) { nqp::create(self) } - #--- introspection methods method total() { Rakudo::QuantHash.BAG-TOTAL($!elems) } diff --git a/src/core/Baggy.pm b/src/core/Baggy.pm index dc37bfed57d..51d0cd0af94 100644 --- a/src/core/Baggy.pm +++ b/src/core/Baggy.pm @@ -12,15 +12,6 @@ my role Baggy does QuantHash { # Immutables aspects of Bag/Mix, need to live to Bag/Mix respectively. #--- interface methods - method SET-SELF(Baggy:D: \elems) { - nqp::stmts( - nqp::if( - nqp::elems(elems), - nqp::bindattr(self,::?CLASS,'$!elems',elems) - ), - self - ) - } multi method ACCEPTS(Baggy:U: \other --> Bool:D) { other.^does(self) } diff --git a/src/core/Iterable.pm b/src/core/Iterable.pm index 198be53152f..3fd51431821 100644 --- a/src/core/Iterable.pm +++ b/src/core/Iterable.pm @@ -142,9 +142,15 @@ my role Iterable { nqp::if( (my $iterator := iterable.flat.iterator).is-lazy, Failure.new(X::Cannot::Lazy.new(:action,:what(type.^name))), - nqp::create(type).SET-SELF( - Rakudo::QuantHash.ADD-PAIRS-TO-MIX( + nqp::if( + nqp::elems(my $elems := Rakudo::QuantHash.ADD-PAIRS-TO-MIX( nqp::create(Rakudo::Internals::IterationSet),$iterator + )), + nqp::create(type).SET-SELF($elems), + nqp::if( + nqp::eqaddr(type,Mix), + mix(), + nqp::create(type) ) ) ) @@ -156,9 +162,15 @@ my role Iterable { nqp::if( (my $iterator := iterable.flat.iterator).is-lazy, Failure.new(X::Cannot::Lazy.new(:action,:what(type.^name))), - nqp::create(type).SET-SELF( - Rakudo::QuantHash.ADD-PAIRS-TO-BAG( + nqp::if( + nqp::elems(my $elems := Rakudo::QuantHash.ADD-PAIRS-TO-BAG( nqp::create(Rakudo::Internals::IterationSet),$iterator + )), + nqp::create(type).SET-SELF($elems), + nqp::if( + nqp::eqaddr(type,Bag), + bag(), + nqp::create(type) ) ) ) @@ -170,9 +182,15 @@ my role Iterable { nqp::if( (my $iterator := iterable.flat.iterator).is-lazy, Failure.new(X::Cannot::Lazy.new(:action,:what(type.^name))), - nqp::create(type).SET-SELF( - Rakudo::QuantHash.ADD-PAIRS-TO-SET( + nqp::if( + nqp::elems(my $elems := Rakudo::QuantHash.ADD-PAIRS-TO-SET( nqp::create(Rakudo::Internals::IterationSet),$iterator + )), + nqp::create(type).SET-SELF($elems), + nqp::if( + nqp::eqaddr(type,Set), + set(), + nqp::create(type) ) ) ) diff --git a/src/core/Mix.pm b/src/core/Mix.pm index 95b36f32550..b4762c40ef3 100644 --- a/src/core/Mix.pm +++ b/src/core/Mix.pm @@ -4,17 +4,6 @@ my class Mix does Mixy { has Real $!total-positive; #--- interface methods - method SET-SELF(Mix:D: \elems) { - nqp::if( - nqp::elems(elems), - nqp::stmts( - nqp::bindattr(self,::?CLASS,'$!elems',elems), - self - ), - mix() - ) - } - multi method DELETE-KEY(Mix:D: \k) { X::Immutable.new(method => 'DELETE-KEY', typename => self.^name).throw; } @@ -46,15 +35,6 @@ my class Mix does Mixy { ) } -#--- object creation methods - multi method new(Mix:_:) { - nqp::if( - nqp::eqaddr(self.WHAT,Mix), - mix(), - nqp::create(self) - ) - } - #--- selection methods multi method grab($count? --> Real:D) { X::Immutable.new( method => 'grab', typename => self.^name ).throw; diff --git a/src/core/QuantHash.pm b/src/core/QuantHash.pm index 4ce44add492..66574d54b22 100644 --- a/src/core/QuantHash.pm +++ b/src/core/QuantHash.pm @@ -1,4 +1,15 @@ my role QuantHash does Associative { + + method SET-SELF(QuantHash:D: \elems) { + nqp::stmts( + nqp::if( + nqp::elems(elems), + nqp::bindattr(self,::?CLASS,'$!elems',elems) + ), + self + ) + } + method Int ( --> Int:D) { self.total.Int } method Num ( --> Num:D) { self.total.Num } method Numeric ( --> Numeric:D) { self.total.Numeric } diff --git a/src/core/Set.pm b/src/core/Set.pm index 4bd6769ab85..f83552172a7 100644 --- a/src/core/Set.pm +++ b/src/core/Set.pm @@ -1,24 +1,6 @@ my class Set does Setty { has $!WHICH; - method SET-SELF(\elems) { - nqp::if( - nqp::elems(elems), - nqp::stmts( - nqp::bindattr(self,::?CLASS,'$!elems',elems), - self - ), - set() - ) - } - multi method new(Set:_:) { - nqp::if( - nqp::eqaddr(self.WHAT,Set), - set(), - nqp::create(self) - ) - } - multi method WHICH (Set:D:) { nqp::if( nqp::attrinited(self,Set,'$!WHICH'), diff --git a/src/core/SetHash.pm b/src/core/SetHash.pm index 2400d5a6f85..5d954512c0b 100644 --- a/src/core/SetHash.pm +++ b/src/core/SetHash.pm @@ -1,15 +1,5 @@ my class SetHash does Setty { - method SET-SELF(\elems) { - nqp::stmts( - nqp::if( - nqp::elems(elems), - nqp::bindattr(self,::?CLASS,'$!elems',elems) - ), - self - ) - } - #--- selector methods multi method grab(SetHash:D:) { From b6a4d5b555520451c5c8a6d394cb914bc7d93245 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Mon, 30 Oct 2017 14:18:36 +0100 Subject: [PATCH 609/692] Make 'my %h is Set = ...' DWIM - also for SetHash, Bag, BagHash, Mix, MixHash - by implementing .STORE for all QuantHash types - .STORE is now also sent a :$initialize flag which is True for initialization - True for: my %h is Set = ...; - not set for: %h = ...; - throws X::Assignment::RO when trying to change Set|Bag|Mix - as in: %h = ...; --- src/Perl6/Actions.nqp | 19 +++++++++++++++++-- src/core/Bag.pm | 16 ++++++++++++++++ src/core/BagHash.pm | 11 +++++++++++ src/core/Mix.pm | 15 +++++++++++++++ src/core/MixHash.pm | 11 +++++++++++ src/core/Set.pm | 16 ++++++++++++++++ src/core/SetHash.pm | 12 ++++++++++++ 7 files changed, 98 insertions(+), 2 deletions(-) diff --git a/src/Perl6/Actions.nqp b/src/Perl6/Actions.nqp index a9894d1a88b..1736f5a1816 100644 --- a/src/Perl6/Actions.nqp +++ b/src/Perl6/Actions.nqp @@ -3157,7 +3157,7 @@ class Perl6::Actions is HLL::Actions does STDActions { } } elsif $ eq '=' { - $past := assign_op($/, $past, $initast); + $past := assign_op($/, $past, $initast, :initialize); } elsif $ eq '.=' { $past := make_dot_equals($past, $initast); @@ -6960,7 +6960,7 @@ class Perl6::Actions is HLL::Actions does STDActions { } my @native_assign_ops := ['', 'assign_i', 'assign_n', 'assign_s']; - sub assign_op($/, $lhs_ast, $rhs_ast) { + sub assign_op($/, $lhs_ast, $rhs_ast, :$initialize) { my $past; my $var_sigil; $lhs_ast := WANTED($lhs_ast,'assign_op/lhs'); @@ -6976,6 +6976,13 @@ class Perl6::Actions is HLL::Actions does STDActions { } } } + + # get the sigil out of the my %h is Set = case + elsif nqp::istype($lhs_ast,QAST::Op) && $lhs_ast.op eq 'bind' + && nqp::istype($lhs_ast[0], QAST::Var) { + $var_sigil := nqp::substr($lhs_ast[0].name, 0, 1); + } + if nqp::istype($lhs_ast, QAST::Var) && nqp::objprimspec($lhs_ast.returns) -> $spec { # Native assignment is only possible to a reference; complain now @@ -6996,6 +7003,14 @@ class Perl6::Actions is HLL::Actions does STDActions { $past := QAST::Op.new( :op('callmethod'), :name('STORE'), $lhs_ast, $rhs_ast); + + # let STORE know if this is the first time + if $initialize { + $past.push(QAST::WVal.new( + :named('initialize'), + :value($*W.find_symbol(['Bool', 'True'])) + )); + } $past.nosink(1); } elsif $var_sigil eq '$' { diff --git a/src/core/Bag.pm b/src/core/Bag.pm index ddf3fce4720..d3f7403b7f8 100644 --- a/src/core/Bag.pm +++ b/src/core/Bag.pm @@ -23,6 +23,22 @@ my class Bag does Baggy { } #--- interface methods + method STORE(*@pairs, :$initialize --> Bag:D) { + nqp::if( + (my $iterator := @pairs.iterator).is-lazy, + Failure.new(X::Cannot::Lazy.new(:action,:what(self.^name))), + nqp::if( + $initialize, + self.SET-SELF( + Rakudo::QuantHash.ADD-PAIRS-TO-BAG( + nqp::create(Rakudo::Internals::IterationSet), $iterator + ) + ), + X::Assignment::RO.new(value => self).throw + ) + ) + } + multi method DELETE-KEY(Bag:D: \k) { X::Immutable.new(method => 'DELETE-KEY', typename => self.^name).throw; } diff --git a/src/core/BagHash.pm b/src/core/BagHash.pm index 50cbd3063d3..2abe4a10478 100644 --- a/src/core/BagHash.pm +++ b/src/core/BagHash.pm @@ -1,6 +1,17 @@ my class BagHash does Baggy { #--- interface methods + method STORE(*@pairs --> BagHash:D) { + nqp::if( + (my $iterator := @pairs.iterator).is-lazy, + Failure.new(X::Cannot::Lazy.new(:action,:what(self.^name))), + self.SET-SELF( + Rakudo::QuantHash.ADD-PAIRS-TO-BAG( + nqp::create(Rakudo::Internals::IterationSet), $iterator + ) + ) + ) + } multi method AT-KEY(BagHash:D: \k) is raw { Proxy.new( FETCH => { diff --git a/src/core/Mix.pm b/src/core/Mix.pm index b4762c40ef3..f9c60f0db04 100644 --- a/src/core/Mix.pm +++ b/src/core/Mix.pm @@ -4,6 +4,21 @@ my class Mix does Mixy { has Real $!total-positive; #--- interface methods + method STORE(*@pairs, :$initialize --> Mix:D) { + nqp::if( + (my $iterator := @pairs.iterator).is-lazy, + Failure.new(X::Cannot::Lazy.new(:action,:what(self.^name))), + nqp::if( + $initialize, + self.SET-SELF( + Rakudo::QuantHash.ADD-PAIRS-TO-MIX( + nqp::create(Rakudo::Internals::IterationSet), $iterator + ) + ), + X::Assignment::RO.new(value => self).throw + ) + ) + } multi method DELETE-KEY(Mix:D: \k) { X::Immutable.new(method => 'DELETE-KEY', typename => self.^name).throw; } diff --git a/src/core/MixHash.pm b/src/core/MixHash.pm index 030b49bd1d0..44eaff9de2f 100644 --- a/src/core/MixHash.pm +++ b/src/core/MixHash.pm @@ -4,6 +4,17 @@ my class MixHash does Mixy { method total() { Rakudo::QuantHash.MIX-TOTAL($!elems) } method !total-positive() { Rakudo::QuantHash.MIX-TOTAL-POSITIVE($!elems) } + method STORE(*@pairs --> MixHash:D) { + nqp::if( + (my $iterator := @pairs.iterator).is-lazy, + Failure.new(X::Cannot::Lazy.new(:action,:what(self.^name))), + self.SET-SELF( + Rakudo::QuantHash.ADD-PAIRS-TO-MIX( + nqp::create(Rakudo::Internals::IterationSet), $iterator + ) + ) + ) + } multi method AT-KEY(MixHash:D: \k) is raw { Proxy.new( FETCH => { diff --git a/src/core/Set.pm b/src/core/Set.pm index f83552172a7..289e4d23537 100644 --- a/src/core/Set.pm +++ b/src/core/Set.pm @@ -88,6 +88,22 @@ my class Set does Setty { } #--- interface methods + method STORE(*@pairs, :$initialize --> Set:D) { + nqp::if( + (my $iterator := @pairs.iterator).is-lazy, + Failure.new(X::Cannot::Lazy.new(:action,:what(self.^name))), + nqp::if( + $initialize, + self.SET-SELF( + Rakudo::QuantHash.ADD-PAIRS-TO-SET( + nqp::create(Rakudo::Internals::IterationSet), $iterator + ) + ), + X::Assignment::RO.new(value => self).throw + ) + ) + } + multi method AT-KEY(Set:D: \k --> Bool:D) { nqp::p6bool($!elems && nqp::existskey($!elems,k.WHICH)) } diff --git a/src/core/SetHash.pm b/src/core/SetHash.pm index 5d954512c0b..fcc523e4af6 100644 --- a/src/core/SetHash.pm +++ b/src/core/SetHash.pm @@ -176,6 +176,18 @@ my class SetHash does Setty { } #--- interface methods + method STORE(*@pairs --> SetHash:D) { + nqp::if( + (my $iterator := @pairs.iterator).is-lazy, + Failure.new(X::Cannot::Lazy.new(:action,:what(self.^name))), + self.SET-SELF( + Rakudo::QuantHash.ADD-PAIRS-TO-SET( + nqp::create(Rakudo::Internals::IterationSet), $iterator + ) + ) + ) + } + multi method AT-KEY(SetHash:D: \k --> Bool:D) is raw { Proxy.new( FETCH => { From 497e0582e6c64ccc04b2e9636a0bdd44026f3575 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Mon, 30 Oct 2017 14:55:28 +0100 Subject: [PATCH 610/692] Make X::Immutable::RO not show all of its gist If it gets too long. It's just there for you to get a hint :-). This fixes RT #132353 --- src/core/Exception.pm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/core/Exception.pm b/src/core/Exception.pm index 29cc05016d7..d2931a923b6 100644 --- a/src/core/Exception.pm +++ b/src/core/Exception.pm @@ -2267,7 +2267,9 @@ my class X::TypeCheck::Splice is X::TypeCheck does X::Comp { my class X::Assignment::RO is Exception { has $.value = "value"; method message { - "Cannot modify an immutable {$.value.^name} ({$.value.gist})" + my $gist = $.value.gist; + $gist = "$gist.substr(0,20)..." if $gist.chars > 23; + "Cannot modify an immutable {$.value.^name} ($gist)" } method typename { $.value.^name } } From ae1f0fdafc2e363209a8cdffa6f87c13c1063ce1 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Mon, 30 Oct 2017 17:29:05 +0100 Subject: [PATCH 611/692] Reset default @snaps as soon as we start periods --- lib/Telemetry.pm6 | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/lib/Telemetry.pm6 b/lib/Telemetry.pm6 index 873daac00ad..89713e74a14 100644 --- a/lib/Telemetry.pm6 +++ b/lib/Telemetry.pm6 @@ -132,11 +132,10 @@ multi sub snap(@s --> Nil) { @s.push(Telemetry.new) } proto sub periods(|) is export { * } multi sub periods() { - @snaps.push(Telemetry.new) if @snaps == 1; - (1..^@snaps).map: { - LAST @snaps = (); - @snaps[$_] - @snaps[$_ - 1] - } + my @s = @snaps; + @snaps = (); + @s.push(Telemetry.new) if @s == 1; + (1..^@s).map: { @s[$_] - @s[$_ - 1] } } multi sub periods(@s) { (1..^@s).map: { @s[$_] - @s[$_ - 1] } } From 0edd0cc9c1d7d9e0740eb8c93f6dbbf11b216536 Mon Sep 17 00:00:00 2001 From: MasterDuke17 Date: Mon, 30 Oct 2017 12:33:57 -0400 Subject: [PATCH 612/692] Normalize proto bodies Convert all `{ * }` to `{*}` for consistency. --- src/core/Any-iterable-methods.pm | 54 +++++++------- src/core/Any.pm | 122 +++++++++++++++---------------- src/core/Complex.pm | 4 +- src/core/Cool.pm | 20 ++--- src/core/Date.pm | 2 +- src/core/DateTime.pm | 2 +- src/core/IO/Path.pm | 8 +- src/core/Int.pm | 2 +- src/core/List.pm | 12 +-- src/core/Mu.pm | 48 ++++++------ src/core/Numeric.pm | 70 +++++++++--------- src/core/Proc/Async.pm | 10 +-- src/core/Rakudo/Internals.pm | 2 +- src/core/Range.pm | 6 +- src/core/Real.pm | 4 +- src/core/ShapedArray.pm | 2 +- src/core/Str.pm | 34 ++++----- src/core/array_operators.pm | 2 +- src/core/control.pm | 14 ++-- src/core/hash_slice.pm | 4 +- src/core/io_operators.pm | 26 +++---- src/core/metaops.pm | 18 ++--- src/core/operators.pm | 12 +-- 23 files changed, 239 insertions(+), 239 deletions(-) diff --git a/src/core/Any-iterable-methods.pm b/src/core/Any-iterable-methods.pm index 498280fab6a..21b6c013569 100644 --- a/src/core/Any-iterable-methods.pm +++ b/src/core/Any-iterable-methods.pm @@ -8,7 +8,7 @@ use MONKEY-TYPING; augment class Any { - proto method map(|) is nodal { * } + proto method map(|) is nodal {*} multi method map(Hash \h) { die "Cannot map a {self.^name} to a {h.^name}. Did you mean to add a stub (\{...\}) or did you mean to .classify?" @@ -767,7 +767,7 @@ Did you mean to add a stub (\{...\}) or did you mean to .classify?" ) } - proto method flatmap (|) is nodal { * } + proto method flatmap (|) is nodal {*} multi method flatmap(&block, :$label) { self.map(&block, :$label).flat } @@ -992,7 +992,7 @@ Did you mean to add a stub (\{...\}) or did you mean to .classify?" ) } - proto method grep(|) is nodal { * } + proto method grep(|) is nodal {*} multi method grep(Bool:D $t) { X::Match::Bool.new( type => '.grep').throw } @@ -1065,7 +1065,7 @@ Did you mean to add a stub (\{...\}) or did you mean to .classify?" } } - proto method first(|) is nodal { * } + proto method first(|) is nodal {*} multi method first(Bool:D $t) { Failure.new(X::Match::Bool.new( type => '.first' )) } @@ -1177,7 +1177,7 @@ Did you mean to add a stub (\{...\}) or did you mean to .classify?" ) } - proto method min (|) is nodal { * } + proto method min (|) is nodal {*} multi method min() { nqp::stmts( nqp::if( @@ -1211,7 +1211,7 @@ Did you mean to add a stub (\{...\}) or did you mean to .classify?" ) } - proto method max (|) is nodal { * } + proto method max (|) is nodal {*} multi method max() { nqp::stmts( nqp::if( @@ -1288,7 +1288,7 @@ Did you mean to add a stub (\{...\}) or did you mean to .classify?" ) } - proto method minmax (|) is nodal { * } + proto method minmax (|) is nodal {*} multi method minmax() { nqp::stmts( nqp::if( @@ -1391,7 +1391,7 @@ Did you mean to add a stub (\{...\}) or did you mean to .classify?" ) } - proto method sort(|) is nodal { * } + proto method sort(|) is nodal {*} multi method sort() { nqp::if( nqp::eqaddr( @@ -1459,14 +1459,14 @@ Did you mean to add a stub (\{...\}) or did you mean to .classify?" ) } - proto method reduce(|) { * } + proto method reduce(|) {*} multi method reduce(&with) is nodal { return unless self.DEFINITE; my $reducer := find-reducer-for-op(&with); $reducer(&with)(self) if $reducer; } - proto method produce(|) { * } + proto method produce(|) {*} multi method produce(&with) is nodal { return unless self.DEFINITE; my $reducer := find-reducer-for-op(&with); @@ -1781,7 +1781,7 @@ Did you mean to add a stub (\{...\}) or did you mean to .classify?" }.new(self, &with)) } - proto method pairup(|) is nodal { * } + proto method pairup(|) is nodal {*} multi method pairup(Any:U:) { () } multi method pairup(Any:D:) { my \iter := self.iterator; @@ -1810,7 +1810,7 @@ Did you mean to add a stub (\{...\}) or did you mean to .classify?" } } - proto method head(|) { * } + proto method head(|) {*} multi method head(Any:D:) is raw { nqp::if( nqp::eqaddr((my $pulled := self.iterator.pull-one),IterationEnd), @@ -1827,7 +1827,7 @@ Did you mean to add a stub (\{...\}) or did you mean to .classify?" Seq.new(Rakudo::Iterator.NextNValues(self.iterator,$n)) } - proto method tail(|) { * } + proto method tail(|) {*} multi method tail(Any:D:) is raw { nqp::if( nqp::eqaddr((my $pulled := @@ -1852,7 +1852,7 @@ Did you mean to add a stub (\{...\}) or did you mean to .classify?" ) } - proto method minpairs(|) { * } + proto method minpairs(|) {*} multi method minpairs(Any:D:) { my @found; for self.pairs { @@ -1870,7 +1870,7 @@ Did you mean to add a stub (\{...\}) or did you mean to .classify?" Seq.new(@found.iterator) } - proto method maxpairs(|) { * } + proto method maxpairs(|) {*} multi method maxpairs(Any:D:) { my @found; for self.pairs { @@ -1888,7 +1888,7 @@ Did you mean to add a stub (\{...\}) or did you mean to .classify?" Seq.new(@found.iterator) } - proto method batch(|) is nodal { * } + proto method batch(|) is nodal {*} multi method batch(Any:D: Int:D :$elems!) { Seq.new(Rakudo::Iterator.Batch(self.iterator,$elems,1)) } @@ -1896,7 +1896,7 @@ Did you mean to add a stub (\{...\}) or did you mean to .classify?" Seq.new(Rakudo::Iterator.Batch(self.iterator,$batch,1)) } - proto method rotor(|) is nodal { * } + proto method rotor(|) is nodal {*} multi method rotor(Any:D: Int:D $batch, :$partial) { Seq.new(Rakudo::Iterator.Batch(self.iterator,$batch,$partial)) } @@ -1904,14 +1904,14 @@ Did you mean to add a stub (\{...\}) or did you mean to .classify?" Seq.new(Rakudo::Iterator.Rotor(self.iterator,@cycle,$partial)) } - proto method skip(|) { * } + proto method skip(|) {*} multi method skip() { Seq.new(self.iterator).skip } multi method skip(Int() $n) { Seq.new(self.iterator).skip($n) } } BEGIN Attribute.^compose; -proto sub infix:(|) is pure { * } +proto sub infix:(|) is pure {*} multi sub infix:(Mu:D \a, Mu:U) { a } multi sub infix:(Mu:U, Mu:D \b) { b } multi sub infix:(Mu:D \a, Mu:D \b) { (a cmp b) < 0 ?? a !! b } @@ -1922,7 +1922,7 @@ multi sub infix:(num \a, num \b) { nqp::if(nqp::islt_i(nqp::cmp_n(a, b) multi sub infix:(+args is raw) { args.min } sub min(+args, :&by = &infix:) { args.min(&by) } -proto sub infix:(|) is pure { * } +proto sub infix:(|) is pure {*} multi sub infix:(Mu:D \a, Mu:U) { a } multi sub infix:(Mu:U, Mu:D \b) { b } multi sub infix:(Mu:D \a, Mu:D \b) { (a cmp b) > 0 ?? a !! b } @@ -1933,7 +1933,7 @@ multi sub infix:(num \a, num \b) { nqp::if(nqp::isgt_i(nqp::cmp_n(a, b) multi sub infix:(+args) { args.max } sub max(+args, :&by = &infix:) { args.max(&by) } -proto sub infix:(|) is pure { * } +proto sub infix:(|) is pure {*} multi sub infix:(+args) { args.minmax } sub minmax(+args, :&by = &infix:) { args.minmax(&by) } @@ -1951,22 +1951,22 @@ proto sub first(|) {*} multi sub first(Bool:D $t, |) { Failure.new(X::Match::Bool.new(:type)) } multi sub first(Mu $test, +values, *%a) { values.first($test,|%a) } -proto sub join(|) { * } +proto sub join(|) {*} multi sub join($sep = '', *@values) { @values.join($sep) } -proto sub reduce (|) { * } +proto sub reduce (|) {*} multi sub reduce (&with, +list) { list.reduce(&with) } -proto sub produce (|) { * } +proto sub produce (|) {*} multi sub produce (&with, +list) { list.produce(&with) } -proto sub unique(|) { * } +proto sub unique(|) {*} multi sub unique(+values, |c) { my $laze = values.is-lazy; values.unique(|c).lazy-if($laze) } -proto sub squish(|) { * } +proto sub squish(|) {*} multi sub squish(+values, |c) { my $laze = values.is-lazy; values.squish(|c).lazy-if($laze) } -proto sub repeated(|) { * } +proto sub repeated(|) {*} multi sub repeated(+values, |c) { my $laze = values.is-lazy; values.repeated(|c).lazy-if($laze) } proto sub sort(|) {*} diff --git a/src/core/Any.pm b/src/core/Any.pm index d8a9c42b0ba..98c08f47709 100644 --- a/src/core/Any.pm +++ b/src/core/Any.pm @@ -21,17 +21,17 @@ my class Any { # declared in BOOTSTRAP nqp::p6bool(nqp::istype(topic, self)) # so that all(@foo) ~~ Type works as expected } - proto method EXISTS-KEY(|) is nodal { * } + proto method EXISTS-KEY(|) is nodal {*} multi method EXISTS-KEY(Any:U: $ --> False) { } multi method EXISTS-KEY(Any:D: $ --> False) { } - proto method DELETE-KEY(|) is nodal { * } + proto method DELETE-KEY(|) is nodal {*} multi method DELETE-KEY(Any:U: $ --> Nil) { } multi method DELETE-KEY(Any:D: $) { Failure.new("Can not remove values from a {self.^name}") } - proto method DELETE-POS(|) is nodal { * } + proto method DELETE-POS(|) is nodal {*} multi method DELETE-POS(Any:U: $pos --> Nil) { } multi method DELETE-POS(Any:D: $pos) { Failure.new("Can not remove elements from a {self.^name}") @@ -49,77 +49,77 @@ my class Any { # declared in BOOTSTRAP method cache() { self.list } - proto method list(|) is nodal { * } + proto method list(|) is nodal {*} multi method list(Any:U:) { infix:<,>(self) } multi method list(Any:D \SELF:) { infix:<,>(SELF) } - proto method flat(|) is nodal { * } + proto method flat(|) is nodal {*} multi method flat() { self.list.flat } - proto method eager(|) is nodal { * } + proto method eager(|) is nodal {*} multi method eager() { self.list.eager } - proto method serial(|) is nodal { * } + proto method serial(|) is nodal {*} multi method serial() { self } # derived from .list - proto method List(|) is nodal { * } + proto method List(|) is nodal {*} multi method List() { self.list } - proto method Slip(|) is nodal { * } + proto method Slip(|) is nodal {*} multi method Slip() { self.list.Slip } - proto method Array(|) is nodal { * } + proto method Array(|) is nodal {*} multi method Array() { self.list.Array } - proto method Seq(|) is nodal { * } + proto method Seq(|) is nodal {*} multi method Seq() { Seq.new(self.iterator) } - proto method hash(|) is nodal { * } + proto method hash(|) is nodal {*} multi method hash(Any:U:) { my % = () } multi method hash(Any:D:) { my % = self } # derived from .hash - proto method Hash(|) is nodal { * } + proto method Hash(|) is nodal {*} multi method Hash() { self.hash.Hash } - proto method Map(|) is nodal { * } + proto method Map(|) is nodal {*} multi method Map() { self.hash.Map } - proto method elems(|) is nodal { * } + proto method elems(|) is nodal {*} multi method elems(Any:U: --> 1) { } multi method elems(Any:D:) { self.list.elems } - proto method end(|) is nodal { * } + proto method end(|) is nodal {*} multi method end(Any:U: --> 0) { } multi method end(Any:D:) { self.list.end } - proto method keys(|) is nodal { * } + proto method keys(|) is nodal {*} multi method keys(Any:U:) { () } multi method keys(Any:D:) { self.list.keys } - proto method kv(|) is nodal { * } + proto method kv(|) is nodal {*} multi method kv(Any:U:) { () } multi method kv(Any:D:) { self.list.kv } - proto method values(|) is nodal { * } + proto method values(|) is nodal {*} multi method values(Any:U:) { () } multi method values(Any:D:) { self.list } - proto method pairs(|) is nodal { * } + proto method pairs(|) is nodal {*} multi method pairs(Any:U:) { () } multi method pairs(Any:D:) { self.list.pairs } - proto method antipairs(|) is nodal { * } + proto method antipairs(|) is nodal {*} multi method antipairs(Any:U:) { () } multi method antipairs(Any:D:) { self.list.antipairs } - proto method invert(|) is nodal { * } + proto method invert(|) is nodal {*} multi method invert(Any:U:) { () } multi method invert(Any:D:) { self.list.invert } - proto method pick(|) is nodal { * } + proto method pick(|) is nodal {*} multi method pick() { self.list.pick } multi method pick($n) { self.list.pick($n) } - proto method roll(|) is nodal { * } + proto method roll(|) is nodal {*} multi method roll() { self.list.roll } multi method roll($n) { self.list.roll($n) } @@ -127,7 +127,7 @@ my class Any { # declared in BOOTSTRAP method match(Any:U: |) { self.Str; nqp::getlexcaller('$/') = Nil } - proto method classify(|) is nodal { * } + proto method classify(|) is nodal {*} multi method classify() { die "Must specify something to classify with, a Callable, Hash or List"; } @@ -141,7 +141,7 @@ my class Any { # declared in BOOTSTRAP Hash.^parameterize(Any,Any).new.classify-list( $test, self, :&as ); } - proto method categorize(|) is nodal { * } + proto method categorize(|) is nodal {*} multi method categorize() { die "Must specify something to categorize with, a Callable, Hash or List"; } @@ -166,7 +166,7 @@ my class Any { # declared in BOOTSTRAP method deepmap(&block) is nodal { deepmap(&block, self) } # XXX GLR Do we need tree post-GLR? - proto method tree(|) is nodal { * } + proto method tree(|) is nodal {*} multi method tree(Any:U:) { self } multi method tree(Any:D:) { nqp::istype(self, Iterable) @@ -194,25 +194,25 @@ my class Any { # declared in BOOTSTRAP SELF.push(|values); } - proto method append(|) is nodal { * } + proto method append(|) is nodal {*} multi method append(Any:U \SELF: |values) { SELF = nqp::istype(SELF,Positional) ?? SELF.new !! Array.new; SELF.append(|values); } - proto method unshift(|) is nodal { * } + proto method unshift(|) is nodal {*} multi method unshift(Any:U \SELF: |values) { SELF = Array.new; SELF.unshift(|values); } - proto method prepend(|) is nodal { * } + proto method prepend(|) is nodal {*} multi method prepend(Any:U \SELF: |values) { SELF = Array.new; SELF.prepend(|values); } - proto method EXISTS-POS(|) is nodal { * } + proto method EXISTS-POS(|) is nodal {*} multi method EXISTS-POS(Any:U: Any:D $ --> False) { } multi method EXISTS-POS(Any:U: Any:U $pos) { die "Cannot use '{$pos.^name}' as an index"; @@ -317,7 +317,7 @@ my class Any { # declared in BOOTSTRAP Rakudo::Internals.WALK-AT-POS(self,@indices).AT-POS($final) } - proto method ZEN-POS(|) { * } + proto method ZEN-POS(|) {*} multi method ZEN-POS(*%unexpected) { %unexpected ?? Failure.new(X::Adverb.new( @@ -327,7 +327,7 @@ my class Any { # declared in BOOTSTRAP !! self } - proto method ZEN-KEY(|) { * } + proto method ZEN-KEY(|) {*} multi method ZEN-KEY(*%unexpected) { %unexpected ?? Failure.new(X::Adverb.new( @@ -337,7 +337,7 @@ my class Any { # declared in BOOTSTRAP !! self } - proto method ASSIGN-POS(|) is nodal { * } + proto method ASSIGN-POS(|) is nodal {*} multi method ASSIGN-POS(Any:U \SELF: \pos, Mu \assignee) { SELF.AT-POS(pos) = assignee; # defer < 0 check } @@ -371,7 +371,7 @@ my class Any { # declared in BOOTSTRAP Rakudo::Internals.WALK-AT-POS(self,@indices).ASSIGN-POS($final,value) } - proto method BIND-POS(|) { * } + proto method BIND-POS(|) {*} multi method BIND-POS(Any:D: **@indices is raw) is raw { # looks like Array.pop doesn't really return a bindable container # my \value := @indices.pop; @@ -395,7 +395,7 @@ my class Any { # declared in BOOTSTRAP method none() is nodal { Junction.new("none",self) } # internals - proto method AT-KEY(|) is nodal { * } + proto method AT-KEY(|) is nodal {*} multi method AT-KEY(Any:D: $key) is raw { Failure.new( self ~~ Associative ?? "Associative indexing implementation missing from type {self.WHAT.perl}" @@ -420,7 +420,7 @@ my class Any { # declared in BOOTSTRAP ) } - proto method BIND-KEY(|) is nodal { * } + proto method BIND-KEY(|) is nodal {*} multi method BIND-KEY(Any:D: \k, \v) is raw { Failure.new(X::Bind.new(target => self.^name)) } @@ -430,7 +430,7 @@ my class Any { # declared in BOOTSTRAP $BIND } - proto method ASSIGN-KEY(|) is nodal { * } + proto method ASSIGN-KEY(|) is nodal {*} multi method ASSIGN-KEY(\SELF: \key, Mu \assignee) is raw { SELF.AT-KEY(key) = assignee; } @@ -442,26 +442,26 @@ my class Any { # declared in BOOTSTRAP } method FLATTENABLE_HASH() is nodal { nqp::hash() } - proto method Set(|) is nodal { * } + proto method Set(|) is nodal {*} multi method Set(Any:) { Set.new-from-pairs(self.list) } - proto method SetHash(|) is nodal { * } + proto method SetHash(|) is nodal {*} multi method SetHash(Any:) { SetHash.new-from-pairs(self.list) } - proto method Bag(|) is nodal { * } + proto method Bag(|) is nodal {*} multi method Bag(Any:) { Bag.new-from-pairs(self.list) } - proto method BagHash(|) is nodal { * } + proto method BagHash(|) is nodal {*} multi method BagHash(Any:) { BagHash.new-from-pairs(self.list) } - proto method Mix(|) is nodal { * } + proto method Mix(|) is nodal {*} multi method Mix(Any:) { Mix.new-from-pairs(self.list) } - proto method MixHash(|) is nodal { * } + proto method MixHash(|) is nodal {*} multi method MixHash() { MixHash.new-from-pairs(self.list) } # XXX GLR does this really need to force a list? - proto method Supply(|) is nodal { * } + proto method Supply(|) is nodal {*} multi method Supply() { self.list.Supply } method nl-out() { "\n" } @@ -483,7 +483,7 @@ my class Any { # declared in BOOTSTRAP Metamodel::ClassHOW.exclude_parent(Any); # builtin ops -proto sub infix:<===>(Mu $?, Mu $?) is pure { * } +proto sub infix:<===>(Mu $?, Mu $?) is pure {*} multi sub infix:<===>($?) { Bool::True } multi sub infix:<===>(\a, \b) { nqp::p6bool( @@ -493,50 +493,50 @@ multi sub infix:<===>(\a, \b) { ) } -proto sub infix:(Mu $?, Mu $?) is pure { * } +proto sub infix:(Mu $?, Mu $?) is pure {*} multi sub infix:($?) { Bool::True } multi sub infix:(\a, \b) { (a cmp b) < 0 } -proto sub infix:(Mu $?, Mu $?) is pure { * } +proto sub infix:(Mu $?, Mu $?) is pure {*} multi sub infix:($x?) { Bool::True } multi sub infix:(\a, \b) { (a cmp b) > 0 } -proto prefix:<++>(Mu) { * } +proto prefix:<++>(Mu) {*} multi prefix:<++>(Mu:D $a is rw) { $a = $a.succ } multi prefix:<++>(Mu:U $a is rw) { $a = 1 } -proto prefix:<-->(Mu) { * } +proto prefix:<-->(Mu) {*} multi prefix:<-->(Mu:D $a is rw) { $a = $a.pred } multi prefix:<-->(Mu:U $a is rw) { $a = -1 } -proto postfix:<++>(Mu) { * } +proto postfix:<++>(Mu) {*} multi postfix:<++>(Mu:D $a is rw) { my $b = $a; $a = $a.succ; $b } multi postfix:<++>(Mu:U $a is rw) { $a = 1; 0 } -proto postfix:<-->(Mu) { * } +proto postfix:<-->(Mu) {*} multi postfix:<-->(Mu:D $a is rw) { my $b = $a; $a = $a.pred; $b } multi postfix:<-->(Mu:U $a is rw) { $a = -1; 0 } -proto sub pick(|) { * } +proto sub pick(|) {*} multi sub pick($n, +values) { values.pick($n) } -proto sub roll(|) { * } +proto sub roll(|) {*} multi sub roll($n, +values) { values.roll($n) } -proto sub keys(|) { * } +proto sub keys(|) {*} multi sub keys($x) { $x.keys } -proto sub values(|) { * } +proto sub values(|) {*} multi sub values($x) { $x.values } -proto sub pairs(|) { * } +proto sub pairs(|) {*} multi sub pairs($x) { $x.pairs } -proto sub kv(|) { * } +proto sub kv(|) {*} multi sub kv($x) { $x.kv } -proto sub elems(|) is nodal { * } +proto sub elems(|) is nodal {*} multi sub elems($a) { $a.elems } -proto sub end(|) { * } +proto sub end(|) {*} multi sub end($a) { $a.end } proto sub sum(|) {*} @@ -563,7 +563,7 @@ sub categorize( $test, +items, *%named ) { } } -proto sub item(|) is pure { * } +proto sub item(|) is pure {*} multi sub item(\x) { my $ = x } multi sub item(|c) { my $ = c.list } multi sub item(Mu $a) { $a } diff --git a/src/core/Complex.pm b/src/core/Complex.pm index 1b433922f9c..1f782e736fb 100644 --- a/src/core/Complex.pm +++ b/src/core/Complex.pm @@ -8,7 +8,7 @@ my class Complex is Cool does Numeric { $!im = im; self } - proto method new(|) { * } + proto method new(|) {*} multi method new() { self.new: 0, 0 } multi method new(Real \re, Real \im) { nqp::create(self)!SET-SELF(re, im) } @@ -487,7 +487,7 @@ multi sub infix:«<=>»(Complex:D \a, Complex:D \b --> Order:D) { multi sub infix:«<=>»(Num(Real) \a, Complex:D \b --> Order:D) { a.Complex <=> b } multi sub infix:«<=>»(Complex:D \a, Num(Real) \b --> Order:D) { a <=> b.Complex } -proto sub postfix:(\a --> Complex:D) is pure { * } +proto sub postfix:(\a --> Complex:D) is pure {*} multi sub postfix:(Real \a --> Complex:D) { Complex.new(0e0, a); } multi sub postfix:(Complex:D \a --> Complex:D) { Complex.new(-a.im, a.re) } multi sub postfix:(Numeric \a --> Complex:D) { a * Complex.new(0e0, 1e0) } diff --git a/src/core/Cool.pm b/src/core/Cool.pm index 87bfd876bc2..9126686b6f1 100644 --- a/src/core/Cool.pm +++ b/src/core/Cool.pm @@ -43,7 +43,7 @@ my class Cool { # declared in BOOTSTRAP multi method exp(Cool:D: ) { self.Numeric.exp } multi method exp(Cool:D: $base) { self.Numeric.exp($base.Numeric) } - proto method round(|) { * } + proto method round(|) {*} multi method round() { self.Numeric.round() } multi method round($base) { self.Numeric.round($base) } @@ -109,7 +109,7 @@ my class Cool { # declared in BOOTSTRAP method chomp(Cool:D:) { self.Str.chomp } - proto method chop(|) { * } + proto method chop(|) {*} multi method chop(Cool:D:) { self.Str.chop } multi method chop(Cool:D: Int() $n) { self.Str.chop($n) } @@ -184,7 +184,7 @@ my class Cool { # declared in BOOTSTRAP $match } - proto method IO(|) { * } + proto method IO(|) {*} multi method IO(Cool:D:) { IO::Path.new(self) } multi method IO(Cool:U:) { IO::Path } @@ -209,7 +209,7 @@ my class Cool { # declared in BOOTSTRAP ) } - proto method Int(|) { * } + proto method Int(|) {*} multi method Int() { nqp::if( nqp::istype((my $numeric := self.Numeric), Failure), @@ -218,7 +218,7 @@ my class Cool { # declared in BOOTSTRAP ) } - proto method UInt(|) { * } + proto method UInt(|) {*} multi method UInt() { my $got := self.Int; $got < 0 @@ -263,7 +263,7 @@ my class Cool { # declared in BOOTSTRAP } Metamodel::ClassHOW.exclude_parent(Cool); -proto sub chop(|) { * } +proto sub chop(|) {*} multi sub chop(Cool:D $s --> Str:D) { $s.chop } multi sub chop(Cool:D $s, Int() $n --> Str:D) { $s.chop($n) } @@ -282,19 +282,19 @@ sub indices(Cool $s, |c) { $s.indices(|c); } -proto sub rindex($, $, $?) is pure { * }; +proto sub rindex($, $, $?) is pure {*}; multi sub rindex(Cool $s, Cool $needle, Cool $pos) { $s.rindex($needle, $pos) }; multi sub rindex(Cool $s, Cool $needle) { $s.rindex($needle) }; -proto sub ords($) is pure { * } +proto sub ords($) is pure {*} multi sub ords(Cool $s) { ords($s.Stringy) } -proto sub comb($, $, $?) { * } +proto sub comb($, $, $?) {*} multi sub comb(Regex $matcher, Cool $input, $limit = *) { $input.comb($matcher, $limit) } multi sub comb(Str $matcher, Cool $input, $limit = *) { $input.comb($matcher, $limit) } multi sub comb(Int:D $matcher, Cool $input, $limit = *) { $input.comb($matcher, $limit) } -proto sub wordcase($) is pure { * } +proto sub wordcase($) is pure {*} multi sub wordcase(Str:D $x) {$x.wordcase } multi sub wordcase(Cool $x) {$x.Str.wordcase } diff --git a/src/core/Date.pm b/src/core/Date.pm index e0ba0735f9e..84d3da39110 100644 --- a/src/core/Date.pm +++ b/src/core/Date.pm @@ -157,7 +157,7 @@ my class Date does Dateish { $dt.day == $!day && $dt.month == $!month && $dt.year == $!year } - proto method DateTime() { * } + proto method DateTime() {*} multi method DateTime(Date:D:) { DateTime.new(:$!year, :$!month, :$!day) } multi method DateTime(Date:U:) { DateTime } method Date() { self } diff --git a/src/core/DateTime.pm b/src/core/DateTime.pm index 3d8188a70ca..5250212b808 100644 --- a/src/core/DateTime.pm +++ b/src/core/DateTime.pm @@ -366,7 +366,7 @@ my class DateTime does Dateish { method utc() { self.in-timezone(0) } method local() { self.in-timezone($*TZ) } - proto method Date() { * } + proto method Date() {*} multi method Date(DateTime:D:) { Date.new($!year,$!month,$!day) } multi method Date(DateTime:U:) { Date } method DateTime() { self } diff --git a/src/core/IO/Path.pm b/src/core/IO/Path.pm index 73622916080..3e46f2a3e33 100644 --- a/src/core/IO/Path.pm +++ b/src/core/IO/Path.pm @@ -214,7 +214,7 @@ my class IO::Path is Cool does IO { } #?endif - proto method absolute(|) { * } + proto method absolute(|) {*} multi method absolute (IO::Path:D:) { $!abspath //= $!SPEC.rel2abs($!path,$!CWD) } @@ -326,7 +326,7 @@ my class IO::Path is Cool does IO { $resolved = $sep unless nqp::chars($resolved); IO::Path!new-from-absolute-path($resolved,:$!SPEC,:CWD($sep)); } - proto method parent(|) { * } + proto method parent(|) {*} multi method parent(IO::Path:D: UInt:D $depth) { my $io = self; $io .= parent xx $depth; @@ -402,7 +402,7 @@ my class IO::Path is Cool does IO { self.bless: :path($!SPEC.join: '', $!path, what), :$!SPEC, :$!CWD; } - proto method chdir(|) { * } + proto method chdir(|) {*} multi method chdir(IO::Path:D: Str() $path, :$test!) { DEPRECATED( :what<:$test argument>, @@ -605,7 +605,7 @@ my class IO::Path is Cool does IO { } } - proto method slurp() { * } + proto method slurp() {*} multi method slurp(IO::Path:D: :$enc, :$bin) { # We use an IO::Handle in binary mode, and then decode the string # all in one go, which avoids the overhead of setting up streaming diff --git a/src/core/Int.pm b/src/core/Int.pm index bc818bdea4f..6b466c14dd3 100644 --- a/src/core/Int.pm +++ b/src/core/Int.pm @@ -79,7 +79,7 @@ my class Int does Real { # declared in BOOTSTRAP method sqrt(Int:D:) { nqp::p6box_n(nqp::sqrt_n(nqp::tonum_I(self))) } - proto method base(|) { * } + proto method base(|) {*} multi method base(Int:D: Int:D $base) { 2 <= $base <= 36 ?? nqp::p6box_s(nqp::base_I(self,nqp::unbox_i($base))) diff --git a/src/core/List.pm b/src/core/List.pm index f4472dbc13a..90b9b604f91 100644 --- a/src/core/List.pm +++ b/src/core/List.pm @@ -393,7 +393,7 @@ my class List does Iterable does Positional { # declared in BOOTSTRAP ) } - proto method fmt(|) { * } + proto method fmt(|) {*} multi method fmt() { nqp::if( (my int $elems = self.elems), # reifies @@ -724,7 +724,7 @@ my class List does Iterable does Positional { # declared in BOOTSTRAP # Store in List targets containers with in the list. This handles list # assignments, like ($a, $b) = foo(). - proto method STORE(|) { * } + proto method STORE(|) {*} multi method STORE(List:D: Iterable:D \iterable) { # First pass -- scan lhs containers and pick out scalar versus list # assignment. This also reifies the RHS values we need, and deconts @@ -932,7 +932,7 @@ my class List does Iterable does Positional { # declared in BOOTSTRAP ) } - proto method pick(|) is nodal { * } + proto method pick(|) is nodal {*} multi method pick(List:D:) { self.is-lazy ?? Failure.new(X::Cannot::Lazy.new(:action('.pick from'))) @@ -993,7 +993,7 @@ my class List does Iterable does Positional { # declared in BOOTSTRAP }.new(self,$elems,$number)) } - proto method roll(|) is nodal { * } + proto method roll(|) is nodal {*} multi method roll() { self.is-lazy ?? Failure.new(X::Cannot::Lazy.new(:action('.roll from'))) @@ -1477,7 +1477,7 @@ multi flat(Iterable \a) { a.flat } sub cache(+@l) { @l } -proto sub infix:(|) { * } +proto sub infix:(|) {*} multi sub infix:() { Failure.new("No zero-arg meaning for infix:") } multi sub infix:(Mu \x) { x } multi sub infix:(&x, Num() $n) { @@ -1518,7 +1518,7 @@ multi sub infix:(Mu \x, Int:D $n) is pure { Seq.new(Rakudo::Iterator.OneValueTimes(x,$n)) } -proto sub reverse(|) { * } +proto sub reverse(|) {*} multi sub reverse(@a) { @a.reverse } multi sub reverse(+@a) { @a.reverse } diff --git a/src/core/Mu.pm b/src/core/Mu.pm index 6d5d14c66be..df12c920f24 100644 --- a/src/core/Mu.pm +++ b/src/core/Mu.pm @@ -10,7 +10,7 @@ my class Mu { # declared in BOOTSTRAP method sink(--> Nil) { } - proto method ACCEPTS(|) { * } + proto method ACCEPTS(|) {*} multi method ACCEPTS(Mu:U: Any \topic) { nqp::p6bool(nqp::istype(topic, self)) } @@ -42,7 +42,7 @@ my class Mu { # declared in BOOTSTRAP ) } - proto method iterator(|) { * } + proto method iterator(|) {*} multi method iterator(Mu:) { my $buf := nqp::create(IterationBuffer); $buf.push(Mu); @@ -52,8 +52,8 @@ my class Mu { # declared in BOOTSTRAP Rakudo::Iterator.ReifiedList($buf) } - proto method split(|) { * } - proto method splice(|) is nodal { * } + proto method split(|) {*} + proto method splice(|) is nodal {*} method emit { emit self; @@ -72,7 +72,7 @@ my class Mu { # declared in BOOTSTRAP $list; } - proto method WHY(|) { * } + proto method WHY(|) {*} multi method WHY(Mu:) { my Mu $why; @@ -108,7 +108,7 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" nqp::p6bool(nqp::isconcrete(self)) } - proto method new(|) { * } + proto method new(|) {*} multi method new(*%attrinit) { nqp::if( nqp::eqaddr( @@ -123,7 +123,7 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" X::Constructor::Positional.new(:type( self )).throw(); } - proto method is-lazy (|) { * } + proto method is-lazy (|) {*} multi method is-lazy(Mu: --> False) { } method CREATE() { @@ -535,18 +535,18 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" self } - proto method Numeric(|) { * } + proto method Numeric(|) {*} multi method Numeric(Mu:U \v:) { warn "Use of uninitialized value of type {self.^name} in numeric context"; 0 } - proto method Real(|) { * } + proto method Real(|) {*} multi method Real(Mu:U \v:) { warn "Use of uninitialized value of type {self.^name} in numeric context"; 0 } - proto method Str(|) { * } + proto method Str(|) {*} multi method Str(Mu:U \v:) { my $name = (defined($*VAR_NAME) ?? $*VAR_NAME !! try v.VAR.?name) // ''; $name ~= ' ' if $name ne ''; @@ -563,7 +563,7 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" ) } - proto method Stringy(|) { * } + proto method Stringy(|) {*} multi method Stringy(Mu:U \v:) { my $*VAR_NAME = try v.VAR.?name; self.Str @@ -572,7 +572,7 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" method item(Mu \item:) is raw { item } - proto method say(|) { * } + proto method say(|) {*} multi method say() { say(self) } method print() { print(self) } method put() { put(self) } @@ -602,7 +602,7 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" } } - proto method gist(|) { * } + proto method gist(|) {*} multi method gist(Mu:U:) { '(' ~ self.^shortname ~ ')' } multi method gist(Mu:D:) { self.perl } @@ -634,7 +634,7 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" } } - proto method perl(|) { * } + proto method perl(|) {*} multi method perl(Mu:U:) { self.^name } multi method perl(Mu:D:) { nqp::if( @@ -651,7 +651,7 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" ) } - proto method DUMP(|) { * } + proto method DUMP(|) {*} multi method DUMP(Mu:U:) { self.perl } multi method DUMP(Mu:D: :$indent-step = 4, :%ctx?) { return DUMP(self, :$indent-step) unless %ctx; @@ -708,7 +708,7 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" @pieces.DUMP-PIECES($before, :$indent-step); } - proto method isa(|) { * } + proto method isa(|) {*} multi method isa(Mu \SELF: Mu $type) { nqp::p6bool(SELF.^isa($type.WHAT)) } @@ -732,7 +732,7 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" SELF.^can($name) } - proto method clone (|) { * } + proto method clone (|) {*} multi method clone(Mu:U: *%twiddles) { %twiddles and die 'Cannot set attribute values when cloning a type object'; self @@ -942,26 +942,26 @@ Perhaps it can be found at https://docs.perl6.org/type/$name" } -proto sub defined(Mu) is pure { * } +proto sub defined(Mu) is pure {*} multi sub defined(Mu \x) { x.defined } -proto sub infix:<~~>(Mu \topic, Mu \matcher) { * } +proto sub infix:<~~>(Mu \topic, Mu \matcher) {*} multi sub infix:<~~>(Mu \topic, Mu \matcher) { matcher.ACCEPTS(topic).Bool; } -proto sub infix:(Mu \topic, Mu \matcher) { * } +proto sub infix:(Mu \topic, Mu \matcher) {*} multi sub infix:(Mu \topic, Mu \matcher) { matcher.ACCEPTS(topic).not; } -proto sub infix:<=:=>(Mu $?, Mu $?) is pure { * } +proto sub infix:<=:=>(Mu $?, Mu $?) is pure {*} multi sub infix:<=:=>($?) { Bool::True } multi sub infix:<=:=>(Mu \a, Mu \b) { nqp::p6bool(nqp::eqaddr(a, b)); } -proto sub infix:(Any $?, Any $?) is pure { * } +proto sub infix:(Any $?, Any $?) is pure {*} multi sub infix:($?) { Bool::True } # Last ditch snapshot semantics. We shouldn't come here too often, so @@ -1074,9 +1074,9 @@ sub DUMP(|args (*@args, :$indent-step = 4, :%ctx?)) { } # U+2212 minus (forward call to regular minus) -proto sub infix:<−>(|) is pure { * } +proto sub infix:<−>(|) is pure {*} multi sub infix:<−>(|c) { infix:<->(|c) } -proto sub prefix:<−>(|) is pure { * } +proto sub prefix:<−>(|) is pure {*} multi sub prefix:<−>(|c) { prefix:<->(|c) } # These must collapse Junctions diff --git a/src/core/Numeric.pm b/src/core/Numeric.pm index 49568ab78cb..756d1833651 100644 --- a/src/core/Numeric.pm +++ b/src/core/Numeric.pm @@ -42,13 +42,13 @@ multi sub infix:(Numeric:D \a, Numeric:D \b) { ## arithmetic operators -proto sub prefix:<+>($?) is pure { * } +proto sub prefix:<+>($?) is pure {*} multi sub prefix:<+>(\a) { a.Numeric } -proto sub prefix:<->($?) is pure { * } +proto sub prefix:<->($?) is pure {*} multi sub prefix:<->(\a) { -a.Numeric } -proto sub abs($) is pure { * } +proto sub abs($) is pure {*} multi sub abs(\a) { abs a.Numeric } proto sub sign($) is pure {*} @@ -169,53 +169,53 @@ proto sub sqrt($) is pure {*} multi sub sqrt(Numeric \x) { x.sqrt } multi sub sqrt(Cool \x) { x.Numeric.sqrt } -proto sub roots($, $) is pure { * } +proto sub roots($, $) is pure {*} multi sub roots($x, Cool $n) { $x.Numeric.Complex.roots($n.Int) } multi sub roots($x, Numeric $n) { $x.Numeric.Complex.roots($n.Int) } -proto sub floor($) is pure { * } +proto sub floor($) is pure {*} multi sub floor($a) { $a.Numeric.floor } multi sub floor(Numeric $a) { $a.floor } -proto sub ceiling($) is pure { * } +proto sub ceiling($) is pure {*} multi sub ceiling($a) { $a.Numeric.ceiling } multi sub ceiling(Numeric $a) { $a.ceiling } -proto sub round($, $?) is pure { * } +proto sub round($, $?) is pure {*} multi sub round($a) { $a.Numeric.round } multi sub round(Numeric $a) { $a.round } multi sub round(Numeric $a, $scale) { $a.round($scale) } -proto sub infix:<+>(Mu $?, Mu $?) is pure { * } +proto sub infix:<+>(Mu $?, Mu $?) is pure {*} multi sub infix:<+>($x = 0) { $x.Numeric } multi sub infix:<+>(\a, \b) { a.Numeric + b.Numeric } -proto sub infix:<->(Mu $?, Mu $?) is pure { * } +proto sub infix:<->(Mu $?, Mu $?) is pure {*} multi sub infix:<->($x = 0) { -$x.Numeric } multi sub infix:<->(\a, \b) { a.Numeric - b.Numeric } -proto sub infix:<*>(Mu $?, Mu $?) is pure { * } +proto sub infix:<*>(Mu $?, Mu $?) is pure {*} multi sub infix:<*>($x = 1) { $x.Numeric } multi sub infix:<*>(\a, \b) { a.Numeric * b.Numeric } sub infix:<×>(|c) is pure { infix:<*>(|c) } -proto sub infix:(Mu $?, Mu $?) is pure { * } +proto sub infix:(Mu $?, Mu $?) is pure {*} multi sub infix:() { Failure.new("No zero-arg meaning for infix:") } multi sub infix:($x) { $x.Numeric } multi sub infix:(\a, \b) { a.Numeric / b.Numeric } sub infix:<÷>(|c) is pure { infix:(|c) } -proto sub infix:
(Mu $?, Mu $?) is pure { * } +proto sub infix:
(Mu $?, Mu $?) is pure {*} # rest of infix:
is in Int.pm -proto sub infix:<%>(Mu $?, Mu $?) is pure { * } +proto sub infix:<%>(Mu $?, Mu $?) is pure {*} multi sub infix:<%>() { Failure.new("No zero-arg meaning for infix:<%>") } multi sub infix:<%>($x) { $x } multi sub infix:<%>(\a, \b) { a.Real % b.Real } -proto sub infix:<%%>(Mu $?, Mu $?) is pure { * } +proto sub infix:<%%>(Mu $?, Mu $?) is pure {*} multi sub infix:<%%>() { Failure.new("No zero-arg meaning for infix:<%%>") } multi sub infix:<%%>($) { Bool::True } multi sub infix:<%%>(Int:D \a, Int:D \b) { @@ -247,32 +247,32 @@ multi sub infix:<%%>(\a, \b) { ) } -proto sub infix:(Mu $?, Mu $?) is pure { * } +proto sub infix:(Mu $?, Mu $?) is pure {*} multi sub infix:(Int $x = 1) { $x } multi sub infix:(\a, \b) { a.Int lcm b.Int } -proto sub infix:(Mu $?, Mu $?) is pure { * } +proto sub infix:(Mu $?, Mu $?) is pure {*} multi sub infix:() { Failure.new('No zero-arg meaning for infix:') } multi sub infix:(Int $x) { $x } multi sub infix:(\a, \b) { a.Int gcd b.Int } -proto sub infix:<**>(Mu $?, Mu $?) is pure { * } +proto sub infix:<**>(Mu $?, Mu $?) is pure {*} multi sub infix:<**>($x = 1) { $x.Numeric } multi sub infix:<**>(\a, \b) { a.Numeric ** b.Numeric } -proto sub postfix:<ⁿ>(Mu $, Mu $) is pure { * } +proto sub postfix:<ⁿ>(Mu $, Mu $) is pure {*} multi sub postfix:<ⁿ>(\a, \b) { a ** b } ## relational operators -proto sub infix:«<=>»(Mu $, Mu $?) is pure { * } +proto sub infix:«<=>»(Mu $, Mu $?) is pure {*} multi sub infix:«<=>»(\a, \b) { a.Real <=> b.Real } -proto sub infix:<==>(Mu $?, Mu $?) is pure { * } +proto sub infix:<==>(Mu $?, Mu $?) is pure {*} multi sub infix:<==>($?) { Bool::True } multi sub infix:<==>(\a, \b) { a.Numeric == b.Numeric } -proto sub infix:<≅>(Mu $?, Mu $?, *%) { * } # note, can't be pure due to dynvar +proto sub infix:<≅>(Mu $?, Mu $?, *%) {*} # note, can't be pure due to dynvar multi sub infix:<≅>($?) { Bool::True } multi sub infix:<≅>(\a, \b, :$tolerance = $*TOLERANCE) { # If operands are non-0, scale the tolerance to the larger of the abs values. @@ -286,64 +286,64 @@ multi sub infix:<≅>(\a, \b, :$tolerance = $*TOLERANCE) { } sub infix:<=~=>(|c) { infix:<≅>(|c) } -proto sub infix:(Mu $?, Mu $?) is pure { * } +proto sub infix:(Mu $?, Mu $?) is pure {*} multi sub infix:($?) { Bool::True } multi sub infix:(Mu \a, Mu \b) { not a == b } -proto sub infix:<≠> (Mu $?, Mu $?) is pure { * } +proto sub infix:<≠> (Mu $?, Mu $?) is pure {*} multi sub infix:<≠> ($?) { Bool::True } multi sub infix:<≠> (Mu \a, Mu \b) { not a == b } -proto sub infix:«<»(Mu $?, Mu $?) is pure { * } +proto sub infix:«<»(Mu $?, Mu $?) is pure {*} multi sub infix:«<»($?) { Bool::True } multi sub infix:«<»(\a, \b) { a.Real < b.Real } -proto sub infix:«<=»(Mu $?, Mu $?) is pure { * } +proto sub infix:«<=»(Mu $?, Mu $?) is pure {*} multi sub infix:«<=»($?) { Bool::True } multi sub infix:«<=»(\a, \b) { a.Real <= b.Real } -proto sub infix:«≤» (Mu $?, Mu $?) is pure { * } +proto sub infix:«≤» (Mu $?, Mu $?) is pure {*} multi sub infix:«≤» ($?) { Bool::True } multi sub infix:«≤» (\a, \b) { a.Real ≤ b.Real } -proto sub infix:«>»(Mu $?, Mu $?) is pure { * } +proto sub infix:«>»(Mu $?, Mu $?) is pure {*} multi sub infix:«>»($?) { Bool::True } multi sub infix:«>»(\a, \b) { a.Real > b.Real } -proto sub infix:«>=»(Mu $?, Mu $?) is pure { * } +proto sub infix:«>=»(Mu $?, Mu $?) is pure {*} multi sub infix:«>=»($?) { Bool::True } multi sub infix:«>=»(\a, \b) { a.Real >= b.Real } -proto sub infix:«≥» (Mu $?, Mu $?) is pure { * } +proto sub infix:«≥» (Mu $?, Mu $?) is pure {*} multi sub infix:«≥» ($?) { Bool::True } multi sub infix:«≥» (\a, \b) { a.Real ≥ b.Real } ## bitwise operators -proto sub infix:<+&>(Mu $?, Mu $?) is pure { * } +proto sub infix:<+&>(Mu $?, Mu $?) is pure {*} multi sub infix:<+&>() { +^0 } multi sub infix:<+&>($x) { $x } multi sub infix:<+&>($x, $y) { $x.Numeric.Int +& $y.Numeric.Int } -proto sub infix:<+|>(Mu $?, Mu $?) is pure { * } +proto sub infix:<+|>(Mu $?, Mu $?) is pure {*} multi sub infix:<+|>() { 0 } multi sub infix:<+|>($x) { $x } multi sub infix:<+|>($x, $y) { $x.Numeric.Int +| $y.Numeric.Int } -proto sub infix:<+^>(Mu $?, Mu $?) is pure { * } +proto sub infix:<+^>(Mu $?, Mu $?) is pure {*} multi sub infix:<+^>() { 0 } multi sub infix:<+^>($x) { $x } multi sub infix:<+^>($x, $y) { $x.Numeric.Int +^ $y.Numeric.Int } -proto sub infix:«+<»(Mu $?, Mu $?) is pure { * } +proto sub infix:«+<»(Mu $?, Mu $?) is pure {*} multi sub infix:«+<»() { Failure.new("No zero-arg meaning for infix:«+<»") } multi sub infix:«+<»($x) { $x } multi sub infix:«+<»($x,$y) { $x.Numeric.Int +< $y.Numeric.Int } -proto sub infix:«+>»(Mu $?, Mu $?) is pure { * } +proto sub infix:«+>»(Mu $?, Mu $?) is pure {*} multi sub infix:«+>»() { Failure.new("No zero-arg meaning for infix:«+>»") } multi sub infix:«+>»($x) { $x } multi sub infix:«+>»($x,$y) { $x.Numeric.Int +> $y.Numeric.Int } -proto sub prefix:<+^>(Mu $) is pure { * } +proto sub prefix:<+^>(Mu $) is pure {*} multi sub prefix:<+^>($x) { +^ $x.Numeric.Int } # vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Proc/Async.pm b/src/core/Proc/Async.pm index 3ac31d87cf0..2534c06f995 100644 --- a/src/core/Proc/Async.pm +++ b/src/core/Proc/Async.pm @@ -118,7 +118,7 @@ my class Proc::Async { has $!encoder; has @!close-after-exit; - proto method new(|) { * } + proto method new(|) {*} multi method new(*@args where .so) { my $path = @args.shift; self.bless(:$path, :@args, |%_) @@ -165,7 +165,7 @@ my class Proc::Async { } } - proto method stdout(|) { * } + proto method stdout(|) {*} multi method stdout(Proc::Async:D: :$bin!) { die X::Proc::Async::SupplyOrStd.new if $!merge_supply; die X::Proc::Async::BindOrUse.new(:handle, :use('get the stdout Supply')) @@ -183,7 +183,7 @@ my class Proc::Async { $enc, $!stdout_descriptor_vow, 1, :$translate-nl } - proto method stderr(|) { * } + proto method stderr(|) {*} multi method stderr(Proc::Async:D: :$bin!) { die X::Proc::Async::SupplyOrStd.new if $!merge_supply; die X::Proc::Async::BindOrUse.new(:handle, :use('get the stderr Supply')) @@ -201,7 +201,7 @@ my class Proc::Async { $enc, $!stderr_descriptor_vow, 2, :$translate-nl } - proto method Supply(|) { * } + proto method Supply(|) {*} multi method Supply(Proc::Async:D: :$bin!) { die X::Proc::Async::SupplyOrStd.new if $!stdout_supply || $!stderr_supply; die X::Proc::Async::BindOrUse.new(:handle, :use('get the output Supply')) @@ -405,7 +405,7 @@ my class Proc::Async { # Note: some of the duplicated code in methods could be moved to # proto, but at the moment (2017-06-02) that makes the call 24% slower - proto method kill(|) { * } + proto method kill(|) {*} multi method kill(Proc::Async:D: Signal:D \signal = SIGHUP) { X::Proc::Async::MustBeStarted.new(:method, proc => self).throw if !$!started; nqp::killprocasync($!process_handle, signal.value) diff --git a/src/core/Rakudo/Internals.pm b/src/core/Rakudo/Internals.pm index 6a70a294469..7cca6edafdb 100644 --- a/src/core/Rakudo/Internals.pm +++ b/src/core/Rakudo/Internals.pm @@ -1436,7 +1436,7 @@ my class Rakudo::Internals { $target } - proto method coremap(|) { * } + proto method coremap(|) {*} multi method coremap(\op, Associative \h, Bool :$deep) { my @keys = h.keys; diff --git a/src/core/Range.pm b/src/core/Range.pm index 603a1360057..d7b59727d05 100644 --- a/src/core/Range.pm +++ b/src/core/Range.pm @@ -373,7 +373,7 @@ my class Range is Cool does Iterable does Positional { } method bounds() { (nqp::decont($!min), nqp::decont($!max)) } - proto method int-bounds(|) { * } + proto method int-bounds(|) {*} multi method int-bounds($from is rw, $to is rw) { nqp::if( $!is-int, @@ -481,7 +481,7 @@ my class Range is Cool does Iterable does Positional { !! "{$!min.perl}{'^' if $!excludes-min}..{'^' if $!excludes-max}$!max.perl()" } - proto method roll(|) { * } + proto method roll(|) {*} multi method roll(Range:D: Whatever) { if self.elems -> $elems { $!is-int @@ -545,7 +545,7 @@ my class Range is Cool does Iterable does Positional { } } - proto method pick(|) { * } + proto method pick(|) {*} multi method pick() { self.roll }; multi method pick(Whatever) { self.list.pick(*) }; multi method pick(Int(Cool) $todo) { diff --git a/src/core/Real.pm b/src/core/Real.pm index 38087020100..74eb4b90847 100644 --- a/src/core/Real.pm +++ b/src/core/Real.pm @@ -37,7 +37,7 @@ my role Real does Numeric { method floor() { self.Bridge.floor } method ceiling() { self.Bridge.ceiling } - proto method round(|) { * } + proto method round(|) {*} multi method round(Real:D:) { (self + 1/2).floor; # Rat NYI here, so no .5 } @@ -174,7 +174,7 @@ multi sub truncate(Real:D $x) { $x.truncate } multi sub truncate(Cool:D $x) { $x.Numeric.truncate } -proto sub atan2($, $?) { * } +proto sub atan2($, $?) {*} multi sub atan2(Real \a, Real \b = 1e0) { a.Bridge.atan2(b.Bridge) } # should really be (Cool, Cool), and then (Cool, Real) and (Real, Cool) # candidates, but since Int both conforms to Cool and Real, we'd get lots diff --git a/src/core/ShapedArray.pm b/src/core/ShapedArray.pm index 2db7a9abe0c..de6ea64f477 100644 --- a/src/core/ShapedArray.pm +++ b/src/core/ShapedArray.pm @@ -291,7 +291,7 @@ }.new(to,from).sink-all } - proto method STORE(|) { * } + proto method STORE(|) {*} multi method STORE(::?CLASS:D: ::?CLASS:D \in) { nqp::if( in.shape eqv self.shape, diff --git a/src/core/Str.pm b/src/core/Str.pm index 1a955940e80..bf2d164ba77 100644 --- a/src/core/Str.pm +++ b/src/core/Str.pm @@ -336,7 +336,7 @@ my class Str does Stringy { # declared in BOOTSTRAP '"' ~ Rakudo::Internals.PERLIFY-STR(self) ~ '"' } - proto method comb(|) { * } + proto method comb(|) {*} multi method comb(Str:D:) { Seq.new(class :: does Iterator { has str $!str; @@ -1291,7 +1291,7 @@ my class Str does Stringy { # declared in BOOTSTRAP } #?endif - proto method lines(|) { * } + proto method lines(|) {*} multi method lines(Str:D: :$count!) { # we should probably deprecate this feature $count ?? self.lines.elems !! self.lines; @@ -2155,7 +2155,7 @@ my class Str does Stringy { # declared in BOOTSTRAP nqp::islt_i($pos, $left) ?? '' !! nqp::p6box_s(nqp::substr($str, $left, $pos + 1 - $left)); } - proto method words(|) { * } + proto method words(|) {*} multi method words(Str:D: :$autoderef!) { # in Actions.postprocess_words my @list := self.words.List; return @list == 1 ?? @list[0] !! @list; @@ -2706,7 +2706,7 @@ my class Str does Stringy { # declared in BOOTSTRAP }).join; } - proto method codes(|) { * } + proto method codes(|) {*} multi method codes(Str:D: --> Int:D) { #?if moar nqp::codes(self) @@ -2720,7 +2720,7 @@ my class Str does Stringy { # declared in BOOTSTRAP 0 } - proto method chars(|) { * } + proto method chars(|) {*} multi method chars(Str:D: --> Int:D) { nqp::p6box_i(nqp::chars($!value)) } @@ -2729,7 +2729,7 @@ my class Str does Stringy { # declared in BOOTSTRAP 0 } - proto method uc(|) { * } + proto method uc(|) {*} multi method uc(Str:D:) { nqp::p6box_s(nqp::uc($!value)); } @@ -2737,7 +2737,7 @@ my class Str does Stringy { # declared in BOOTSTRAP self.Str; } - proto method lc(|) { * } + proto method lc(|) {*} multi method lc(Str:D:) { nqp::p6box_s(nqp::lc($!value)); } @@ -2745,7 +2745,7 @@ my class Str does Stringy { # declared in BOOTSTRAP self.Str; } - proto method tc(|) { * } + proto method tc(|) {*} multi method tc(Str:D:) { nqp::p6box_s(nqp::tc(nqp::substr($!value,0,1)) ~ nqp::substr($!value,1)); } @@ -2753,7 +2753,7 @@ my class Str does Stringy { # declared in BOOTSTRAP self.Str } - proto method fc(|) { * } + proto method fc(|) {*} multi method fc(Str:D:) { nqp::p6box_s(nqp::fc($!value)); } @@ -2761,7 +2761,7 @@ my class Str does Stringy { # declared in BOOTSTRAP self.Str; } - proto method tclc(|) { * } + proto method tclc(|) {*} multi method tclc(Str:D:) { nqp::p6box_s(nqp::tclc($!value)) } @@ -2769,7 +2769,7 @@ my class Str does Stringy { # declared in BOOTSTRAP self.Str } - proto method flip(|) { * } + proto method flip(|) {*} multi method flip(Str:D:) { nqp::p6box_s(nqp::flip($!value)) } @@ -2777,7 +2777,7 @@ my class Str does Stringy { # declared in BOOTSTRAP self.Str } - proto method ord(|) { * } + proto method ord(|) {*} multi method ord(Str:D: --> Int:D) { nqp::chars($!value) ?? nqp::p6box_i(nqp::ord($!value)) @@ -2919,7 +2919,7 @@ sub trim-leading (Cool:D $s --> Str:D) { $s.trim-leading } sub trim-trailing(Cool:D $s --> Str:D) { $s.trim-trailing } # the opposite of Real.base, used for :16($hex_str) -proto sub UNBASE (|) { * } +proto sub UNBASE (|) {*} multi sub UNBASE(Int:D $base, Any:D $num) { X::Numeric::Confused.new(:$num, :$base).throw; } @@ -2961,8 +2961,8 @@ sub UNBASE_BRACKET($base, @a) { } $v; } -proto sub infix:(|) is pure { * } -proto sub infix:(|) { * } +proto sub infix:(|) is pure {*} +proto sub infix:(|) {*} #?if moar multi sub infix:(Str:D \a, Str:D \b --> Order:D) { ORDER( @@ -3015,12 +3015,12 @@ sub chrs(*@c --> Str:D) { nqp::join("",$result) } -proto sub parse-base(|) { * } +proto sub parse-base(|) {*} multi sub parse-base(Str:D $str, Int:D $radix) { $str.parse-base($radix) } sub parse-names(Str:D $str) { $str.parse-names } -proto sub substr(|) { * } +proto sub substr(|) {*} multi sub substr(Str:D \what, Int:D \start) { my str $str = nqp::unbox_s(what); my int $max = nqp::chars($str); diff --git a/src/core/array_operators.pm b/src/core/array_operators.pm index 3f8ae565e09..46d8bc5b48c 100644 --- a/src/core/array_operators.pm +++ b/src/core/array_operators.pm @@ -1,5 +1,5 @@ # The [...] term creates an Array. -proto circumfix:<[ ]>(|) { * } +proto circumfix:<[ ]>(|) {*} multi circumfix:<[ ]>() { nqp::create(Array) } diff --git a/src/core/control.pm b/src/core/control.pm index 79563f35375..a203e59e8b1 100644 --- a/src/core/control.pm +++ b/src/core/control.pm @@ -50,14 +50,14 @@ multi sub return(**@x is raw --> Nil) { nqp::throwpayloadlexcaller(nqp::const::CONTROL_RETURN, @x); } -proto sub take-rw(|) { * } +proto sub take-rw(|) {*} multi sub take-rw() { die "take-rw without parameters doesn't make sense" } multi sub take-rw(\x) { THROW(nqp::const::CONTROL_TAKE, x) } multi sub take-rw(|) { THROW(nqp::const::CONTROL_TAKE,RETURN-LIST(nqp::p6argvmarray)) } -proto sub take(|) { * } +proto sub take(|) {*} multi sub take() { die "take without parameters doesn't make sense" } multi sub take(\x) { THROW(nqp::const::CONTROL_TAKE, nqp::p6recont_ro(x)) @@ -69,22 +69,22 @@ multi sub take(|) { ) } -proto sub goto(|) { * } +proto sub goto(|) {*} multi sub goto(Label:D \x --> Nil) { x.goto } -proto sub last(|) { * } +proto sub last(|) {*} multi sub last(--> Nil) { nqp::throwextype(nqp::const::CONTROL_LAST); Nil } multi sub last(Label:D \x --> Nil) { x.last } -proto sub next(|) { * } +proto sub next(|) {*} multi sub next(--> Nil) { nqp::throwextype(nqp::const::CONTROL_NEXT); Nil } multi sub next(Label:D \x --> Nil) { x.next } -proto sub redo(|) { * } +proto sub redo(|) {*} multi sub redo(--> Nil) { nqp::throwextype(nqp::const::CONTROL_REDO); Nil } multi sub redo(Label:D \x --> Nil) { x.redo } -proto sub succeed(|) { * } +proto sub succeed(|) {*} multi sub succeed(--> Nil) { THROW-NIL(nqp::const::CONTROL_SUCCEED) } multi sub succeed(\x --> Nil) { THROW(nqp::const::CONTROL_SUCCEED, x) } multi sub succeed(| --> Nil) { diff --git a/src/core/hash_slice.pm b/src/core/hash_slice.pm index e4838299196..f2265c11c5d 100644 --- a/src/core/hash_slice.pm +++ b/src/core/hash_slice.pm @@ -1,6 +1,6 @@ # all sub postcircumfix {} candidates here please -proto sub postcircumfix:<{ }>(|) is nodal { * } +proto sub postcircumfix:<{ }>(|) is nodal {*} # %h multi sub postcircumfix:<{ }>( \SELF, \key ) is raw { @@ -158,7 +158,7 @@ multi sub postcircumfix:<{ }>( \SELF, *%other ) is raw { } -proto sub postcircumfix:<{; }>(|) is nodal { * } +proto sub postcircumfix:<{; }>(|) is nodal {*} sub MD-HASH-SLICE-ONE-POSITION(\SELF, \indices, \idx, int $dim, \target) { my int $next-dim = $dim + 1; diff --git a/src/core/io_operators.pm b/src/core/io_operators.pm index 4245b8f3ad1..d564e142535 100644 --- a/src/core/io_operators.pm +++ b/src/core/io_operators.pm @@ -1,6 +1,6 @@ my class IO::ArgFiles { ... } -proto sub print(|) { * } +proto sub print(|) {*} multi sub print(Str:D \x) { $*OUT.print(x); } @@ -13,7 +13,7 @@ multi sub print(**@args is raw) { $*OUT.print($str); } -proto sub say(|) { * } +proto sub say(|) {*} multi sub say() { $*OUT.print-nl } multi sub say(Str:D \x) { my $out := $*OUT; @@ -33,7 +33,7 @@ multi sub say(**@args is raw) { $out.print(nqp::concat($str,$out.nl-out)); } -proto sub put(|) { * } +proto sub put(|) {*} multi sub put() { $*OUT.print-nl } multi sub put(Str:D \x) { my $out := $*OUT; @@ -53,7 +53,7 @@ multi sub put(**@args is raw) { $out.print(nqp::concat($str,$out.nl-out)); } -proto sub note(|) { * } +proto sub note(|) {*} multi sub note() { my $err := $*ERR; $err.print(nqp::concat("Noted",$err.nl-out)); @@ -86,34 +86,34 @@ multi sub prompt($msg) { $*IN.get; } -proto sub dir(|) { * } +proto sub dir(|) {*} multi sub dir(*%_) { $*SPEC.curdir.IO.dir(:!absolute, |%_) } multi sub dir(IO::Path:D $path, |c) { $path.dir(|c) } multi sub dir(IO() $path, |c) { $path.dir(|c) } -proto sub open(|) { * } +proto sub open(|) {*} multi sub open(IO() $path, |c) { IO::Handle.new(:$path).open(|c) } -proto sub lines(|) { * } +proto sub lines(|) {*} multi sub lines($what = $*ARGFILES, |c) { $what.lines(|c) } -proto sub words(|) { * } +proto sub words(|) {*} multi sub words($what = $*ARGFILES, |c) { $what.words(|c) } -proto sub get (|) { * } +proto sub get (|) {*} multi sub get (IO::Handle:D $fh = $*ARGFILES) { $fh.get } -proto sub getc (|) { * } +proto sub getc (|) {*} multi sub getc (IO::Handle:D $fh = $*ARGFILES) { $fh.getc } -proto sub close(|) { * } +proto sub close(|) {*} multi sub close(IO::Handle:D $fh) { $fh.close } -proto sub slurp(|) { * } +proto sub slurp(|) {*} multi sub slurp(IO::Handle:D $fh = $*ARGFILES, |c) { $fh.slurp(|c) } multi sub slurp(IO() $path, |c) { $path.slurp(|c) } -proto sub spurt(|) { * } +proto sub spurt(|) {*} multi sub spurt(IO::Handle:D $fh, |c) { $fh .spurt(|c) } multi sub spurt(IO() $path, |c) { $path.spurt(|c) } diff --git a/src/core/metaops.pm b/src/core/metaops.pm index e70494542eb..f50dd12fbc3 100644 --- a/src/core/metaops.pm +++ b/src/core/metaops.pm @@ -116,7 +116,7 @@ sub METAOP_ZIP(\op, &reduce) { ) } -proto sub METAOP_REDUCE_LEFT(|) { * } +proto sub METAOP_REDUCE_LEFT(|) {*} multi sub METAOP_REDUCE_LEFT(\op, \triangle) { if op.count > 2 and op.count < Inf { my $count = op.count; @@ -212,7 +212,7 @@ multi sub METAOP_REDUCE_LEFT(\op) { } } -proto sub METAOP_REDUCE_RIGHT(|) { * } +proto sub METAOP_REDUCE_RIGHT(|) {*} multi sub METAOP_REDUCE_RIGHT(\op, \triangle) { nqp::if( op.count < Inf && nqp::isgt_i((my int $count = op.count),2), @@ -398,7 +398,7 @@ multi sub METAOP_REDUCE_RIGHT(\op) { ) } -proto sub METAOP_REDUCE_LIST(|) { * } +proto sub METAOP_REDUCE_LIST(|) {*} multi sub METAOP_REDUCE_LIST(\op, \triangle) { sub (+values) { GATHER({ @@ -414,7 +414,7 @@ multi sub METAOP_REDUCE_LIST(\op) { sub (+values) { op.(|values) } } -proto sub METAOP_REDUCE_LISTINFIX(|) { * } +proto sub METAOP_REDUCE_LISTINFIX(|) {*} multi sub METAOP_REDUCE_LISTINFIX(\op, \triangle) { sub (|values) { my \p = values[0]; @@ -436,7 +436,7 @@ multi sub METAOP_REDUCE_LISTINFIX(\op) { } } -proto sub METAOP_REDUCE_CHAIN(|) { * } +proto sub METAOP_REDUCE_CHAIN(|) {*} multi sub METAOP_REDUCE_CHAIN(\op, \triangle) { sub (+values) { my $state = True; @@ -526,7 +526,7 @@ sub METAOP_HYPER_PREFIX(\op) { sub METAOP_HYPER_CALL(\list, |args) { deepmap(-> $c { $c(|args) }, list) } -proto sub HYPER(|) { * } +proto sub HYPER(|) {*} multi sub HYPER(&op, \left, \right, :$dwim-left, :$dwim-right) { op(left, right); @@ -643,7 +643,7 @@ multi sub HYPER(\op, \obj) { ) } -proto sub deepmap(|) { * } +proto sub deepmap(|) {*} multi sub deepmap(\op, \obj) { Rakudo::Internals.coremap(op, obj, :deep) @@ -654,7 +654,7 @@ multi sub deepmap(\op, Associative \h) { hash @keys Z deepmap(op, h{@keys}) } -proto sub nodemap(|) { * } +proto sub nodemap(|) {*} multi sub nodemap(\op, \obj) { my Mu $rpa := nqp::create(IterationBuffer); my \objs := obj.list; @@ -697,7 +697,7 @@ multi sub nodemap(\op, Associative \h) { hash @keys Z nodemap(op, h{@keys}) } -proto sub duckmap(|) { * } +proto sub duckmap(|) {*} multi sub duckmap(\op, \obj) { Rakudo::Internals.coremap(sub (\arg) { CATCH { return arg ~~ Iterable:D ?? duckmap(op,arg) !! arg }; op.(arg); }, obj); } diff --git a/src/core/operators.pm b/src/core/operators.pm index ae17de917e6..2856c282691 100644 --- a/src/core/operators.pm +++ b/src/core/operators.pm @@ -12,7 +12,7 @@ my class X::Does::TypeObject is Exception { method message() { "Cannot use 'does' operator with a type object." } } -proto sub infix:(|) { * } +proto sub infix:(|) {*} multi sub infix:(Mu:D \obj, Mu:U \rolish) is raw { # XXX Mutability check. my $role := rolish.HOW.archetypes.composable() ?? rolish !! @@ -51,7 +51,7 @@ multi sub infix:(Rational:D \a, Rational:D \b) is default { a.isNaN || b.isNaN ?? a.Num cmp b.Num !! a <=> b } -proto sub infix:(|) is pure { * } +proto sub infix:(|) is pure {*} multi sub infix:(Mu:D \obj, Mu:U \rolish) { my $role := rolish.HOW.archetypes.composable() ?? rolish !! rolish.HOW.archetypes.composalizable() ?? rolish.HOW.composalize(rolish) !! @@ -466,7 +466,7 @@ sub WHAT(Mu \x) { x.WHAT } sub HOW (Mu \x) { x.HOW } sub VAR (Mu \x) { x.VAR } -proto sub infix:<...>(|) { * } +proto sub infix:<...>(|) {*} multi sub infix:<...>(\a, Mu \b) { Seq.new(SEQUENCE(a, b).iterator) } multi sub infix:<...>(|lol) { my @lol := lol.list; @@ -506,13 +506,13 @@ multi sub infix:<...>(|lol) { } } -proto sub infix:<...^>(|) { * } +proto sub infix:<...^>(|) {*} multi sub infix:<...^>(\a, Mu \b) { Seq.new(SEQUENCE(a, b, :exclude_end(1)).iterator) } -proto sub infix:<…>(|) { * } +proto sub infix:<…>(|) {*} multi sub infix:<…>(|c) { infix:<...>(|c) } -proto sub infix:<…^>(|) { * } +proto sub infix:<…^>(|) {*} multi sub infix:<…^>(|c) { infix:<...^>(|c) } multi sub undefine(Mu \x) is raw { x = Nil } From 0949217961b317150642e172bdf368b1b42b217e Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Mon, 30 Oct 2017 23:30:06 +0100 Subject: [PATCH 613/692] Give threads a name --- src/core/ThreadPoolScheduler.pm | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index 803155cc33a..950b44392bf 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -260,7 +260,7 @@ my class ThreadPoolScheduler does Scheduler { submethod BUILD(Queue :$queue!, :$!scheduler!) { $!queue := $queue; - $!thread = Thread.start(:app_lifetime, { + $!thread = Thread.start(:app_lifetime, :name, { my $*AWAITER := ThreadPoolAwaiter.new(:$!queue); loop { self!run-one(nqp::shift($queue)); @@ -273,7 +273,7 @@ my class ThreadPoolScheduler does Scheduler { submethod BUILD(Queue :$queue!, :$!scheduler!) { $!queue := $queue; - $!thread = Thread.start(:app_lifetime, { + $!thread = Thread.start(:app_lifetime, :name, { my $*AWAITER := ThreadPoolAwaiter.new(:$!queue); loop { self!run-one(nqp::shift($queue)); @@ -286,7 +286,7 @@ my class ThreadPoolScheduler does Scheduler { submethod BUILD(:$!scheduler!) { my $queue := $!queue := Queue.CREATE; - $!thread = Thread.start(:app_lifetime, { + $!thread = Thread.start(:app_lifetime, :name, { my $*AWAITER := ThreadPoolAwaiter.new(:$!queue); loop { self!run-one(nqp::shift($queue)); @@ -449,7 +449,7 @@ my class ThreadPoolScheduler does Scheduler { my constant NUM_SAMPLES = 5; method !maybe-start-supervisor(--> Nil) { unless $!supervisor.DEFINITE { - $!supervisor = Thread.start(:app_lifetime, { + $!supervisor = Thread.start(:app_lifetime, :name, { sub add-general-worker(--> Nil) { $!state-lock.protect: { $!general-workers := push-worker( From bdc73563f484325cc5448a847c87f35dd73b3fb1 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Tue, 31 Oct 2017 00:13:53 +0100 Subject: [PATCH 614/692] Fix for RT #131846 Thanks perlawhirl++ for nudging --- src/core/List.pm | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/src/core/List.pm b/src/core/List.pm index f4472dbc13a..8aecfa7cae5 100644 --- a/src/core/List.pm +++ b/src/core/List.pm @@ -1120,7 +1120,21 @@ my class List does Iterable does Positional { # declared in BOOTSTRAP multi method combinations(Range:D $ofrange) { nqp::stmts( (my int $elems = self.elems), # reifies - $ofrange.int-bounds(my int $i, my int $to), + nqp::if( + $ofrange.is-int, + $ofrange.int-bounds(my int $i, my int $to), + nqp::stmts( + nqp::unless( + $ofrange.min < 0, # $i already 0 if not + ($i = $ofrange.min + $ofrange.excludes-min) + ), + nqp::if( + $ofrange.max > $elems, + ($to = $elems), + ($to = $ofrange.max - $ofrange.excludes-max) + ) + ) + ), ($i = nqp::if(nqp::islt_i($i,0),-1,nqp::sub_i($i,1))), nqp::if(nqp::isgt_i($to,$elems),($to = $elems)), Seq.new( From 91543fe310c6cb63011d1804d27793debcd44913 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Tue, 31 Oct 2017 00:58:41 +0100 Subject: [PATCH 615/692] Channel/Supply to also be closed with sub close() - rather than having to use the method, TIMTOWTDI - somewhere between 2015.11-554-g3b4964b and 2017.08 this regressed - spotted in https://www.nntp.perl.org/group/perl.perl6.users/2017/10/msg4550.html --- src/core/io_operators.pm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/core/io_operators.pm b/src/core/io_operators.pm index 4245b8f3ad1..c9c156c0793 100644 --- a/src/core/io_operators.pm +++ b/src/core/io_operators.pm @@ -107,7 +107,9 @@ proto sub getc (|) { * } multi sub getc (IO::Handle:D $fh = $*ARGFILES) { $fh.getc } proto sub close(|) { * } -multi sub close(IO::Handle:D $fh) { $fh.close } +multi sub close(IO::Handle:D $fh) { $fh.close } +multi sub close(Channel:D $channel) { $channel.close } +multi sub close(Supply:D $supply) { $supply.close } proto sub slurp(|) { * } multi sub slurp(IO::Handle:D $fh = $*ARGFILES, |c) { $fh.slurp(|c) } From f72ad227fb5d8c6cd2a57e8a7f09660124204740 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Tue, 31 Oct 2017 01:02:22 +0100 Subject: [PATCH 616/692] Add Telemetry.supervisor - number of supervisor threads running (expected values: 0 or 1) - use Telemetry; signal(SIGINT).tap: &exit; say Telemetry.supervisor # 1 - use Telemetry; say Telemetry.supervisor # 0 --- lib/Telemetry.pm6 | 22 +++++++++++++++++++--- 1 file changed, 19 insertions(+), 3 deletions(-) diff --git a/lib/Telemetry.pm6 b/lib/Telemetry.pm6 index 89713e74a14..f6d6a5150b0 100644 --- a/lib/Telemetry.pm6 +++ b/lib/Telemetry.pm6 @@ -8,16 +8,22 @@ class Telemetry { has int $!cpu-user; has int $!cpu-sys; has int $!wallclock; + has int $!supervisor; my num $start = Rakudo::Internals.INITTIME; submethod BUILD() { my \rusage = nqp::getrusage; - $!cpu-user = nqp::atpos_i(rusage, nqp::const::RUSAGE_UTIME_SEC) * 1000000 + $!cpu-user = nqp::atpos_i(rusage,nqp::const::RUSAGE_UTIME_SEC) * 1000000 + nqp::atpos_i(rusage, nqp::const::RUSAGE_UTIME_MSEC); - $!cpu-sys = nqp::atpos_i(rusage, nqp::const::RUSAGE_STIME_SEC) * 1000000 + $!cpu-sys = nqp::atpos_i(rusage,nqp::const::RUSAGE_STIME_SEC) * 1000000 + nqp::atpos_i(rusage, nqp::const::RUSAGE_STIME_MSEC); - $!wallclock = nqp::fromnum_I(1000000*nqp::sub_n(nqp::time_n,$start),Int); + $!wallclock = + nqp::fromnum_I(1000000 * nqp::sub_n(nqp::time_n,$start),Int); + + my $scheduler := nqp::decont($*SCHEDULER); + $!supervisor = 1 + if nqp::getattr($scheduler,ThreadPoolScheduler,'$!supervisor'); } proto method cpu() { * } @@ -54,6 +60,16 @@ class Telemetry { } multi method wallclock(Telemetry:D:) is raw { $!wallclock } + proto method supervisor() { * } + multi method supervisor(Telemetry:U:) { + nqp::istrue( + nqp::getattr( + nqp::decont($*SCHEDULER),ThreadPoolScheduler,'$!supervisor' + ) + ) + } + multi method supervisor(Telemetry:D:) { $!supervisor } + multi method Str(Telemetry:D:) { $!wallclock ?? "$.cpu / $!wallclock" !! "cpu / wallclock" } From 4b4429cccbfb276e729213478fec40e9a2407ff6 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Tue, 31 Oct 2017 01:30:01 +0100 Subject: [PATCH 617/692] Add support for Telemetry.general-workers - the number of general worker threads active - also some stuff about supervisor I forgot just now --- lib/Telemetry.pm6 | 48 +++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 42 insertions(+), 6 deletions(-) diff --git a/lib/Telemetry.pm6 b/lib/Telemetry.pm6 index f6d6a5150b0..a5862a5e4c3 100644 --- a/lib/Telemetry.pm6 +++ b/lib/Telemetry.pm6 @@ -9,6 +9,7 @@ class Telemetry { has int $!cpu-sys; has int $!wallclock; has int $!supervisor; + has int $!general-workers; my num $start = Rakudo::Internals.INITTIME; @@ -24,6 +25,12 @@ class Telemetry { my $scheduler := nqp::decont($*SCHEDULER); $!supervisor = 1 if nqp::getattr($scheduler,ThreadPoolScheduler,'$!supervisor'); + + if nqp::getattr($scheduler,ThreadPoolScheduler,'$!general-workers') + -> \workers { + $!general-workers = nqp::elems(workers) + } + } proto method cpu() { * } @@ -70,6 +77,17 @@ class Telemetry { } multi method supervisor(Telemetry:D:) { $!supervisor } + proto method general-workers() { * } + multi method general-workers(Telemetry:U:) { + nqp::if( + nqp::istrue((my $workers := nqp::getattr( + nqp::decont($*SCHEDULER),ThreadPoolScheduler,'$!general-workers' + ))), + nqp::elems($workers) + ) + } + multi method general-workers(Telemetry:D:) { $!general-workers } + multi method Str(Telemetry:D:) { $!wallclock ?? "$.cpu / $!wallclock" !! "cpu / wallclock" } @@ -82,19 +100,25 @@ class Telemetry::Period is Telemetry { multi method new(Telemetry::Period: int :$cpu-user, int :$cpu-sys, - int :$wallclock + int :$wallclock, + int :$supervisor, + int :$general-workers, ) { - self.new($cpu-user, $cpu-sys, $wallclock) + self.new($cpu-user, $cpu-sys, $wallclock, $supervisor, $general-workers) } multi method new(Telemetry::Period: int $cpu-user, int $cpu-sys, - int $wallclock + int $wallclock, + int $supervisor, + int $general-workers, ) { my $period := nqp::create(Telemetry::Period); - nqp::bindattr_i($period,Telemetry,'$!cpu-user', $cpu-user); - nqp::bindattr_i($period,Telemetry,'$!cpu-sys', $cpu-sys); - nqp::bindattr_i($period,Telemetry,'$!wallclock',$wallclock); + nqp::bindattr_i($period,Telemetry,'$!cpu-user', $cpu-user); + nqp::bindattr_i($period,Telemetry,'$!cpu-sys', $cpu-sys); + nqp::bindattr_i($period,Telemetry,'$!wallclock', $wallclock); + nqp::bindattr_i($period,Telemetry,'$!supervisor', $supervisor); + nqp::bindattr_i($period,Telemetry,'$!general-workers',$general-workers); $period } @@ -105,6 +129,10 @@ class Telemetry::Period is Telemetry { nqp::getattr_i(self,Telemetry,'$!cpu-sys') }), :wallclock({ nqp::getattr_i(self,Telemetry,'$!wallclock') + }), :supervisor({ + nqp::getattr_i(self,Telemetry,'$!supervisor') + }), :general-workers({ + nqp::getattr_i(self,Telemetry,'$!general-workers') }))" } @@ -137,6 +165,14 @@ multi sub infix:<->(Telemetry:D $a, Telemetry:D $b) is export { nqp::sub_i( nqp::getattr_i(nqp::decont($a),Telemetry,'$!wallclock'), nqp::getattr_i(nqp::decont($b),Telemetry,'$!wallclock') + ), + nqp::sub_i( + nqp::getattr_i(nqp::decont($a),Telemetry,'$!supervisor'), + nqp::getattr_i(nqp::decont($b),Telemetry,'$!supervisor') + ), + nqp::sub_i( + nqp::getattr_i(nqp::decont($a),Telemetry,'$!general-workers'), + nqp::getattr_i(nqp::decont($b),Telemetry,'$!general-workers') ) ) } From 58249a529c27e07f2b72d73e2f7fabc226c31b75 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Tue, 31 Oct 2017 01:41:25 +0100 Subject: [PATCH 618/692] Add support for Telemetry.timer-workers - the number of timer worker threads active --- lib/Telemetry.pm6 | 32 ++++++++++++++++++++++++++++++-- 1 file changed, 30 insertions(+), 2 deletions(-) diff --git a/lib/Telemetry.pm6 b/lib/Telemetry.pm6 index a5862a5e4c3..941a5c639e7 100644 --- a/lib/Telemetry.pm6 +++ b/lib/Telemetry.pm6 @@ -10,6 +10,7 @@ class Telemetry { has int $!wallclock; has int $!supervisor; has int $!general-workers; + has int $!timer-workers; my num $start = Rakudo::Internals.INITTIME; @@ -28,7 +29,11 @@ class Telemetry { if nqp::getattr($scheduler,ThreadPoolScheduler,'$!general-workers') -> \workers { - $!general-workers = nqp::elems(workers) + $!general-workers = nqp::elems(workers); + } + if nqp::getattr($scheduler,ThreadPoolScheduler,'$!timer-workers') + -> \workers { + $!timer-workers = nqp::elems(workers); } } @@ -88,6 +93,17 @@ class Telemetry { } multi method general-workers(Telemetry:D:) { $!general-workers } + proto method timer-workers() { * } + multi method timer-workers(Telemetry:U:) { + nqp::if( + nqp::istrue((my $workers := nqp::getattr( + nqp::decont($*SCHEDULER),ThreadPoolScheduler,'$!timer-workers' + ))), + nqp::elems($workers) + ) + } + multi method timer-workers(Telemetry:D:) { $!timer-workers } + multi method Str(Telemetry:D:) { $!wallclock ?? "$.cpu / $!wallclock" !! "cpu / wallclock" } @@ -103,8 +119,12 @@ class Telemetry::Period is Telemetry { int :$wallclock, int :$supervisor, int :$general-workers, + int :$timer-workers, ) { - self.new($cpu-user, $cpu-sys, $wallclock, $supervisor, $general-workers) + self.new( + $cpu-user, $cpu-sys, $wallclock, + $supervisor, $general-workers, $timer-workers + ) } multi method new(Telemetry::Period: int $cpu-user, @@ -112,6 +132,7 @@ class Telemetry::Period is Telemetry { int $wallclock, int $supervisor, int $general-workers, + int $timer-workers, ) { my $period := nqp::create(Telemetry::Period); nqp::bindattr_i($period,Telemetry,'$!cpu-user', $cpu-user); @@ -119,6 +140,7 @@ class Telemetry::Period is Telemetry { nqp::bindattr_i($period,Telemetry,'$!wallclock', $wallclock); nqp::bindattr_i($period,Telemetry,'$!supervisor', $supervisor); nqp::bindattr_i($period,Telemetry,'$!general-workers',$general-workers); + nqp::bindattr_i($period,Telemetry,'$!timer-workers', $timer-workers); $period } @@ -133,6 +155,8 @@ class Telemetry::Period is Telemetry { nqp::getattr_i(self,Telemetry,'$!supervisor') }), :general-workers({ nqp::getattr_i(self,Telemetry,'$!general-workers') + }), :timer-workers({ + nqp::getattr_i(self,Telemetry,'$!timer-workers') }))" } @@ -173,6 +197,10 @@ multi sub infix:<->(Telemetry:D $a, Telemetry:D $b) is export { nqp::sub_i( nqp::getattr_i(nqp::decont($a),Telemetry,'$!general-workers'), nqp::getattr_i(nqp::decont($b),Telemetry,'$!general-workers') + ), + nqp::sub_i( + nqp::getattr_i(nqp::decont($a),Telemetry,'$!timer-workers'), + nqp::getattr_i(nqp::decont($b),Telemetry,'$!timer-workers') ) ) } From f51a3efc7d9612e4126f134b20c7de4cfcdbb463 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Tue, 31 Oct 2017 02:04:35 +0100 Subject: [PATCH 619/692] Add support for Telemetry.affinity-workers - the number of affinity worker threads active --- lib/Telemetry.pm6 | 27 ++++++++++++++++++++++++++- 1 file changed, 26 insertions(+), 1 deletion(-) diff --git a/lib/Telemetry.pm6 b/lib/Telemetry.pm6 index 941a5c639e7..cca860153d0 100644 --- a/lib/Telemetry.pm6 +++ b/lib/Telemetry.pm6 @@ -11,6 +11,7 @@ class Telemetry { has int $!supervisor; has int $!general-workers; has int $!timer-workers; + has int $!affinity-workers; my num $start = Rakudo::Internals.INITTIME; @@ -35,6 +36,10 @@ class Telemetry { -> \workers { $!timer-workers = nqp::elems(workers); } + if nqp::getattr($scheduler,ThreadPoolScheduler,'$!affinity-workers') + -> \workers { + $!affinity-workers = nqp::elems(workers); + } } @@ -104,6 +109,17 @@ class Telemetry { } multi method timer-workers(Telemetry:D:) { $!timer-workers } + proto method affinity-workers() { * } + multi method affinity-workers(Telemetry:U:) { + nqp::if( + nqp::istrue((my $workers := nqp::getattr( + nqp::decont($*SCHEDULER),ThreadPoolScheduler,'$!affinity-workers' + ))), + nqp::elems($workers) + ) + } + multi method affinity-workers(Telemetry:D:) { $!affinity-workers } + multi method Str(Telemetry:D:) { $!wallclock ?? "$.cpu / $!wallclock" !! "cpu / wallclock" } @@ -120,10 +136,11 @@ class Telemetry::Period is Telemetry { int :$supervisor, int :$general-workers, int :$timer-workers, + int :$affinity-workers, ) { self.new( $cpu-user, $cpu-sys, $wallclock, - $supervisor, $general-workers, $timer-workers + $supervisor, $general-workers, $timer-workers, $affinity-workers ) } multi method new(Telemetry::Period: @@ -133,6 +150,7 @@ class Telemetry::Period is Telemetry { int $supervisor, int $general-workers, int $timer-workers, + int $affinity-workers, ) { my $period := nqp::create(Telemetry::Period); nqp::bindattr_i($period,Telemetry,'$!cpu-user', $cpu-user); @@ -141,6 +159,7 @@ class Telemetry::Period is Telemetry { nqp::bindattr_i($period,Telemetry,'$!supervisor', $supervisor); nqp::bindattr_i($period,Telemetry,'$!general-workers',$general-workers); nqp::bindattr_i($period,Telemetry,'$!timer-workers', $timer-workers); + nqp::bindattr_i($period,Telemetry,'$!affinity-workers',$affinity-workers); $period } @@ -157,6 +176,8 @@ class Telemetry::Period is Telemetry { nqp::getattr_i(self,Telemetry,'$!general-workers') }), :timer-workers({ nqp::getattr_i(self,Telemetry,'$!timer-workers') + }), :affinity-workers({ + nqp::getattr_i(self,Telemetry,'$!affinity-workers') }))" } @@ -201,6 +222,10 @@ multi sub infix:<->(Telemetry:D $a, Telemetry:D $b) is export { nqp::sub_i( nqp::getattr_i(nqp::decont($a),Telemetry,'$!timer-workers'), nqp::getattr_i(nqp::decont($b),Telemetry,'$!timer-workers') + ), + nqp::sub_i( + nqp::getattr_i(nqp::decont($a),Telemetry,'$!affinity-workers'), + nqp::getattr_i(nqp::decont($b),Telemetry,'$!affinity-workers') ) ) } From 8a0eb7fa6afc1c9c8fbd053b9e56aca0e5bd0f3f Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Tue, 31 Oct 2017 02:22:45 +0100 Subject: [PATCH 620/692] Introducing Telemetry snapper - runs a repeated snap() in a separate Thread - outside the ThreadPoolScheduler, as to prevent interference - defaults to once every .1 second, can be adjusted with snapper($sleep) - can be run in a BEGIN or INIT phaser - will only allow one snapper to be running at any time --- lib/Telemetry.pm6 | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/lib/Telemetry.pm6 b/lib/Telemetry.pm6 index cca860153d0..f3ee74640a1 100644 --- a/lib/Telemetry.pm6 +++ b/lib/Telemetry.pm6 @@ -230,11 +230,23 @@ multi sub infix:<->(Telemetry:D $a, Telemetry:D $b) is export { ) } +constant T is export = Telemetry; + my @snaps; proto sub snap(|) is export { * } multi sub snap(--> Nil) { @snaps.push(Telemetry.new) } multi sub snap(@s --> Nil) { @s.push(Telemetry.new) } +my int $snapper-running; +sub snapper($sleep = 0.1 --> Nil) is export { + unless $snapper-running { + Thread.start(:app_lifetime, :name, { + loop { snap; sleep $sleep } + }); + $snapper-running = 1 + } +} + proto sub periods(|) is export { * } multi sub periods() { my @s = @snaps; From bc00894fd7f666c621427b4bafb8898b9de279de Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Tue, 31 Oct 2017 09:41:06 +0100 Subject: [PATCH 621/692] Add support for Telemetry.general-jobs - the number of jobs waiting for handling by general-workers --- lib/Telemetry.pm6 | 31 +++++++++++++++++++++++++++++-- 1 file changed, 29 insertions(+), 2 deletions(-) diff --git a/lib/Telemetry.pm6 b/lib/Telemetry.pm6 index f3ee74640a1..41c59db40fc 100644 --- a/lib/Telemetry.pm6 +++ b/lib/Telemetry.pm6 @@ -10,6 +10,7 @@ class Telemetry { has int $!wallclock; has int $!supervisor; has int $!general-workers; + has int $!general-jobs; has int $!timer-workers; has int $!affinity-workers; @@ -32,6 +33,10 @@ class Telemetry { -> \workers { $!general-workers = nqp::elems(workers); } + if nqp::getattr($scheduler,ThreadPoolScheduler,'$!general-queue') + -> \queue { + $!general-jobs = nqp::elems(queue); + } if nqp::getattr($scheduler,ThreadPoolScheduler,'$!timer-workers') -> \workers { $!timer-workers = nqp::elems(workers); @@ -98,6 +103,17 @@ class Telemetry { } multi method general-workers(Telemetry:D:) { $!general-workers } + proto method general-jobs() { * } + multi method general-jobs(Telemetry:U:) { + nqp::if( + nqp::istrue((my $queue := nqp::getattr( + nqp::decont($*SCHEDULER),ThreadPoolScheduler,'$!general-queue' + ))), + nqp::elems($queue) + ) + } + multi method general-jobs(Telemetry:D:) { $!general-jobs } + proto method timer-workers() { * } multi method timer-workers(Telemetry:U:) { nqp::if( @@ -135,12 +151,15 @@ class Telemetry::Period is Telemetry { int :$wallclock, int :$supervisor, int :$general-workers, + int :$general-jobs, int :$timer-workers, int :$affinity-workers, ) { self.new( - $cpu-user, $cpu-sys, $wallclock, - $supervisor, $general-workers, $timer-workers, $affinity-workers + $cpu-user, $cpu-sys, $wallclock, $supervisor, + $general-workers, $general-jobs, + $timer-workers, + $affinity-workers ) } multi method new(Telemetry::Period: @@ -149,6 +168,7 @@ class Telemetry::Period is Telemetry { int $wallclock, int $supervisor, int $general-workers, + int $general-jobs, int $timer-workers, int $affinity-workers, ) { @@ -158,6 +178,7 @@ class Telemetry::Period is Telemetry { nqp::bindattr_i($period,Telemetry,'$!wallclock', $wallclock); nqp::bindattr_i($period,Telemetry,'$!supervisor', $supervisor); nqp::bindattr_i($period,Telemetry,'$!general-workers',$general-workers); + nqp::bindattr_i($period,Telemetry,'$!general-jobs', $general-jobs); nqp::bindattr_i($period,Telemetry,'$!timer-workers', $timer-workers); nqp::bindattr_i($period,Telemetry,'$!affinity-workers',$affinity-workers); $period @@ -174,6 +195,8 @@ class Telemetry::Period is Telemetry { nqp::getattr_i(self,Telemetry,'$!supervisor') }), :general-workers({ nqp::getattr_i(self,Telemetry,'$!general-workers') + }), :general-jobs({ + nqp::getattr_i(self,Telemetry,'$!general-jobs') }), :timer-workers({ nqp::getattr_i(self,Telemetry,'$!timer-workers') }), :affinity-workers({ @@ -219,6 +242,10 @@ multi sub infix:<->(Telemetry:D $a, Telemetry:D $b) is export { nqp::getattr_i(nqp::decont($a),Telemetry,'$!general-workers'), nqp::getattr_i(nqp::decont($b),Telemetry,'$!general-workers') ), + nqp::sub_i( + nqp::getattr_i(nqp::decont($a),Telemetry,'$!general-jobs'), + nqp::getattr_i(nqp::decont($b),Telemetry,'$!general-jobs') + ), nqp::sub_i( nqp::getattr_i(nqp::decont($a),Telemetry,'$!timer-workers'), nqp::getattr_i(nqp::decont($b),Telemetry,'$!timer-workers') From e95b02f158df26038141e3b065044c172facf3f8 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Tue, 31 Oct 2017 09:55:14 +0100 Subject: [PATCH 622/692] Add support for Telemetry.timer-jobs - the number of jobs waiting for handling by timer-workers --- lib/Telemetry.pm6 | 27 ++++++++++++++++++++++++++- 1 file changed, 26 insertions(+), 1 deletion(-) diff --git a/lib/Telemetry.pm6 b/lib/Telemetry.pm6 index 41c59db40fc..4ce69f06097 100644 --- a/lib/Telemetry.pm6 +++ b/lib/Telemetry.pm6 @@ -12,6 +12,7 @@ class Telemetry { has int $!general-workers; has int $!general-jobs; has int $!timer-workers; + has int $!timer-jobs; has int $!affinity-workers; my num $start = Rakudo::Internals.INITTIME; @@ -41,6 +42,10 @@ class Telemetry { -> \workers { $!timer-workers = nqp::elems(workers); } + if nqp::getattr($scheduler,ThreadPoolScheduler,'$!timer-queue') + -> \queue { + $!timer-jobs = nqp::elems(queue); + } if nqp::getattr($scheduler,ThreadPoolScheduler,'$!affinity-workers') -> \workers { $!affinity-workers = nqp::elems(workers); @@ -125,6 +130,17 @@ class Telemetry { } multi method timer-workers(Telemetry:D:) { $!timer-workers } + proto method timer-jobs() { * } + multi method timer-jobs(Telemetry:U:) { + nqp::if( + nqp::istrue((my $queue := nqp::getattr( + nqp::decont($*SCHEDULER),ThreadPoolScheduler,'$!timer-queue' + ))), + nqp::elems($queue) + ) + } + multi method timer-jobs(Telemetry:D:) { $!timer-jobs } + proto method affinity-workers() { * } multi method affinity-workers(Telemetry:U:) { nqp::if( @@ -153,12 +169,13 @@ class Telemetry::Period is Telemetry { int :$general-workers, int :$general-jobs, int :$timer-workers, + int :$timer-jobs, int :$affinity-workers, ) { self.new( $cpu-user, $cpu-sys, $wallclock, $supervisor, $general-workers, $general-jobs, - $timer-workers, + $timer-workers, $timer-jobs, $affinity-workers ) } @@ -170,6 +187,7 @@ class Telemetry::Period is Telemetry { int $general-workers, int $general-jobs, int $timer-workers, + int $timer-jobs, int $affinity-workers, ) { my $period := nqp::create(Telemetry::Period); @@ -180,6 +198,7 @@ class Telemetry::Period is Telemetry { nqp::bindattr_i($period,Telemetry,'$!general-workers',$general-workers); nqp::bindattr_i($period,Telemetry,'$!general-jobs', $general-jobs); nqp::bindattr_i($period,Telemetry,'$!timer-workers', $timer-workers); + nqp::bindattr_i($period,Telemetry,'$!timer-jobs', $timer-jobs); nqp::bindattr_i($period,Telemetry,'$!affinity-workers',$affinity-workers); $period } @@ -199,6 +218,8 @@ class Telemetry::Period is Telemetry { nqp::getattr_i(self,Telemetry,'$!general-jobs') }), :timer-workers({ nqp::getattr_i(self,Telemetry,'$!timer-workers') + }), :timer-jobs({ + nqp::getattr_i(self,Telemetry,'$!timer-jobs') }), :affinity-workers({ nqp::getattr_i(self,Telemetry,'$!affinity-workers') }))" @@ -250,6 +271,10 @@ multi sub infix:<->(Telemetry:D $a, Telemetry:D $b) is export { nqp::getattr_i(nqp::decont($a),Telemetry,'$!timer-workers'), nqp::getattr_i(nqp::decont($b),Telemetry,'$!timer-workers') ), + nqp::sub_i( + nqp::getattr_i(nqp::decont($a),Telemetry,'$!timer-jobs'), + nqp::getattr_i(nqp::decont($b),Telemetry,'$!timer-jobs') + ), nqp::sub_i( nqp::getattr_i(nqp::decont($a),Telemetry,'$!affinity-workers'), nqp::getattr_i(nqp::decont($b),Telemetry,'$!affinity-workers') From ccbfaaa0ab4b7db49c3510b72837334afe1af784 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Tue, 31 Oct 2017 13:09:09 +0100 Subject: [PATCH 623/692] Introducing Telemetry report - first version, showing: utilization, supervisor, general-threads, general-jobs, timer-threads, timer-jobs, affinity-threads - will be noted at program exit if there are still snaps around --- lib/Telemetry.pm6 | 42 ++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 40 insertions(+), 2 deletions(-) diff --git a/lib/Telemetry.pm6 b/lib/Telemetry.pm6 index 4ce69f06097..d7e9641eb2a 100644 --- a/lib/Telemetry.pm6 +++ b/lib/Telemetry.pm6 @@ -304,10 +304,48 @@ multi sub periods() { my @s = @snaps; @snaps = (); @s.push(Telemetry.new) if @s == 1; - (1..^@s).map: { @s[$_] - @s[$_ - 1] } + periods(@s) } multi sub periods(@s) { (1..^@s).map: { @s[$_] - @s[$_ - 1] } } -END { if @snaps { .say for periods } } +proto sub report(|) is export { * } +multi sub report() { + my @s = @snaps; + @snaps = (); + @s.push(Telemetry.new) if @s == 1; + report(@s) +} +multi sub report(@s) { + sub hide0(\value) { value ?? sprintf("%3d",value) !! " " } + + my $text := nqp::list_s(qq:to/HEADER/); +Telemetry Report of Process #$*PID ($*INIT-INSTANT.DateTime()) + util% sv gt gj tt tj at +HEADER + + sub push-period($_) { + nqp::push_s($text, + sprintf("%6.2f %s %s %s %s %s %s\n", + .utilization, + hide0(.supervisor), + hide0(.general-workers), hide0(.general-jobs), + hide0(.timer-workers), hide0(.timer-jobs), + hide0(.affinity-workers) + ) + ); + } + + push-period($_) for periods(@s); + + nqp::push_s($text, qq:to/FOOTER/); +------ --- --- --- --- --- --- +FOOTER + + push-period(@s[*-1] - @s[0]); + + nqp::join('',$text) +} + +END { if @snaps { note report } } # vim: ft=perl6 expandtab sw=4 From 2f963b14a9a8a4cc0ce5e6072deedf36da76d3ba Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Tue, 31 Oct 2017 13:50:38 +0100 Subject: [PATCH 624/692] Various Telemetry report improvements --- lib/Telemetry.pm6 | 20 +++++++++++++------- 1 file changed, 13 insertions(+), 7 deletions(-) diff --git a/lib/Telemetry.pm6 b/lib/Telemetry.pm6 index d7e9641eb2a..cee385810a5 100644 --- a/lib/Telemetry.pm6 +++ b/lib/Telemetry.pm6 @@ -292,8 +292,9 @@ multi sub snap(@s --> Nil) { @s.push(Telemetry.new) } my int $snapper-running; sub snapper($sleep = 0.1 --> Nil) is export { unless $snapper-running { + snap; Thread.start(:app_lifetime, :name, { - loop { snap; sleep $sleep } + loop { sleep $sleep; snap } }); $snapper-running = 1 } @@ -310,16 +311,21 @@ multi sub periods(@s) { (1..^@s).map: { @s[$_] - @s[$_ - 1] } } proto sub report(|) is export { * } multi sub report() { - my @s = @snaps; - @snaps = (); - @s.push(Telemetry.new) if @s == 1; - report(@s) + my $s := nqp::clone(nqp::getattr(@snaps,List,'$!reified')); + nqp::setelems(nqp::getattr(@snaps,List,'$!reified'),0); + nqp::push($s,Telemetry.new) if nqp::elems($s) == 1; + report(nqp::p6bindattrinvres(nqp::create(List),List,'$!reified',$s)); } multi sub report(@s) { sub hide0(\value) { value ?? sprintf("%3d",value) !! " " } + my $total = @s[*-1] - @s[0]; my $text := nqp::list_s(qq:to/HEADER/); Telemetry Report of Process #$*PID ($*INIT-INSTANT.DateTime()) +Number of Snapshots: {+@s} +Total Time: { ($total.wallclock / 1000000).fmt("%9.2f") } seconds +Total CPU Usage: { ($total.cpu / 1000000).fmt("%9.2f") } seconds + util% sv gt gj tt tj at HEADER @@ -341,11 +347,11 @@ HEADER ------ --- --- --- --- --- --- FOOTER - push-period(@s[*-1] - @s[0]); + push-period($total); nqp::join('',$text) } -END { if @snaps { note report } } +END { if @snaps { snap; note report } } # vim: ft=perl6 expandtab sw=4 From c1867ba19d72a161e5582d283bb6626079dc5b07 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Tue, 31 Oct 2017 17:03:43 +0100 Subject: [PATCH 625/692] Add snapper.pm6 - helper module for starting up a Telemetry snapper externally - through either -Msnapper or "use snapper" - because of auto-reporting now a useful tool for snapping a whole script - some other minor tweaks in Telemetry --- lib/Telemetry.pm6 | 12 ++++++------ lib/snapper.pm6 | 7 +++++++ tools/build/install-core-dist.pl | 1 + 3 files changed, 14 insertions(+), 6 deletions(-) create mode 100644 lib/snapper.pm6 diff --git a/lib/Telemetry.pm6 b/lib/Telemetry.pm6 index cee385810a5..8c3de2cc98a 100644 --- a/lib/Telemetry.pm6 +++ b/lib/Telemetry.pm6 @@ -1,4 +1,4 @@ -# An attempt at providing an API to nqp::getrusage. +# Provide an API for keeping track of a lot of system lifesigns use nqp; @@ -320,7 +320,7 @@ multi sub report(@s) { sub hide0(\value) { value ?? sprintf("%3d",value) !! " " } my $total = @s[*-1] - @s[0]; - my $text := nqp::list_s(qq:to/HEADER/); + my $text := nqp::list_s(qq:to/HEADER/.chomp); Telemetry Report of Process #$*PID ($*INIT-INSTANT.DateTime()) Number of Snapshots: {+@s} Total Time: { ($total.wallclock / 1000000).fmt("%9.2f") } seconds @@ -331,25 +331,25 @@ HEADER sub push-period($_) { nqp::push_s($text, - sprintf("%6.2f %s %s %s %s %s %s\n", + sprintf("%6.2f %s %s %s %s %s %s", .utilization, hide0(.supervisor), hide0(.general-workers), hide0(.general-jobs), hide0(.timer-workers), hide0(.timer-jobs), hide0(.affinity-workers) - ) + ).trim-trailing ); } push-period($_) for periods(@s); - nqp::push_s($text, qq:to/FOOTER/); + nqp::push_s($text, qq:to/FOOTER/.chomp); ------ --- --- --- --- --- --- FOOTER push-period($total); - nqp::join('',$text) + nqp::join("\n",$text) } END { if @snaps { snap; note report } } diff --git a/lib/snapper.pm6 b/lib/snapper.pm6 new file mode 100644 index 00000000000..049dbaeb931 --- /dev/null +++ b/lib/snapper.pm6 @@ -0,0 +1,7 @@ +# shorthand for loading Telemetry and starting a snapper + +use Telemetry; + +snapper; + +# vim: ft=perl6 expandtab sw=4 diff --git a/tools/build/install-core-dist.pl b/tools/build/install-core-dist.pl index 1b67cafdeab..ad49684794d 100644 --- a/tools/build/install-core-dist.pl +++ b/tools/build/install-core-dist.pl @@ -11,6 +11,7 @@ "experimental" => "lib/experimental.pm6", "CompUnit::Repository::Staging" => "lib/CompUnit/Repository/Staging.pm", "Telemetry" => "lib/Telemetry.pm6", + "snapper" => "lib/snapper.pm6", ; PROCESS::<$REPO> := CompUnit::Repository::Staging.new( From 8e4d3248f62800fe70e9aed3f7403f67e2c778df Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Tue, 31 Oct 2017 17:35:12 +0100 Subject: [PATCH 626/692] SNAPPER= environment variable to set snap period --- lib/snapper.pm6 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/snapper.pm6 b/lib/snapper.pm6 index 049dbaeb931..2823c716865 100644 --- a/lib/snapper.pm6 +++ b/lib/snapper.pm6 @@ -2,6 +2,6 @@ use Telemetry; -snapper; +snapper( %*ENV // 0.1 ); # vim: ft=perl6 expandtab sw=4 From 0a8096989d2a3f5fd35c846361a96b786bcaeb82 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Tue, 31 Oct 2017 17:47:29 +0100 Subject: [PATCH 627/692] s/SNAPPER/RAKUDO_SNAPPER/ --- lib/snapper.pm6 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/snapper.pm6 b/lib/snapper.pm6 index 2823c716865..942581cd476 100644 --- a/lib/snapper.pm6 +++ b/lib/snapper.pm6 @@ -2,6 +2,6 @@ use Telemetry; -snapper( %*ENV // 0.1 ); +snapper( %*ENV // 0.1 ); # vim: ft=perl6 expandtab sw=4 From dcf3e28c50f3ecfd8d6596874b156050c3a3c17c Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Tue, 31 Oct 2017 18:04:12 +0100 Subject: [PATCH 628/692] s/x-jobs/x-jobs-waiting/ - because they show the number of jobs still waiting to be executed - makes logical room for x-jobs-completed --- lib/Telemetry.pm6 | 58 +++++++++++++++++++++++------------------------ 1 file changed, 29 insertions(+), 29 deletions(-) diff --git a/lib/Telemetry.pm6 b/lib/Telemetry.pm6 index 8c3de2cc98a..24703706cf4 100644 --- a/lib/Telemetry.pm6 +++ b/lib/Telemetry.pm6 @@ -10,9 +10,9 @@ class Telemetry { has int $!wallclock; has int $!supervisor; has int $!general-workers; - has int $!general-jobs; + has int $!general-jobs-waiting; has int $!timer-workers; - has int $!timer-jobs; + has int $!timer-jobs-waiting; has int $!affinity-workers; my num $start = Rakudo::Internals.INITTIME; @@ -36,7 +36,7 @@ class Telemetry { } if nqp::getattr($scheduler,ThreadPoolScheduler,'$!general-queue') -> \queue { - $!general-jobs = nqp::elems(queue); + $!general-jobs-waiting = nqp::elems(queue); } if nqp::getattr($scheduler,ThreadPoolScheduler,'$!timer-workers') -> \workers { @@ -44,7 +44,7 @@ class Telemetry { } if nqp::getattr($scheduler,ThreadPoolScheduler,'$!timer-queue') -> \queue { - $!timer-jobs = nqp::elems(queue); + $!timer-jobs-waiting = nqp::elems(queue); } if nqp::getattr($scheduler,ThreadPoolScheduler,'$!affinity-workers') -> \workers { @@ -108,8 +108,8 @@ class Telemetry { } multi method general-workers(Telemetry:D:) { $!general-workers } - proto method general-jobs() { * } - multi method general-jobs(Telemetry:U:) { + proto method general-jobs-waiting() { * } + multi method general-jobs-waiting(Telemetry:U:) { nqp::if( nqp::istrue((my $queue := nqp::getattr( nqp::decont($*SCHEDULER),ThreadPoolScheduler,'$!general-queue' @@ -117,7 +117,7 @@ class Telemetry { nqp::elems($queue) ) } - multi method general-jobs(Telemetry:D:) { $!general-jobs } + multi method general-jobs-waiting(Telemetry:D:) { $!general-jobs-waiting } proto method timer-workers() { * } multi method timer-workers(Telemetry:U:) { @@ -130,8 +130,8 @@ class Telemetry { } multi method timer-workers(Telemetry:D:) { $!timer-workers } - proto method timer-jobs() { * } - multi method timer-jobs(Telemetry:U:) { + proto method timer-jobs-waiting() { * } + multi method timer-jobs-waiting(Telemetry:U:) { nqp::if( nqp::istrue((my $queue := nqp::getattr( nqp::decont($*SCHEDULER),ThreadPoolScheduler,'$!timer-queue' @@ -139,7 +139,7 @@ class Telemetry { nqp::elems($queue) ) } - multi method timer-jobs(Telemetry:D:) { $!timer-jobs } + multi method timer-jobs-waiting(Telemetry:D:) { $!timer-jobs-waiting } proto method affinity-workers() { * } multi method affinity-workers(Telemetry:U:) { @@ -167,15 +167,15 @@ class Telemetry::Period is Telemetry { int :$wallclock, int :$supervisor, int :$general-workers, - int :$general-jobs, + int :$general-jobs-waiting, int :$timer-workers, - int :$timer-jobs, + int :$timer-jobs-waiting, int :$affinity-workers, ) { self.new( $cpu-user, $cpu-sys, $wallclock, $supervisor, - $general-workers, $general-jobs, - $timer-workers, $timer-jobs, + $general-workers, $general-jobs-waiting, + $timer-workers, $timer-jobs-waiting, $affinity-workers ) } @@ -185,9 +185,9 @@ class Telemetry::Period is Telemetry { int $wallclock, int $supervisor, int $general-workers, - int $general-jobs, + int $general-jobs-waiting, int $timer-workers, - int $timer-jobs, + int $timer-jobs-waiting, int $affinity-workers, ) { my $period := nqp::create(Telemetry::Period); @@ -196,9 +196,9 @@ class Telemetry::Period is Telemetry { nqp::bindattr_i($period,Telemetry,'$!wallclock', $wallclock); nqp::bindattr_i($period,Telemetry,'$!supervisor', $supervisor); nqp::bindattr_i($period,Telemetry,'$!general-workers',$general-workers); - nqp::bindattr_i($period,Telemetry,'$!general-jobs', $general-jobs); + nqp::bindattr_i($period,Telemetry,'$!general-jobs-waiting', $general-jobs-waiting); nqp::bindattr_i($period,Telemetry,'$!timer-workers', $timer-workers); - nqp::bindattr_i($period,Telemetry,'$!timer-jobs', $timer-jobs); + nqp::bindattr_i($period,Telemetry,'$!timer-jobs-waiting', $timer-jobs-waiting); nqp::bindattr_i($period,Telemetry,'$!affinity-workers',$affinity-workers); $period } @@ -214,12 +214,12 @@ class Telemetry::Period is Telemetry { nqp::getattr_i(self,Telemetry,'$!supervisor') }), :general-workers({ nqp::getattr_i(self,Telemetry,'$!general-workers') - }), :general-jobs({ - nqp::getattr_i(self,Telemetry,'$!general-jobs') + }), :general-jobs-waiting({ + nqp::getattr_i(self,Telemetry,'$!general-jobs-waiting') }), :timer-workers({ nqp::getattr_i(self,Telemetry,'$!timer-workers') - }), :timer-jobs({ - nqp::getattr_i(self,Telemetry,'$!timer-jobs') + }), :timer-jobs-waiting({ + nqp::getattr_i(self,Telemetry,'$!timer-jobs-waiting') }), :affinity-workers({ nqp::getattr_i(self,Telemetry,'$!affinity-workers') }))" @@ -264,16 +264,16 @@ multi sub infix:<->(Telemetry:D $a, Telemetry:D $b) is export { nqp::getattr_i(nqp::decont($b),Telemetry,'$!general-workers') ), nqp::sub_i( - nqp::getattr_i(nqp::decont($a),Telemetry,'$!general-jobs'), - nqp::getattr_i(nqp::decont($b),Telemetry,'$!general-jobs') + nqp::getattr_i(nqp::decont($a),Telemetry,'$!general-jobs-waiting'), + nqp::getattr_i(nqp::decont($b),Telemetry,'$!general-jobs-waiting') ), nqp::sub_i( nqp::getattr_i(nqp::decont($a),Telemetry,'$!timer-workers'), nqp::getattr_i(nqp::decont($b),Telemetry,'$!timer-workers') ), nqp::sub_i( - nqp::getattr_i(nqp::decont($a),Telemetry,'$!timer-jobs'), - nqp::getattr_i(nqp::decont($b),Telemetry,'$!timer-jobs') + nqp::getattr_i(nqp::decont($a),Telemetry,'$!timer-jobs-waiting'), + nqp::getattr_i(nqp::decont($b),Telemetry,'$!timer-jobs-waiting') ), nqp::sub_i( nqp::getattr_i(nqp::decont($a),Telemetry,'$!affinity-workers'), @@ -326,7 +326,7 @@ Number of Snapshots: {+@s} Total Time: { ($total.wallclock / 1000000).fmt("%9.2f") } seconds Total CPU Usage: { ($total.cpu / 1000000).fmt("%9.2f") } seconds - util% sv gt gj tt tj at + util% sv gt gjw tt tjw at HEADER sub push-period($_) { @@ -334,8 +334,8 @@ HEADER sprintf("%6.2f %s %s %s %s %s %s", .utilization, hide0(.supervisor), - hide0(.general-workers), hide0(.general-jobs), - hide0(.timer-workers), hide0(.timer-jobs), + hide0(.general-workers), hide0(.general-jobs-waiting), + hide0(.timer-workers), hide0(.timer-jobs-waiting), hide0(.affinity-workers) ).trim-trailing ); From 9381ffbc90fe2543f971b2ad102d52e4198e0a11 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Tue, 31 Oct 2017 22:29:01 +0100 Subject: [PATCH 629/692] Add Worker.total, total # jobs completed by worker - $!completed is the number of jobs completed since last supervisor check - which is useless for telemetry purposes --- src/core/ThreadPoolScheduler.pm | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index 950b44392bf..76341d492c4 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -199,13 +199,16 @@ my class ThreadPoolScheduler does Scheduler { has int $.completed; #?endif + # Total number of tasks completed since creation. + has int $.total; + # Working is 1 if the worker is currently busy, 0 if not. has int $.working; # Number of times take-completed has returned zero in a row. has int $.times-nothing-completed; - # Resets the completed to zero. + # Resets the completed to zero and updates the total. method take-completed() { #?if moar my atomicint $taken; @@ -219,6 +222,7 @@ my class ThreadPoolScheduler does Scheduler { $!times-nothing-completed++; } else { + $!total = $!total + $taken; $!times-nothing-completed = 0; } $taken From 0bdda0866f262e4db42d73ab6a8bf18eff721f06 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Tue, 31 Oct 2017 23:01:21 +0100 Subject: [PATCH 630/692] Latest set of Telemetry improvements - s/jobs/tasks/ as we use the word "task" in ThreadPoolScheduler code - s/waiting/queued/, so that we can use the "w" for "working" later - add (general|timer)-tasks-completed info - add wallclock back into report for now (so we can see period size) --- lib/Telemetry.pm6 | 168 +++++++++++++++++++++++++++++++++++----------- 1 file changed, 127 insertions(+), 41 deletions(-) diff --git a/lib/Telemetry.pm6 b/lib/Telemetry.pm6 index 24703706cf4..b75e419a88b 100644 --- a/lib/Telemetry.pm6 +++ b/lib/Telemetry.pm6 @@ -10,13 +10,32 @@ class Telemetry { has int $!wallclock; has int $!supervisor; has int $!general-workers; - has int $!general-jobs-waiting; + has int $!general-tasks-queued; + has int $!general-tasks-completed; has int $!timer-workers; - has int $!timer-jobs-waiting; + has int $!timer-tasks-queued; + has int $!timer-tasks-completed; has int $!affinity-workers; my num $start = Rakudo::Internals.INITTIME; + sub completed(\workers) is raw { + my int $elems = nqp::elems(workers); + my int $completed; + my int $i = -1; + nqp::while( + nqp::islt_i(($i = nqp::add_i($i,1)),$elems), + nqp::stmts( + (my $w := nqp::atpos(workers,$i)), + ($completed = nqp::add_i( + $completed, + nqp::getattr_i($w,$w.WHAT,'$!total') + )) + ) + ); + $completed + } + submethod BUILD() { my \rusage = nqp::getrusage; $!cpu-user = nqp::atpos_i(rusage,nqp::const::RUSAGE_UTIME_SEC) * 1000000 @@ -33,18 +52,20 @@ class Telemetry { if nqp::getattr($scheduler,ThreadPoolScheduler,'$!general-workers') -> \workers { $!general-workers = nqp::elems(workers); + $!general-tasks-completed = completed(workers); } if nqp::getattr($scheduler,ThreadPoolScheduler,'$!general-queue') -> \queue { - $!general-jobs-waiting = nqp::elems(queue); + $!general-tasks-queued = nqp::elems(queue); } if nqp::getattr($scheduler,ThreadPoolScheduler,'$!timer-workers') -> \workers { $!timer-workers = nqp::elems(workers); + $!timer-tasks-completed = completed(workers); } if nqp::getattr($scheduler,ThreadPoolScheduler,'$!timer-queue') -> \queue { - $!timer-jobs-waiting = nqp::elems(queue); + $!timer-tasks-queued = nqp::elems(queue); } if nqp::getattr($scheduler,ThreadPoolScheduler,'$!affinity-workers') -> \workers { @@ -95,7 +116,9 @@ class Telemetry { ) ) } - multi method supervisor(Telemetry:D:) { $!supervisor } + multi method supervisor(Telemetry:D:) { + $!supervisor + } proto method general-workers() { * } multi method general-workers(Telemetry:U:) { @@ -106,10 +129,12 @@ class Telemetry { nqp::elems($workers) ) } - multi method general-workers(Telemetry:D:) { $!general-workers } + multi method general-workers(Telemetry:D:) { + $!general-workers + } - proto method general-jobs-waiting() { * } - multi method general-jobs-waiting(Telemetry:U:) { + proto method general-tasks-queued() { * } + multi method general-tasks-queued(Telemetry:U:) { nqp::if( nqp::istrue((my $queue := nqp::getattr( nqp::decont($*SCHEDULER),ThreadPoolScheduler,'$!general-queue' @@ -117,7 +142,22 @@ class Telemetry { nqp::elems($queue) ) } - multi method general-jobs-waiting(Telemetry:D:) { $!general-jobs-waiting } + multi method general-tasks-queued(Telemetry:D:) { + $!general-tasks-queued + } + + proto method general-tasks-completed() { * } + multi method general-tasks-completed(Telemetry:U:) { + nqp::if( + nqp::istrue((my $workers := nqp::getattr( + nqp::decont($*SCHEDULER),ThreadPoolScheduler,'$!general-workers' + ))), + completed($workers) + ) + } + multi method general-tasks-completed(Telemetry:D:) { + $!general-tasks-completed + } proto method timer-workers() { * } multi method timer-workers(Telemetry:U:) { @@ -130,8 +170,8 @@ class Telemetry { } multi method timer-workers(Telemetry:D:) { $!timer-workers } - proto method timer-jobs-waiting() { * } - multi method timer-jobs-waiting(Telemetry:U:) { + proto method timer-tasks-queued() { * } + multi method timer-tasks-queued(Telemetry:U:) { nqp::if( nqp::istrue((my $queue := nqp::getattr( nqp::decont($*SCHEDULER),ThreadPoolScheduler,'$!timer-queue' @@ -139,7 +179,20 @@ class Telemetry { nqp::elems($queue) ) } - multi method timer-jobs-waiting(Telemetry:D:) { $!timer-jobs-waiting } + multi method timer-tasks-queued(Telemetry:D:) { $!timer-tasks-queued } + + proto method timer-tasks-completed() { * } + multi method timer-tasks-completed(Telemetry:U:) { + nqp::if( + nqp::istrue((my $workers := nqp::getattr( + nqp::decont($*SCHEDULER),ThreadPoolScheduler,'$!timer-workers' + ))), + completed($workers) + ) + } + multi method timer-tasks-completed(Telemetry:D:) { + $!timer-tasks-completed + } proto method affinity-workers() { * } multi method affinity-workers(Telemetry:U:) { @@ -167,15 +220,17 @@ class Telemetry::Period is Telemetry { int :$wallclock, int :$supervisor, int :$general-workers, - int :$general-jobs-waiting, + int :$general-tasks-queued, + int :$general-tasks-completed, int :$timer-workers, - int :$timer-jobs-waiting, + int :$timer-tasks-queued, + int :$timer-tasks-completed, int :$affinity-workers, ) { self.new( $cpu-user, $cpu-sys, $wallclock, $supervisor, - $general-workers, $general-jobs-waiting, - $timer-workers, $timer-jobs-waiting, + $general-workers, $general-tasks-queued, $general-tasks-completed, + $timer-workers, $timer-tasks-queued, $timer-tasks-completed, $affinity-workers ) } @@ -185,21 +240,36 @@ class Telemetry::Period is Telemetry { int $wallclock, int $supervisor, int $general-workers, - int $general-jobs-waiting, + int $general-tasks-queued, + int $general-tasks-completed, int $timer-workers, - int $timer-jobs-waiting, + int $timer-tasks-queued, + int $timer-tasks-completed, int $affinity-workers, ) { my $period := nqp::create(Telemetry::Period); - nqp::bindattr_i($period,Telemetry,'$!cpu-user', $cpu-user); - nqp::bindattr_i($period,Telemetry,'$!cpu-sys', $cpu-sys); - nqp::bindattr_i($period,Telemetry,'$!wallclock', $wallclock); - nqp::bindattr_i($period,Telemetry,'$!supervisor', $supervisor); - nqp::bindattr_i($period,Telemetry,'$!general-workers',$general-workers); - nqp::bindattr_i($period,Telemetry,'$!general-jobs-waiting', $general-jobs-waiting); - nqp::bindattr_i($period,Telemetry,'$!timer-workers', $timer-workers); - nqp::bindattr_i($period,Telemetry,'$!timer-jobs-waiting', $timer-jobs-waiting); - nqp::bindattr_i($period,Telemetry,'$!affinity-workers',$affinity-workers); + nqp::bindattr_i($period,Telemetry, + '$!cpu-user', $cpu-user); + nqp::bindattr_i($period,Telemetry, + '$!cpu-sys', $cpu-sys); + nqp::bindattr_i($period,Telemetry, + '$!wallclock', $wallclock); + nqp::bindattr_i($period,Telemetry, + '$!supervisor', $supervisor); + nqp::bindattr_i($period,Telemetry, + '$!general-workers', $general-workers); + nqp::bindattr_i($period,Telemetry, + '$!general-tasks-queued', $general-tasks-queued); + nqp::bindattr_i($period,Telemetry, + '$!general-tasks-completed',$general-tasks-completed); + nqp::bindattr_i($period,Telemetry, + '$!timer-workers', $timer-workers); + nqp::bindattr_i($period,Telemetry, + '$!timer-tasks-queued', $timer-tasks-queued); + nqp::bindattr_i($period,Telemetry, + '$!timer-tasks-completed', $timer-tasks-completed); + nqp::bindattr_i($period,Telemetry, + '$!affinity-workers', $affinity-workers); $period } @@ -214,12 +284,16 @@ class Telemetry::Period is Telemetry { nqp::getattr_i(self,Telemetry,'$!supervisor') }), :general-workers({ nqp::getattr_i(self,Telemetry,'$!general-workers') - }), :general-jobs-waiting({ - nqp::getattr_i(self,Telemetry,'$!general-jobs-waiting') + }), :general-tasks-queued({ + nqp::getattr_i(self,Telemetry,'$!general-tasks-queued') + }), :general-tasks-completed({ + nqp::getattr_i(self,Telemetry,'$!general-tasks-completed') }), :timer-workers({ nqp::getattr_i(self,Telemetry,'$!timer-workers') - }), :timer-jobs-waiting({ - nqp::getattr_i(self,Telemetry,'$!timer-jobs-waiting') + }), :timer-tasks-queued({ + nqp::getattr_i(self,Telemetry,'$!timer-tasks-queued') + }), :timer-tasks-completed({ + nqp::getattr_i(self,Telemetry,'$!timer-tasks-completed') }), :affinity-workers({ nqp::getattr_i(self,Telemetry,'$!affinity-workers') }))" @@ -264,16 +338,24 @@ multi sub infix:<->(Telemetry:D $a, Telemetry:D $b) is export { nqp::getattr_i(nqp::decont($b),Telemetry,'$!general-workers') ), nqp::sub_i( - nqp::getattr_i(nqp::decont($a),Telemetry,'$!general-jobs-waiting'), - nqp::getattr_i(nqp::decont($b),Telemetry,'$!general-jobs-waiting') + nqp::getattr_i(nqp::decont($a),Telemetry,'$!general-tasks-queued'), + nqp::getattr_i(nqp::decont($b),Telemetry,'$!general-tasks-queued') + ), + nqp::sub_i( + nqp::getattr_i(nqp::decont($a),Telemetry,'$!general-tasks-completed'), + nqp::getattr_i(nqp::decont($b),Telemetry,'$!general-tasks-completed') ), nqp::sub_i( nqp::getattr_i(nqp::decont($a),Telemetry,'$!timer-workers'), nqp::getattr_i(nqp::decont($b),Telemetry,'$!timer-workers') ), nqp::sub_i( - nqp::getattr_i(nqp::decont($a),Telemetry,'$!timer-jobs-waiting'), - nqp::getattr_i(nqp::decont($b),Telemetry,'$!timer-jobs-waiting') + nqp::getattr_i(nqp::decont($a),Telemetry,'$!timer-tasks-queued'), + nqp::getattr_i(nqp::decont($b),Telemetry,'$!timer-tasks-queued') + ), + nqp::sub_i( + nqp::getattr_i(nqp::decont($a),Telemetry,'$!timer-tasks-completed'), + nqp::getattr_i(nqp::decont($b),Telemetry,'$!timer-tasks-completed') ), nqp::sub_i( nqp::getattr_i(nqp::decont($a),Telemetry,'$!affinity-workers'), @@ -317,7 +399,7 @@ multi sub report() { report(nqp::p6bindattrinvres(nqp::create(List),List,'$!reified',$s)); } multi sub report(@s) { - sub hide0(\value) { value ?? sprintf("%3d",value) !! " " } + sub hide0(\value, $size = 3) { value ?? sprintf("%{$size}d",value) !! " " } my $total = @s[*-1] - @s[0]; my $text := nqp::list_s(qq:to/HEADER/.chomp); @@ -326,16 +408,20 @@ Number of Snapshots: {+@s} Total Time: { ($total.wallclock / 1000000).fmt("%9.2f") } seconds Total CPU Usage: { ($total.cpu / 1000000).fmt("%9.2f") } seconds - util% sv gt gjw tt tjw at + wall util% sv gd gtq gtc td ttq at HEADER sub push-period($_) { nqp::push_s($text, - sprintf("%6.2f %s %s %s %s %s %s", + sprintf('%8d %6.2f %s %s %s %s %s %s %s', + .wallclock, .utilization, hide0(.supervisor), - hide0(.general-workers), hide0(.general-jobs-waiting), - hide0(.timer-workers), hide0(.timer-jobs-waiting), + hide0(.general-workers), + hide0(.general-tasks-queued), + hide0(.general-tasks-completed,4), + hide0(.timer-workers), + hide0(.timer-tasks-queued), hide0(.affinity-workers) ).trim-trailing ); @@ -344,7 +430,7 @@ HEADER push-period($_) for periods(@s); nqp::push_s($text, qq:to/FOOTER/.chomp); ------- --- --- --- --- --- --- +-------- ------ --- --- --- ---- --- --- --- FOOTER push-period($total); From 697e4ecff54077e9d791e4096fff1abda3785a22 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Tue, 31 Oct 2017 23:45:08 +0100 Subject: [PATCH 631/692] Use prefix ++ instead of postfix ++ where possible This seems to have a few % positive effect on test-t --race 20 --- src/core/ThreadPoolScheduler.pm | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index 76341d492c4..559a60d05c8 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -106,7 +106,7 @@ my class ThreadPoolScheduler does Scheduler { nqp::push_i(indices, $insert); } - $insert++; + ++$insert; } # See if we have anything that we really need to suspend for. If @@ -124,7 +124,7 @@ my class ThreadPoolScheduler does Scheduler { $l.lock; { my int $remaining = $num-handles; - loop (my int $i = 0; $i < $num-handles; $i++) { + loop (my int $i = 0; $i < $num-handles; ++$i) { my $handle := nqp::atpos(handles, $i); my int $insert = nqp::atpos_i(indices, $i); $handle.subscribe-awaiter(-> \success, \result { @@ -219,7 +219,7 @@ my class ThreadPoolScheduler does Scheduler { $!completed = 0; #?endif if $taken == 0 { - $!times-nothing-completed++; + ++$!times-nothing-completed; } else { $!total = $!total + $taken; @@ -252,10 +252,10 @@ my class ThreadPoolScheduler does Scheduler { }); $!working = 0; #?if moar - $!completed⚛++; + ++⚛$!completed; #?endif #?if !moar - $!completed++; + ++$!completed; #?endif } } From 581edd58e9c1c9e90f93d71d1d97e546c4a858aa Mon Sep 17 00:00:00 2001 From: usev6 Date: Wed, 1 Nov 2017 06:55:51 +0100 Subject: [PATCH 632/692] Add bandaid for JVM: no native array in supervisor For some reasons using a native num array when starting the supervisor thread does not work correctly on the JVM backend. It looks like a VMArrayInstance is created (instead of VMArrayInstance_n). See also https://irclog.perlgeek.de/perl6-dev/2017-10-31#i_15383761 --- src/core/ThreadPoolScheduler.pm | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index 559a60d05c8..9e08dd424b4 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -491,7 +491,12 @@ my class ThreadPoolScheduler does Scheduler { scheduler-debug "Supervisor started"; my num $last-rusage-time = nqp::time_n; my int $last-usage = getrusage-total; +#?if !jvm my num @last-utils = 0e0 xx NUM_SAMPLES; +#?endif +#?if jvm + my @last-utils = 0e0 xx NUM_SAMPLES; +#?endif my int $cpu-cores = nqp::cpucores(); scheduler-debug "Supervisor thinks there are $cpu-cores CPU cores"; loop { From de92e34013e6e5380af9795b58aed228805e56df Mon Sep 17 00:00:00 2001 From: Aleks-Daniel Jakimenko-Aleksejev Date: Wed, 1 Nov 2017 09:09:54 +0200 Subject: [PATCH 633/692] Start the changelog for 2017.11 So that others have some place to log their changes if they want to. --- docs/ChangeLog | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/docs/ChangeLog b/docs/ChangeLog index 074394e6f36..198ad92a7b4 100644 --- a/docs/ChangeLog +++ b/docs/ChangeLog @@ -1,3 +1,14 @@ +New in 2017.11: + + SPECIAL NOTES: + + Security: + + Deprecations: + + Fixes: + + Additions: + + Removals: + + Build system: + + Efficiency: + + Internal: + New in 2017.10: + SPECIAL NOTES: + This release includes fixes to || alternation in :ratchet From 6389cea9f23c7fc2efb76c50a09331ac05d14c72 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Wed, 1 Nov 2017 12:45:29 +0100 Subject: [PATCH 634/692] Add Worker.worked attribute - number of wallclock seconds the Worker actually worked - would be nice to get amount of CPU as well, but that's currently not possible - OTOH, assuming CPU intensive jobs, this is probably 1:1 with CPU --- src/core/ThreadPoolScheduler.pm | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index 9e08dd424b4..6f9807a326e 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -202,6 +202,9 @@ my class ThreadPoolScheduler does Scheduler { # Total number of tasks completed since creation. has int $.total; + # Wallclock seconds actually worked + has num $.worked; + # Working is 1 if the worker is currently busy, 0 if not. has int $.working; @@ -229,14 +232,19 @@ my class ThreadPoolScheduler does Scheduler { } method !run-one(\task --> Nil) { + my num $start; $!working = 1; nqp::continuationreset(THREAD_POOL_PROMPT, { if nqp::istype(task, List) { my Mu $code := nqp::shift(nqp::getattr(task, List, '$!reified')); + $start = nqp::time_n; $code(|task); + $!worked = nqp::add_n($!worked,nqp::sub_n(nqp::time_n,$start)); } else { + $start = nqp::time_n; task.(); + $!worked = nqp::add_n($!worked,nqp::sub_n(nqp::time_n,$start)); } CONTROL { default { From 2ec29f20b8bc205963111de7d4f3fa0c9f4fd539 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Wed, 1 Nov 2017 08:53:59 -0400 Subject: [PATCH 635/692] Add a blurb about filing Issues Since this document is linked to from "New Issue" page, it's helpful to include "rules" for bug reports first and place all the info about contributions later. --- CONTRIBUTING.md | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index ecfdd8e5192..f47f1ddea10 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -1,3 +1,14 @@ +# Filing Issues + +## Potential bugs + +Please include a way for developers to reproduce the problem. A small program +that demonstrates a problem is best. + +Describe the behaviour you're observing and how it differs from expectations. +Include the version of the compiler you're using (run `perl6 -v`) as well as +the type and version of the operating system (e.g. `Windows 10`) + # How to Contribute to Rakudo Perl 6 Contributions to Rakudo are very welcome. From c360d9a28d7206e9884b9870be67e5c4fdafd198 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Wed, 1 Nov 2017 08:54:50 -0400 Subject: [PATCH 636/692] Add more separation between sections --- CONTRIBUTING.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index f47f1ddea10..edf39feb6ed 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -9,6 +9,8 @@ Describe the behaviour you're observing and how it differs from expectations. Include the version of the compiler you're using (run `perl6 -v`) as well as the type and version of the operating system (e.g. `Windows 10`) +-------------------------------- + # How to Contribute to Rakudo Perl 6 Contributions to Rakudo are very welcome. From d48e446ddbf2bbef62ec7a36697162eb13755fbd Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Wed, 1 Nov 2017 09:07:49 -0400 Subject: [PATCH 637/692] Add ISSUE_TEMPLATE.md GitHub uses it as a template for new issues. --- .github/ISSUE_TEMPLATE.md | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) create mode 100644 .github/ISSUE_TEMPLATE.md diff --git a/.github/ISSUE_TEMPLATE.md b/.github/ISSUE_TEMPLATE.md new file mode 100644 index 00000000000..b1aa0749c68 --- /dev/null +++ b/.github/ISSUE_TEMPLATE.md @@ -0,0 +1,22 @@ + + +## The Problem + +## Expected Behavior + +## Actual Behavior + +## Steps to Reproduce + + +## Your Environment +* Operating system: +* Compiler version (`perl6 -v`): + From 5e158d9c6b42e424e2cb1dc445b13276ad64a4d1 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Wed, 1 Nov 2017 09:10:45 -0400 Subject: [PATCH 638/692] Simplify wording --- .github/ISSUE_TEMPLATE.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/ISSUE_TEMPLATE.md b/.github/ISSUE_TEMPLATE.md index b1aa0749c68..18039676aff 100644 --- a/.github/ISSUE_TEMPLATE.md +++ b/.github/ISSUE_TEMPLATE.md @@ -16,7 +16,7 @@ If the program unexpectedly crashes, please run it with `perl6 --ll-exception` and provide the produced output. --> -## Your Environment +## Environment * Operating system: * Compiler version (`perl6 -v`): From b386963a373a44a5bb4c2fa83c012c1673344d6e Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Wed, 1 Nov 2017 14:18:52 +0100 Subject: [PATCH 639/692] One last place where we can use push-worker --- src/core/ThreadPoolScheduler.pm | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index 6f9807a326e..e37d54b02b3 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -333,15 +333,13 @@ my class ThreadPoolScheduler does Scheduler { unless $!general-queue.DEFINITE { # We don't have any workers yet, so start one. $!general-queue := nqp::create(Queue); - my $workers := nqp::create(IterationBuffer); - nqp::push( - $workers, + $!general-workers := push-worker( + nqp::create(IterationBuffer), GeneralWorker.new( queue => $!general-queue, scheduler => self ) ); - $!general-workers := $workers; scheduler-debug "Created initial general worker thread"; self!maybe-start-supervisor(); } From 23776247298f24fe374903e5239cdd61f173078a Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Wed, 1 Nov 2017 14:46:32 +0100 Subject: [PATCH 640/692] Remove Worker.worked, it was too heavy to be run always Also move update of Worker.total to run-one - so we don't lose any completions not seen by supervisor yet at end --- src/core/ThreadPoolScheduler.pm | 10 +--------- 1 file changed, 1 insertion(+), 9 deletions(-) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index e37d54b02b3..759dc60e89d 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -202,9 +202,6 @@ my class ThreadPoolScheduler does Scheduler { # Total number of tasks completed since creation. has int $.total; - # Wallclock seconds actually worked - has num $.worked; - # Working is 1 if the worker is currently busy, 0 if not. has int $.working; @@ -225,26 +222,20 @@ my class ThreadPoolScheduler does Scheduler { ++$!times-nothing-completed; } else { - $!total = $!total + $taken; $!times-nothing-completed = 0; } $taken } method !run-one(\task --> Nil) { - my num $start; $!working = 1; nqp::continuationreset(THREAD_POOL_PROMPT, { if nqp::istype(task, List) { my Mu $code := nqp::shift(nqp::getattr(task, List, '$!reified')); - $start = nqp::time_n; $code(|task); - $!worked = nqp::add_n($!worked,nqp::sub_n(nqp::time_n,$start)); } else { - $start = nqp::time_n; task.(); - $!worked = nqp::add_n($!worked,nqp::sub_n(nqp::time_n,$start)); } CONTROL { default { @@ -265,6 +256,7 @@ my class ThreadPoolScheduler does Scheduler { #?if !moar ++$!completed; #?endif + ++$!total; } } my class GeneralWorker does Worker { From 5d0ccf73a44f692a397023648d1802af54060bc3 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Wed, 1 Nov 2017 15:44:18 +0100 Subject: [PATCH 641/692] Use a dedicated first-worker Instead of cloning an empty buffer and then pushing with push-worker. --- src/core/ThreadPoolScheduler.pm | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index 759dc60e89d..2e9ba9f6f02 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -325,8 +325,7 @@ my class ThreadPoolScheduler does Scheduler { unless $!general-queue.DEFINITE { # We don't have any workers yet, so start one. $!general-queue := nqp::create(Queue); - $!general-workers := push-worker( - nqp::create(IterationBuffer), + $!general-workers := first-worker( GeneralWorker.new( queue => $!general-queue, scheduler => self @@ -346,8 +345,7 @@ my class ThreadPoolScheduler does Scheduler { unless $!timer-queue.DEFINITE { # We don't have any workers yet, so start one. $!timer-queue := nqp::create(Queue); - $!timer-workers := push-worker( - nqp::create(IterationBuffer), + $!timer-workers := first-worker( TimerWorker.new( queue => $!timer-queue, scheduler => self @@ -370,8 +368,7 @@ my class ThreadPoolScheduler does Scheduler { if $!affinity-workers.elems == 0 { # We don't have any affinity workers yet, so start one # and return its queue. - $!affinity-workers := push-worker( - nqp::create(IterationBuffer), + $!affinity-workers := first-worker( AffinityWorker.new( scheduler => self ) @@ -435,6 +432,14 @@ my class ThreadPoolScheduler does Scheduler { } } + # Initializing a worker list with a worker, is straightforward and devoid + # of concurrency issues, as we're already in protected code when we do this. + sub first-worker(\first) is raw { + my $workers := nqp::create(IterationBuffer); + nqp::push($workers,first); + $workers + } + # Since the worker lists can be changed during copying, we need to # just take whatever we can get and assume that it may be gone by # the time we get to it. From bfcc43ec9a9c060c793beaccdaff777795e93478 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Wed, 1 Nov 2017 16:19:06 +0100 Subject: [PATCH 642/692] Easify ThreadPoolScheduler creation with initial_threads > 0 --- src/core/ThreadPoolScheduler.pm | 30 +++++++++++++----------------- 1 file changed, 13 insertions(+), 17 deletions(-) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index 2e9ba9f6f02..395eecca594 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -670,25 +670,21 @@ my class ThreadPoolScheduler does Scheduler { if $!initial_threads > 0 { # We've been asked to make some initial threads; we interpret this # as general workers. - self!general-queue(); # Starts one worker - if $!initial_threads > 1 { - my $workers := nqp::create(IterationBuffer); - my int $i = -1; - nqp::while( - nqp::islt_i(($i = nqp::add_i($i,1)),$!initial_threads), - nqp::push( - $workers, - GeneralWorker.new( - queue => $!general-queue, - scheduler => self - ) - ) - ); - $!general-workers := $workers; - } + $!general-queue := nqp::create(Queue); + $!general-workers := nqp::create(IterationBuffer); + nqp::push( + $!general-workers, + GeneralWorker.new( + queue => $!general-queue, + scheduler => self + ) + ) for ^$!initial_threads; + scheduler-debug "Created scheduler with $!initial_threads initial general workers"; + self!maybe-start-supervisor(); } else { - $!general-workers := nqp::create(IterationBuffer); + scheduler-debug "Created scheduler without initial general workers"; + $!general-workers := nqp::create(IterationBuffer); } } From 87e8720202c055ffad8a3e09310c187d260eb5fa Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Wed, 1 Nov 2017 16:31:00 +0100 Subject: [PATCH 643/692] Simplify ThreadPoolScheduler creation a bit further --- src/core/ThreadPoolScheduler.pm | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index 395eecca594..4cb8d656148 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -664,6 +664,7 @@ my class ThreadPoolScheduler does Scheduler { die "Initial thread pool threads ($!initial_threads) must be less than or equal to maximum threads ($!max_threads)" if $!initial_threads > $!max_threads; + $!general-workers := nqp::create(IterationBuffer); $!timer-workers := nqp::create(IterationBuffer); $!affinity-workers := nqp::create(IterationBuffer); @@ -671,7 +672,6 @@ my class ThreadPoolScheduler does Scheduler { # We've been asked to make some initial threads; we interpret this # as general workers. $!general-queue := nqp::create(Queue); - $!general-workers := nqp::create(IterationBuffer); nqp::push( $!general-workers, GeneralWorker.new( @@ -684,7 +684,6 @@ my class ThreadPoolScheduler does Scheduler { } else { scheduler-debug "Created scheduler without initial general workers"; - $!general-workers := nqp::create(IterationBuffer); } } From 5eeb72a9f514dc370104a9a4e59a7787f93fe4aa Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Wed, 1 Nov 2017 17:09:27 +0100 Subject: [PATCH 644/692] Make Range.sum sensible for -Inf/Inf endpoints --- src/core/Range.pm | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/src/core/Range.pm b/src/core/Range.pm index 603a1360057..c26acff6886 100644 --- a/src/core/Range.pm +++ b/src/core/Range.pm @@ -391,7 +391,7 @@ my class Range is Cool does Iterable does Positional { ($from = $!min.floor + $!excludes-min), ($to = $!max.floor - ($!excludes-max && $!max.Int == $!max)) ), - (die "Cannot determine integer bounds") + Failure.new("Cannot determine integer bounds") ) ) } @@ -649,9 +649,15 @@ my class Range is Cool does Iterable does Positional { } method sum() is nodal { - my ($start,$stop) = self.int-bounds || nextsame; - my $elems = 0 max $stop - $start + 1; - ($start + $stop) * $elems div 2; + self.int-bounds(my $start, my $stop) + ?? ($start + $stop) * (0 max $stop - $start + 1) div 2 + !! $!min == -Inf + ?? $!max == Inf + ?? 0 + !! -Inf + !! $!max == Inf + ?? Inf + !! nextsame } method rand() { From 21efe96ffb9d4c2cd9bbffbec116c32d059ae86e Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Wed, 1 Nov 2017 17:17:32 +0100 Subject: [PATCH 645/692] -Inf .. Inf should be NaN, not 0 --- src/core/Range.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/Range.pm b/src/core/Range.pm index c26acff6886..b3f9b5547a0 100644 --- a/src/core/Range.pm +++ b/src/core/Range.pm @@ -653,7 +653,7 @@ my class Range is Cool does Iterable does Positional { ?? ($start + $stop) * (0 max $stop - $start + 1) div 2 !! $!min == -Inf ?? $!max == Inf - ?? 0 + ?? NaN !! -Inf !! $!max == Inf ?? Inf From 9254396270dc29fa3a194b88edd563fd9ea88445 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Wed, 1 Nov 2017 18:01:52 +0100 Subject: [PATCH 646/692] Improve readability of ThreadPoolScheduler --- src/core/ThreadPoolScheduler.pm | 26 ++++++++------------------ 1 file changed, 8 insertions(+), 18 deletions(-) diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index 4cb8d656148..35617c2534e 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -387,7 +387,7 @@ my class ThreadPoolScheduler does Scheduler { my $most-free-worker; my int $i = -1; nqp::while( - nqp::islt_i(($i = nqp::add_i($i,1)),nqp::elems($cur-affinity-workers)), + ++$i < nqp::elems($cur-affinity-workers), nqp::if( $most-free-worker.DEFINITE, nqp::stmts( @@ -581,18 +581,12 @@ my class ThreadPoolScheduler does Scheduler { my int $total-times-nothing-completed; my int $i = -1; nqp::while( - nqp::islt_i(($i = nqp::add_i($i,1)),nqp::elems(worker-list)), + ++$i < nqp::elems(worker-list), nqp::if( (my $worker := nqp::atpos(worker-list,$i)).working, nqp::stmts( - ($total-completed = nqp::add_i( - $total-completed, - $worker.take-completed - )), - ($total-times-nothing-completed = nqp::add_i( - $total-times-nothing-completed, - $worker.times-nothing-completed - )) + ($total-completed += $worker.take-completed), + ($total-times-nothing-completed += $worker.times-nothing-completed) ), return ) @@ -647,13 +641,9 @@ my class ThreadPoolScheduler does Scheduler { } method !total-workers() is raw { - nqp::add_i( - nqp::elems($!general-workers), - nqp::add_i( - nqp::elems($!timer-workers), - nqp::elems($!affinity-workers) - ) - ) + nqp::elems($!general-workers) + + nqp::elems($!timer-workers) + + nqp::elems($!affinity-workers) } submethod BUILD( @@ -781,7 +771,7 @@ my class ThreadPoolScheduler does Scheduler { my int $i = -1; nqp::while( - nqp::islt_i(($i = nqp::add_i($i,1)),nqp::elems($!affinity-workers)), + ++$i < nqp::elems($!affinity-workers), $loads = $loads + nqp::atpos($!affinity-workers,$i).queue.elems ); From a2ae00edefa82aa882e3df871ad23c2dd7869dec Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Wed, 1 Nov 2017 18:04:53 +0100 Subject: [PATCH 647/692] Remove some superfluous code - we don't need to stub Telemetry::Period anymore - now that we have snapper, we're probably going to be doing less with T --- lib/Telemetry.pm6 | 4 ---- 1 file changed, 4 deletions(-) diff --git a/lib/Telemetry.pm6 b/lib/Telemetry.pm6 index b75e419a88b..b46b73fec1b 100644 --- a/lib/Telemetry.pm6 +++ b/lib/Telemetry.pm6 @@ -2,8 +2,6 @@ use nqp; -class Telemetry::Period { ... } - class Telemetry { has int $!cpu-user; has int $!cpu-sys; @@ -364,8 +362,6 @@ multi sub infix:<->(Telemetry:D $a, Telemetry:D $b) is export { ) } -constant T is export = Telemetry; - my @snaps; proto sub snap(|) is export { * } multi sub snap(--> Nil) { @snaps.push(Telemetry.new) } From 86d541f44e7a47379a55e0f31d44bb14391f51eb Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Wed, 1 Nov 2017 19:55:53 +0100 Subject: [PATCH 648/692] Make Telemetry report configurable - both by the column name as well with the method name - add :$legend parameter to add legend of columns shown - show report generation time with whole second granularity --- lib/Telemetry.pm6 | 102 +++++++++++++++++++++++++++++++++++----------- 1 file changed, 79 insertions(+), 23 deletions(-) diff --git a/lib/Telemetry.pm6 b/lib/Telemetry.pm6 index b46b73fec1b..7667cbf6028 100644 --- a/lib/Telemetry.pm6 +++ b/lib/Telemetry.pm6 @@ -388,49 +388,105 @@ multi sub periods() { multi sub periods(@s) { (1..^@s).map: { @s[$_] - @s[$_ - 1] } } proto sub report(|) is export { * } -multi sub report() { +multi sub report(:$legend) { my $s := nqp::clone(nqp::getattr(@snaps,List,'$!reified')); nqp::setelems(nqp::getattr(@snaps,List,'$!reified'),0); nqp::push($s,Telemetry.new) if nqp::elems($s) == 1; - report(nqp::p6bindattrinvres(nqp::create(List),List,'$!reified',$s)); + report( + nqp::p6bindattrinvres(nqp::create(List),List,'$!reified',$s), + :$legend + ); } -multi sub report(@s) { - sub hide0(\value, $size = 3) { value ?? sprintf("%{$size}d",value) !! " " } + +# Convert to spaces if numeric value is 0 +sub hide0(\value, int $size = 3) { + value ?? value.fmt("%{$size}d") !! nqp::x(" ",$size) +} + +# Set up how to handle report generation +my %format = + affinity-workers => + [ " aw", { hide0(.affinity-workers) }, '---', + "The number of affinity threads"], + cpu => + [" cpu", { .cpu.fmt('%8d') }, '--------', + "The amount of CPU used (in microseconds)"], + cpu-user => + ["cpu-user", { .cpu.fmt('%8d') }, '--------', + "The amount of CPU used in user code (in microseconds)"], + cpu-sys => + [" cpu-sys", { .cpu.fmt('%8d') }, '--------', + "The amount of CPU used in system overhead (in microseconds)"], + general-workers => + [ " gw", { hide0(.general-workers) }, '---', + "The number of general worker threads"], + general-tasks-queued => + [ "gtq", { hide0(.general-tasks-queued) }, '---', + "The number of tasks queued for execution in general worker threads"], + general-tasks-completed => + [ " gtc", { hide0(.general-tasks-completed,4) }, '----', + "The number of tasks completed in general worker threads"], + supervisor => + [ "s", { hide0(.supervisor,1) }, '-', + "The number of supervisors"], + timer-workers => + [ " tw", { hide0(.timer-workers) }, '---', + "The number of timer threads"], + timer-tasks-queued => + [ "ttq", { hide0(.timer-tasks-queued) }, '---', + "The number of tasks queued for execution in timer threads"], + timer-tasks-completed => + [ "ttc", { hide0(.timer-tasks-completed) }, '---', + "The number of tasks completed in timer threads"], + utilization => + [ " util%", { .utilization.fmt('%6.2f') }, '------', + "Percentage of CPU utilization (0..100%)"], + wallclock => + [" wall", { .wallclock.fmt('%8d') }, '--------', + "Number of microseconds elapsed"], +; + +# Make sure we can also use the header key as an indicator +for %format.kv -> \k, \v { + %format{v[0].trim} = v +} + +multi sub report( + @s, + @cols = , + :$legend, +) { my $total = @s[*-1] - @s[0]; my $text := nqp::list_s(qq:to/HEADER/.chomp); -Telemetry Report of Process #$*PID ($*INIT-INSTANT.DateTime()) +Telemetry Report of Process #$*PID ({Instant.from-posix(nqp::time_i).DateTime}) Number of Snapshots: {+@s} Total Time: { ($total.wallclock / 1000000).fmt("%9.2f") } seconds Total CPU Usage: { ($total.cpu / 1000000).fmt("%9.2f") } seconds - wall util% sv gd gtq gtc td ttq at HEADER - sub push-period($_) { + nqp::push_s($text,%format{@cols}>>.[0].join(" ")); + + sub push-period($period) { nqp::push_s($text, - sprintf('%8d %6.2f %s %s %s %s %s %s %s', - .wallclock, - .utilization, - hide0(.supervisor), - hide0(.general-workers), - hide0(.general-tasks-queued), - hide0(.general-tasks-completed,4), - hide0(.timer-workers), - hide0(.timer-tasks-queued), - hide0(.affinity-workers) - ).trim-trailing - ); + %format{@cols}>>.[1]>>.($period).join(" ").trim-trailing); } push-period($_) for periods(@s); - nqp::push_s($text, qq:to/FOOTER/.chomp); --------- ------ --- --- --- ---- --- --- --- -FOOTER + nqp::push_s($text,%format{@cols}>>.[2].join(" ")); push-period($total); - + + if $legend { + nqp::push_s($text,""); + nqp::push_s($text,"Legend:"); + for %format{@cols} -> $col { + nqp::push_s($text," $col[0].trim-leading.fmt('%5s') $col[3]"); + } + } + nqp::join("\n",$text) } From 474feb0933291df5fc0df61f01c7ea82b28f221e Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Wed, 1 Nov 2017 20:12:00 +0100 Subject: [PATCH 649/692] Add :header-repeat = 32 parameter to Telemetry report --- lib/Telemetry.pm6 | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) diff --git a/lib/Telemetry.pm6 b/lib/Telemetry.pm6 index 7667cbf6028..8b95d32eeef 100644 --- a/lib/Telemetry.pm6 +++ b/lib/Telemetry.pm6 @@ -388,13 +388,14 @@ multi sub periods() { multi sub periods(@s) { (1..^@s).map: { @s[$_] - @s[$_ - 1] } } proto sub report(|) is export { * } -multi sub report(:$legend) { +multi sub report(:$legend, :$header-repeat = 32) { my $s := nqp::clone(nqp::getattr(@snaps,List,'$!reified')); nqp::setelems(nqp::getattr(@snaps,List,'$!reified'),0); nqp::push($s,Telemetry.new) if nqp::elems($s) == 1; report( nqp::p6bindattrinvres(nqp::create(List),List,'$!reified',$s), - :$legend + :$legend, + :$header-repeat, ); } @@ -455,6 +456,7 @@ multi sub report( @s, @cols = , :$legend, + :$header-repeat = 32, ) { my $total = @s[*-1] - @s[0]; @@ -463,17 +465,20 @@ Telemetry Report of Process #$*PID ({Instant.from-posix(nqp::time_i).DateTime}) Number of Snapshots: {+@s} Total Time: { ($total.wallclock / 1000000).fmt("%9.2f") } seconds Total CPU Usage: { ($total.cpu / 1000000).fmt("%9.2f") } seconds - HEADER - nqp::push_s($text,%format{@cols}>>.[0].join(" ")); - sub push-period($period) { nqp::push_s($text, %format{@cols}>>.[1]>>.($period).join(" ").trim-trailing); } - push-period($_) for periods(@s); + my $header = "\n%format{@cols}>>.[0].join(" ")"; + nqp::push_s($text,$header) unless $header-repeat; + + for periods(@s).kv -> $index, $period { + nqp::push_s($text,$header) if $index %% $header-repeat; + push-period($period) + } nqp::push_s($text,%format{@cols}>>.[2].join(" ")); From 5e7dfe52fd6cfa4b3b24ecd87cbabc1ccafa48bc Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Wed, 1 Nov 2017 20:22:37 +0100 Subject: [PATCH 650/692] Further Telemetry tweaks: - format initialization only needs values - remove from default columns - they're really only for deep debugging - change some double quotes strings to single quoted (for clarity) - make sure no header-repeat doesn't explode --- lib/Telemetry.pm6 | 23 ++++++++++++----------- 1 file changed, 12 insertions(+), 11 deletions(-) diff --git a/lib/Telemetry.pm6 b/lib/Telemetry.pm6 index 8b95d32eeef..f8b65c40fb5 100644 --- a/lib/Telemetry.pm6 +++ b/lib/Telemetry.pm6 @@ -443,18 +443,18 @@ my %format = [ " util%", { .utilization.fmt('%6.2f') }, '------', "Percentage of CPU utilization (0..100%)"], wallclock => - [" wall", { .wallclock.fmt('%8d') }, '--------', + ["wallclock", { .wallclock.fmt('%9d') }, '---------', "Number of microseconds elapsed"], ; # Make sure we can also use the header key as an indicator -for %format.kv -> \k, \v { +for %format.values -> \v { %format{v[0].trim} = v } multi sub report( @s, - @cols = , + @cols = , :$legend, :$header-repeat = 32, ) { @@ -463,30 +463,31 @@ multi sub report( my $text := nqp::list_s(qq:to/HEADER/.chomp); Telemetry Report of Process #$*PID ({Instant.from-posix(nqp::time_i).DateTime}) Number of Snapshots: {+@s} -Total Time: { ($total.wallclock / 1000000).fmt("%9.2f") } seconds -Total CPU Usage: { ($total.cpu / 1000000).fmt("%9.2f") } seconds +Total Time: { ($total.wallclock / 1000000).fmt('%9.2f') } seconds +Total CPU Usage: { ($total.cpu / 1000000).fmt('%9.2f') } seconds HEADER sub push-period($period) { nqp::push_s($text, - %format{@cols}>>.[1]>>.($period).join(" ").trim-trailing); + %format{@cols}>>.[1]>>.($period).join(' ').trim-trailing); } - my $header = "\n%format{@cols}>>.[0].join(" ")"; + my $header = "\n%format{@cols}>>.[0].join(' ')"; nqp::push_s($text,$header) unless $header-repeat; for periods(@s).kv -> $index, $period { - nqp::push_s($text,$header) if $index %% $header-repeat; + nqp::push_s($text,$header) + if $header-repeat && $index %% $header-repeat; push-period($period) } - nqp::push_s($text,%format{@cols}>>.[2].join(" ")); + nqp::push_s($text,%format{@cols}>>.[2].join(' ')); push-period($total); if $legend { - nqp::push_s($text,""); - nqp::push_s($text,"Legend:"); + nqp::push_s($text,''); + nqp::push_s($text,'Legend:'); for %format{@cols} -> $col { nqp::push_s($text," $col[0].trim-leading.fmt('%5s') $col[3]"); } From 3b4f0c6ceb20e4f272275daffd29cdfbfcb31caa Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Wed, 1 Nov 2017 21:58:27 +0100 Subject: [PATCH 651/692] More Telemetry additions - support for max-rss and ix-rss, add max-rss to default report - .gist/.Str no longer special case an empty Telemetry / Period - only decont a/b once in infix:<-> - auto-calculate width of "-" footer for a column --- lib/Telemetry.pm6 | 182 ++++++++++++++++++++++++++++++---------------- 1 file changed, 119 insertions(+), 63 deletions(-) diff --git a/lib/Telemetry.pm6 b/lib/Telemetry.pm6 index f8b65c40fb5..b43c58e5f5f 100644 --- a/lib/Telemetry.pm6 +++ b/lib/Telemetry.pm6 @@ -5,6 +5,8 @@ use nqp; class Telemetry { has int $!cpu-user; has int $!cpu-sys; + has int $!max-rss; + has int $!ix-rss; has int $!wallclock; has int $!supervisor; has int $!general-workers; @@ -34,12 +36,22 @@ class Telemetry { $completed } + constant UTIME_SEC = 0; + constant UTIME_MSEC = 1; + constant STIME_SEC = 2; + constant STIME_MSEC = 3; + constant MAX_RSS = 4; + constant IX_RSS = 5; + submethod BUILD() { my \rusage = nqp::getrusage; - $!cpu-user = nqp::atpos_i(rusage,nqp::const::RUSAGE_UTIME_SEC) * 1000000 - + nqp::atpos_i(rusage, nqp::const::RUSAGE_UTIME_MSEC); - $!cpu-sys = nqp::atpos_i(rusage,nqp::const::RUSAGE_STIME_SEC) * 1000000 - + nqp::atpos_i(rusage, nqp::const::RUSAGE_STIME_MSEC); + $!cpu-user = nqp::atpos_i(rusage,UTIME_SEC) * 1000000 + + nqp::atpos_i(rusage,UTIME_MSEC); + $!cpu-sys = nqp::atpos_i(rusage,STIME_SEC) * 1000000 + + nqp::atpos_i(rusage,STIME_MSEC); + $!max-rss = nqp::atpos_i(rusage,MAX_RSS); + $!ix-rss = nqp::atpos_i(rusage,IX_RSS); + $!wallclock = nqp::fromnum_I(1000000 * nqp::sub_n(nqp::time_n,$start),Int); @@ -75,10 +87,10 @@ class Telemetry { proto method cpu() { * } multi method cpu(Telemetry:U:) is raw { my \rusage = nqp::getrusage; - nqp::atpos_i(rusage, nqp::const::RUSAGE_UTIME_SEC) * 1000000 - + nqp::atpos_i(rusage, nqp::const::RUSAGE_UTIME_MSEC) - + nqp::atpos_i(rusage, nqp::const::RUSAGE_STIME_SEC) * 1000000 - + nqp::atpos_i(rusage, nqp::const::RUSAGE_STIME_MSEC) + nqp::atpos_i(rusage,UTIME_SEC) * 1000000 + + nqp::atpos_i(rusage,UTIME_MSEC) + + nqp::atpos_i(rusage,STIME_SEC) * 1000000 + + nqp::atpos_i(rusage,STIME_MSEC) } multi method cpu(Telemetry:D:) is raw { nqp::add_i($!cpu-user,$!cpu-sys) @@ -87,19 +99,31 @@ class Telemetry { proto method cpu-user() { * } multi method cpu-user(Telemetry:U:) is raw { my \rusage = nqp::getrusage; - nqp::atpos_i(rusage, nqp::const::RUSAGE_UTIME_SEC) * 1000000 - + nqp::atpos_i(rusage, nqp::const::RUSAGE_UTIME_MSEC) + nqp::atpos_i(rusage,UTIME_SEC) * 1000000 + + nqp::atpos_i(rusage,UTIME_MSEC) } multi method cpu-user(Telemetry:D:) is raw { $!cpu-user } proto method cpu-sys() { * } multi method cpu-sys(Telemetry:U:) is raw { my \rusage = nqp::getrusage; - nqp::atpos_i(rusage, nqp::const::RUSAGE_STIME_SEC) * 1000000 - + nqp::atpos_i(rusage, nqp::const::RUSAGE_STIME_MSEC) + nqp::atpos_i(rusage,STIME_SEC) * 1000000 + + nqp::atpos_i(rusage,STIME_MSEC) } multi method cpu-sys(Telemetry:D:) is raw { $!cpu-sys } + proto method max-rss() { * } + multi method max-rss(Telemetry:U:) is raw { + nqp::atpos_i(nqp::getrusage,MAX_RSS) + } + multi method max-rss(Telemetry:D:) is raw { $!max-rss } + + proto method ix-rss() { * } + multi method ix-rss(Telemetry:U:) is raw { + nqp::atpos_i(nqp::getrusage,IX_RSS) + } + multi method ix-rss(Telemetry:D:) is raw { $!ix-rss } + proto method wallclock() { * } multi method wallclock(Telemetry:U:) is raw { nqp::fromnum_I(1000000 * nqp::sub_n(nqp::time_n,$start),Int) @@ -204,10 +228,10 @@ class Telemetry { multi method affinity-workers(Telemetry:D:) { $!affinity-workers } multi method Str(Telemetry:D:) { - $!wallclock ?? "$.cpu / $!wallclock" !! "cpu / wallclock" + "$.cpu / $!wallclock" } multi method gist(Telemetry:D:) { - $!wallclock ?? "$.cpu / $!wallclock" !! "cpu / wallclock" + "$.cpu / $!wallclock" } } @@ -215,6 +239,8 @@ class Telemetry::Period is Telemetry { multi method new(Telemetry::Period: int :$cpu-user, int :$cpu-sys, + int :$max-rss, + int :$ix-rss, int :$wallclock, int :$supervisor, int :$general-workers, @@ -226,7 +252,9 @@ class Telemetry::Period is Telemetry { int :$affinity-workers, ) { self.new( - $cpu-user, $cpu-sys, $wallclock, $supervisor, + $cpu-user, $cpu-sys, + $max-rss, $ix-rss, + $wallclock, $supervisor, $general-workers, $general-tasks-queued, $general-tasks-completed, $timer-workers, $timer-tasks-queued, $timer-tasks-completed, $affinity-workers @@ -235,6 +263,8 @@ class Telemetry::Period is Telemetry { multi method new(Telemetry::Period: int $cpu-user, int $cpu-sys, + int $max-rss, + int $ix-rss, int $wallclock, int $supervisor, int $general-workers, @@ -250,6 +280,10 @@ class Telemetry::Period is Telemetry { '$!cpu-user', $cpu-user); nqp::bindattr_i($period,Telemetry, '$!cpu-sys', $cpu-sys); + nqp::bindattr_i($period,Telemetry, + '$!max-rss', $max-rss); + nqp::bindattr_i($period,Telemetry, + '$!ix-rss', $ix-rss); nqp::bindattr_i($period,Telemetry, '$!wallclock', $wallclock); nqp::bindattr_i($period,Telemetry, @@ -276,6 +310,10 @@ class Telemetry::Period is Telemetry { nqp::getattr_i(self,Telemetry,'$!cpu-user') }), :cpu-sys({ nqp::getattr_i(self,Telemetry,'$!cpu-sys') + }), :max-rss({ + nqp::getattr_i(self,Telemetry,'$!max-rss') + }), :ix-rss({ + nqp::getattr_i(self,Telemetry,'$!ix-rss') }), :wallclock({ nqp::getattr_i(self,Telemetry,'$!wallclock') }), :supervisor({ @@ -308,56 +346,67 @@ class Telemetry::Period is Telemetry { method utilization() { $factor * self.cpus } } -multi sub infix:<->(Telemetry:U $a, Telemetry:U $b) is export { - Telemetry::Period.new(0,0,0) +multi sub infix:<->(Telemetry:U \a, Telemetry:U \b) is export { + nqp::create(Telemetry::Period) } -multi sub infix:<->(Telemetry:D $a, Telemetry:U $b) is export { $a - $b.new } -multi sub infix:<->(Telemetry:U $a, Telemetry:D $b) is export { $a.new - $b } -multi sub infix:<->(Telemetry:D $a, Telemetry:D $b) is export { +multi sub infix:<->(Telemetry:D \a, Telemetry:U \b) is export { a - b.new } +multi sub infix:<->(Telemetry:U \a, Telemetry:D \b) is export { a.new - b } +multi sub infix:<->(Telemetry:D \a, Telemetry:D \b) is export { + my $a := nqp::decont(a); + my $b := nqp::decont(b); + Telemetry::Period.new( nqp::sub_i( - nqp::getattr_i(nqp::decont($a),Telemetry,'$!cpu-user'), - nqp::getattr_i(nqp::decont($b),Telemetry,'$!cpu-user') + nqp::getattr_i($a,Telemetry,'$!cpu-user'), + nqp::getattr_i($b,Telemetry,'$!cpu-user') + ), + nqp::sub_i( + nqp::getattr_i($a,Telemetry,'$!cpu-sys'), + nqp::getattr_i($b,Telemetry,'$!cpu-sys') + ), + nqp::sub_i( + nqp::getattr_i($a,Telemetry,'$!max-rss'), + nqp::getattr_i($b,Telemetry,'$!max-rss') ), nqp::sub_i( - nqp::getattr_i(nqp::decont($a),Telemetry,'$!cpu-sys'), - nqp::getattr_i(nqp::decont($b),Telemetry,'$!cpu-sys') + nqp::getattr_i($a,Telemetry,'$!ix-rss'), + nqp::getattr_i($b,Telemetry,'$!ix-rss') ), nqp::sub_i( - nqp::getattr_i(nqp::decont($a),Telemetry,'$!wallclock'), - nqp::getattr_i(nqp::decont($b),Telemetry,'$!wallclock') + nqp::getattr_i($a,Telemetry,'$!wallclock'), + nqp::getattr_i($b,Telemetry,'$!wallclock') ), nqp::sub_i( - nqp::getattr_i(nqp::decont($a),Telemetry,'$!supervisor'), - nqp::getattr_i(nqp::decont($b),Telemetry,'$!supervisor') + nqp::getattr_i($a,Telemetry,'$!supervisor'), + nqp::getattr_i($b,Telemetry,'$!supervisor') ), nqp::sub_i( - nqp::getattr_i(nqp::decont($a),Telemetry,'$!general-workers'), - nqp::getattr_i(nqp::decont($b),Telemetry,'$!general-workers') + nqp::getattr_i($a,Telemetry,'$!general-workers'), + nqp::getattr_i($b,Telemetry,'$!general-workers') ), nqp::sub_i( - nqp::getattr_i(nqp::decont($a),Telemetry,'$!general-tasks-queued'), - nqp::getattr_i(nqp::decont($b),Telemetry,'$!general-tasks-queued') + nqp::getattr_i($a,Telemetry,'$!general-tasks-queued'), + nqp::getattr_i($b,Telemetry,'$!general-tasks-queued') ), nqp::sub_i( - nqp::getattr_i(nqp::decont($a),Telemetry,'$!general-tasks-completed'), - nqp::getattr_i(nqp::decont($b),Telemetry,'$!general-tasks-completed') + nqp::getattr_i($a,Telemetry,'$!general-tasks-completed'), + nqp::getattr_i($b,Telemetry,'$!general-tasks-completed') ), nqp::sub_i( - nqp::getattr_i(nqp::decont($a),Telemetry,'$!timer-workers'), - nqp::getattr_i(nqp::decont($b),Telemetry,'$!timer-workers') + nqp::getattr_i($a,Telemetry,'$!timer-workers'), + nqp::getattr_i($b,Telemetry,'$!timer-workers') ), nqp::sub_i( - nqp::getattr_i(nqp::decont($a),Telemetry,'$!timer-tasks-queued'), - nqp::getattr_i(nqp::decont($b),Telemetry,'$!timer-tasks-queued') + nqp::getattr_i($a,Telemetry,'$!timer-tasks-queued'), + nqp::getattr_i($b,Telemetry,'$!timer-tasks-queued') ), nqp::sub_i( - nqp::getattr_i(nqp::decont($a),Telemetry,'$!timer-tasks-completed'), - nqp::getattr_i(nqp::decont($b),Telemetry,'$!timer-tasks-completed') + nqp::getattr_i($a,Telemetry,'$!timer-tasks-completed'), + nqp::getattr_i($b,Telemetry,'$!timer-tasks-completed') ), nqp::sub_i( - nqp::getattr_i(nqp::decont($a),Telemetry,'$!affinity-workers'), - nqp::getattr_i(nqp::decont($b),Telemetry,'$!affinity-workers') + nqp::getattr_i($a,Telemetry,'$!affinity-workers'), + nqp::getattr_i($b,Telemetry,'$!affinity-workers') ) ) } @@ -407,54 +456,61 @@ sub hide0(\value, int $size = 3) { # Set up how to handle report generation my %format = affinity-workers => - [ " aw", { hide0(.affinity-workers) }, '---', + [ " aw", { hide0(.affinity-workers) }, "The number of affinity threads"], - cpu => - [" cpu", { .cpu.fmt('%8d') }, '--------', + cpu => + [" cpu", { .cpu.fmt('%8d') }, "The amount of CPU used (in microseconds)"], - cpu-user => - ["cpu-user", { .cpu.fmt('%8d') }, '--------', + cpu-user => + ["cpu-user", { .cpu.fmt('%8d') }, "The amount of CPU used in user code (in microseconds)"], - cpu-sys => - [" cpu-sys", { .cpu.fmt('%8d') }, '--------', + cpu-sys => + [" cpu-sys", { .cpu.fmt('%8d') }, "The amount of CPU used in system overhead (in microseconds)"], general-workers => - [ " gw", { hide0(.general-workers) }, '---', + [ " gw", { hide0(.general-workers) }, "The number of general worker threads"], general-tasks-queued => - [ "gtq", { hide0(.general-tasks-queued) }, '---', + [ "gtq", { hide0(.general-tasks-queued) }, "The number of tasks queued for execution in general worker threads"], general-tasks-completed => - [ " gtc", { hide0(.general-tasks-completed,4) }, '----', + [ " gtc", { hide0(.general-tasks-completed,4) }, "The number of tasks completed in general worker threads"], + ix-rss => + [" ix-rss", { hide0(.ix-rss,10) }, + "Integral shared text memory size (in bytes)"], + max-rss => + [" max-rss", { .max-rss.fmt('%10d') }, + "Maximum resident set size (in bytes)"], supervisor => - [ "s", { hide0(.supervisor,1) }, '-', + [ "s", { hide0(.supervisor,1) }, "The number of supervisors"], timer-workers => - [ " tw", { hide0(.timer-workers) }, '---', + [ " tw", { hide0(.timer-workers) }, "The number of timer threads"], timer-tasks-queued => - [ "ttq", { hide0(.timer-tasks-queued) }, '---', + [ "ttq", { hide0(.timer-tasks-queued) }, "The number of tasks queued for execution in timer threads"], timer-tasks-completed => - [ "ttc", { hide0(.timer-tasks-completed) }, '---', + [ "ttc", { hide0(.timer-tasks-completed) }, "The number of tasks completed in timer threads"], utilization => - [ " util%", { .utilization.fmt('%6.2f') }, '------', + [ " util%", { .utilization.fmt('%6.2f') }, "Percentage of CPU utilization (0..100%)"], wallclock => - ["wallclock", { .wallclock.fmt('%9d') }, '---------', + ["wallclock", { .wallclock.fmt('%9d') }, "Number of microseconds elapsed"], ; -# Make sure we can also use the header key as an indicator +# Set footer and make sure we can also use the header key as an indicator for %format.values -> \v { - %format{v[0].trim} = v + v[3] = '-' x v[0].chars; + %format{v[0].trim} = v; } multi sub report( @s, - @cols = , + @cols = , :$legend, :$header-repeat = 32, ) { @@ -481,7 +537,7 @@ HEADER push-period($period) } - nqp::push_s($text,%format{@cols}>>.[2].join(' ')); + nqp::push_s($text,%format{@cols}>>.[3].join(' ')); push-period($total); @@ -489,7 +545,7 @@ HEADER nqp::push_s($text,''); nqp::push_s($text,'Legend:'); for %format{@cols} -> $col { - nqp::push_s($text," $col[0].trim-leading.fmt('%5s') $col[3]"); + nqp::push_s($text," $col[0].trim-leading.fmt('%5s') $col[2]"); } } From ac738b988e7c2a0c9660add89df9e157208e5a34 Mon Sep 17 00:00:00 2001 From: usev6 Date: Wed, 1 Nov 2017 22:43:15 +0100 Subject: [PATCH 652/692] [jvm] Don't run test files that hang regularly --- t/spectest.data | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/t/spectest.data b/t/spectest.data index 0c79d5ff9d3..8264ff8b83e 100644 --- a/t/spectest.data +++ b/t/spectest.data @@ -543,9 +543,9 @@ S06-traits/precedence.t S07-slip/slip.t S07-iterators/range-iterator.t S07-hyperrace/for.t -S07-hyperrace/hyper.t -S07-hyperrace/race.t -S07-hyperrace/stress.t # stress +S07-hyperrace/hyper.t # moar +S07-hyperrace/race.t # moar +S07-hyperrace/stress.t # moar stress S06-traits/slurpy-is-rw.t S09-autovivification/autoincrement.t S09-autovivification/autovivification.t From 7144dc290c483c2130b681868902a5fcbc57eb0e Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Wed, 1 Nov 2017 22:51:10 +0100 Subject: [PATCH 653/692] Still more Telemetry goodies - export all of the metrics as subs - so calling "max-rss" will give you the current max-rss value - added some internal documentation for clarity - removed protos for methods, as we don't need them outside the setting - multiple calls to snapper() now allow changing of period size on-the-fly --- lib/Telemetry.pm6 | 318 +++++++++++++++++++++++++--------------------- 1 file changed, 176 insertions(+), 142 deletions(-) diff --git a/lib/Telemetry.pm6 b/lib/Telemetry.pm6 index b43c58e5f5f..8d2d9582c2f 100644 --- a/lib/Telemetry.pm6 +++ b/lib/Telemetry.pm6 @@ -2,6 +2,135 @@ use nqp; +# Constants indexing into the nqp::getrusage array ----------------------------- +constant UTIME_SEC = 0; +constant UTIME_MSEC = 1; +constant STIME_SEC = 2; +constant STIME_MSEC = 3; +constant MAX_RSS = 4; +constant IX_RSS = 5; + +# Helper stuff ----------------------------------------------------------------- +my num $start = Rakudo::Internals.INITTIME; + +sub completed(\workers) is raw { + my int $elems = nqp::elems(workers); + my int $completed; + my int $i = -1; + nqp::while( + nqp::islt_i(($i = nqp::add_i($i,1)),$elems), + nqp::stmts( + (my $w := nqp::atpos(workers,$i)), + ($completed = nqp::add_i( + $completed, + nqp::getattr_i($w,$w.WHAT,'$!total') + )) + ) + ); + $completed +} + +# Subroutines that are exported with :COLUMNS ---------------------------------- +sub cpu() is raw is export(:COLUMNS) { + my \rusage = nqp::getrusage; + nqp::atpos_i(rusage,UTIME_SEC) * 1000000 + + nqp::atpos_i(rusage,UTIME_MSEC) + + nqp::atpos_i(rusage,STIME_SEC) * 1000000 + + nqp::atpos_i(rusage,STIME_MSEC) +} + +sub cpu-user() is raw is export(:COLUMNS) { + my \rusage = nqp::getrusage; + nqp::atpos_i(rusage,UTIME_SEC) * 1000000 + nqp::atpos_i(rusage,UTIME_MSEC) +} + +sub cpu-sys() is raw is export(:COLUMNS) { + my \rusage = nqp::getrusage; + nqp::atpos_i(rusage,STIME_SEC) * 1000000 + nqp::atpos_i(rusage,STIME_MSEC) +} + +sub max-rss() is raw is export(:COLUMNS) { + nqp::atpos_i(nqp::getrusage,MAX_RSS) +} + +sub ix-rss() is raw is export(:COLUMNS) { + nqp::atpos_i(nqp::getrusage,IX_RSS) +} + +sub wallclock() is raw is export(:COLUMNS) { + nqp::fromnum_I(1000000 * nqp::sub_n(nqp::time_n,$start),Int) +} + +sub supervisor() is raw is export(:COLUMNS) { + nqp::istrue( + nqp::getattr(nqp::decont($*SCHEDULER),ThreadPoolScheduler,'$!supervisor') + ) +} + +sub general-workers() is raw is export(:COLUMNS) { + nqp::if( + nqp::istrue((my $workers := nqp::getattr( + nqp::decont($*SCHEDULER),ThreadPoolScheduler,'$!general-workers' + ))), + nqp::elems($workers) + ) +} + +sub general-tasks-queued() is raw is export(:COLUMNS) { + nqp::if( + nqp::istrue((my $queue := nqp::getattr( + nqp::decont($*SCHEDULER),ThreadPoolScheduler,'$!general-queue' + ))), + nqp::elems($queue) + ) +} + +sub general-tasks-completed() is raw is export(:COLUMNS) { + nqp::if( + nqp::istrue((my $workers := nqp::getattr( + nqp::decont($*SCHEDULER),ThreadPoolScheduler,'$!general-workers' + ))), + completed($workers) + ) +} + +sub timer-workers() is raw is export(:COLUMNS) { + nqp::if( + nqp::istrue((my $workers := nqp::getattr( + nqp::decont($*SCHEDULER),ThreadPoolScheduler,'$!timer-workers' + ))), + nqp::elems($workers) + ) +} + +sub timer-tasks-queued() is raw is export(:COLUMNS) { + nqp::if( + nqp::istrue((my $queue := nqp::getattr( + nqp::decont($*SCHEDULER),ThreadPoolScheduler,'$!timer-queue' + ))), + nqp::elems($queue) + ) +} + +sub timer-tasks-completed() is raw is export(:COLUMNS) { + nqp::if( + nqp::istrue((my $workers := nqp::getattr( + nqp::decont($*SCHEDULER),ThreadPoolScheduler,'$!timer-workers' + ))), + completed($workers) + ) +} + +sub affinity-workers() is raw is export(:COLUMNS) { + nqp::if( + nqp::istrue((my $workers := nqp::getattr( + nqp::decont($*SCHEDULER),ThreadPoolScheduler,'$!affinity-workers' + ))), + nqp::elems($workers) + ) +} + +# Telemetry -------------------------------------------------------------------- class Telemetry { has int $!cpu-user; has int $!cpu-sys; @@ -17,32 +146,6 @@ class Telemetry { has int $!timer-tasks-completed; has int $!affinity-workers; - my num $start = Rakudo::Internals.INITTIME; - - sub completed(\workers) is raw { - my int $elems = nqp::elems(workers); - my int $completed; - my int $i = -1; - nqp::while( - nqp::islt_i(($i = nqp::add_i($i,1)),$elems), - nqp::stmts( - (my $w := nqp::atpos(workers,$i)), - ($completed = nqp::add_i( - $completed, - nqp::getattr_i($w,$w.WHAT,'$!total') - )) - ) - ); - $completed - } - - constant UTIME_SEC = 0; - constant UTIME_MSEC = 1; - constant STIME_SEC = 2; - constant STIME_MSEC = 3; - constant MAX_RSS = 4; - constant IX_RSS = 5; - submethod BUILD() { my \rusage = nqp::getrusage; $!cpu-user = nqp::atpos_i(rusage,UTIME_SEC) * 1000000 @@ -84,147 +187,62 @@ class Telemetry { } - proto method cpu() { * } - multi method cpu(Telemetry:U:) is raw { - my \rusage = nqp::getrusage; - nqp::atpos_i(rusage,UTIME_SEC) * 1000000 - + nqp::atpos_i(rusage,UTIME_MSEC) - + nqp::atpos_i(rusage,STIME_SEC) * 1000000 - + nqp::atpos_i(rusage,STIME_MSEC) - } - multi method cpu(Telemetry:D:) is raw { - nqp::add_i($!cpu-user,$!cpu-sys) - } + multi method cpu(Telemetry:U:) is raw { cpu } + multi method cpu(Telemetry:D:) is raw { nqp::add_i($!cpu-user,$!cpu-sys) } - proto method cpu-user() { * } - multi method cpu-user(Telemetry:U:) is raw { - my \rusage = nqp::getrusage; - nqp::atpos_i(rusage,UTIME_SEC) * 1000000 - + nqp::atpos_i(rusage,UTIME_MSEC) - } + multi method cpu-user(Telemetry:U:) is raw { cpu-user } multi method cpu-user(Telemetry:D:) is raw { $!cpu-user } - proto method cpu-sys() { * } - multi method cpu-sys(Telemetry:U:) is raw { - my \rusage = nqp::getrusage; - nqp::atpos_i(rusage,STIME_SEC) * 1000000 - + nqp::atpos_i(rusage,STIME_MSEC) - } + multi method cpu-sys(Telemetry:U:) is raw { cpu-sys } multi method cpu-sys(Telemetry:D:) is raw { $!cpu-sys } - proto method max-rss() { * } - multi method max-rss(Telemetry:U:) is raw { - nqp::atpos_i(nqp::getrusage,MAX_RSS) - } + multi method max-rss(Telemetry:U:) is raw { max-rss } multi method max-rss(Telemetry:D:) is raw { $!max-rss } - proto method ix-rss() { * } - multi method ix-rss(Telemetry:U:) is raw { - nqp::atpos_i(nqp::getrusage,IX_RSS) - } + multi method ix-rss(Telemetry:U:) is raw { ix-rss } multi method ix-rss(Telemetry:D:) is raw { $!ix-rss } - proto method wallclock() { * } - multi method wallclock(Telemetry:U:) is raw { - nqp::fromnum_I(1000000 * nqp::sub_n(nqp::time_n,$start),Int) - } + multi method wallclock(Telemetry:U:) is raw { wallclock } multi method wallclock(Telemetry:D:) is raw { $!wallclock } - proto method supervisor() { * } - multi method supervisor(Telemetry:U:) { - nqp::istrue( - nqp::getattr( - nqp::decont($*SCHEDULER),ThreadPoolScheduler,'$!supervisor' - ) - ) - } - multi method supervisor(Telemetry:D:) { - $!supervisor - } + multi method supervisor(Telemetry:U:) is raw { supervisor } + multi method supervisor(Telemetry:D:) is raw { $!supervisor } - proto method general-workers() { * } - multi method general-workers(Telemetry:U:) { - nqp::if( - nqp::istrue((my $workers := nqp::getattr( - nqp::decont($*SCHEDULER),ThreadPoolScheduler,'$!general-workers' - ))), - nqp::elems($workers) - ) - } - multi method general-workers(Telemetry:D:) { - $!general-workers - } + multi method general-workers(Telemetry:U:) is raw { general-workers } + multi method general-workers(Telemetry:D:) is raw { $!general-workers } - proto method general-tasks-queued() { * } - multi method general-tasks-queued(Telemetry:U:) { - nqp::if( - nqp::istrue((my $queue := nqp::getattr( - nqp::decont($*SCHEDULER),ThreadPoolScheduler,'$!general-queue' - ))), - nqp::elems($queue) - ) + multi method general-tasks-queued(Telemetry:U:) is raw { + general-tasks-queued } - multi method general-tasks-queued(Telemetry:D:) { + multi method general-tasks-queued(Telemetry:D:) is raw { $!general-tasks-queued } - proto method general-tasks-completed() { * } - multi method general-tasks-completed(Telemetry:U:) { - nqp::if( - nqp::istrue((my $workers := nqp::getattr( - nqp::decont($*SCHEDULER),ThreadPoolScheduler,'$!general-workers' - ))), - completed($workers) - ) + multi method general-tasks-completed(Telemetry:U:) is raw { + general-tasks-completed } - multi method general-tasks-completed(Telemetry:D:) { + multi method general-tasks-completed(Telemetry:D:) is raw { $!general-tasks-completed } - proto method timer-workers() { * } - multi method timer-workers(Telemetry:U:) { - nqp::if( - nqp::istrue((my $workers := nqp::getattr( - nqp::decont($*SCHEDULER),ThreadPoolScheduler,'$!timer-workers' - ))), - nqp::elems($workers) - ) + multi method timer-workers(Telemetry:U:) is raw { timer-workers } + multi method timer-workers(Telemetry:D:) is raw { $!timer-workers } + + multi method timer-tasks-queued(Telemetry:U:) is raw { + timer-tasks-queued } - multi method timer-workers(Telemetry:D:) { $!timer-workers } - - proto method timer-tasks-queued() { * } - multi method timer-tasks-queued(Telemetry:U:) { - nqp::if( - nqp::istrue((my $queue := nqp::getattr( - nqp::decont($*SCHEDULER),ThreadPoolScheduler,'$!timer-queue' - ))), - nqp::elems($queue) - ) + multi method timer-tasks-queued(Telemetry:D:) is raw { + $!timer-tasks-queued } - multi method timer-tasks-queued(Telemetry:D:) { $!timer-tasks-queued } - - proto method timer-tasks-completed() { * } - multi method timer-tasks-completed(Telemetry:U:) { - nqp::if( - nqp::istrue((my $workers := nqp::getattr( - nqp::decont($*SCHEDULER),ThreadPoolScheduler,'$!timer-workers' - ))), - completed($workers) - ) + + multi method timer-tasks-completed(Telemetry:U:) is raw { + timer-tasks-completed } - multi method timer-tasks-completed(Telemetry:D:) { + multi method timer-tasks-completed(Telemetry:D:) is raw { $!timer-tasks-completed } - proto method affinity-workers() { * } - multi method affinity-workers(Telemetry:U:) { - nqp::if( - nqp::istrue((my $workers := nqp::getattr( - nqp::decont($*SCHEDULER),ThreadPoolScheduler,'$!affinity-workers' - ))), - nqp::elems($workers) - ) - } + multi method affinity-workers(Telemetry:U:) { affinity-workers } multi method affinity-workers(Telemetry:D:) { $!affinity-workers } multi method Str(Telemetry:D:) { @@ -235,7 +253,10 @@ class Telemetry { } } +# Telemetry::Period ------------------------------------------------------------ class Telemetry::Period is Telemetry { + + # The external .new with slower named parameter interface multi method new(Telemetry::Period: int :$cpu-user, int :$cpu-sys, @@ -260,6 +281,8 @@ class Telemetry::Period is Telemetry { $affinity-workers ) } + + # The internal .new with faster positional parameter interface multi method new(Telemetry::Period: int $cpu-user, int $cpu-sys, @@ -305,6 +328,7 @@ class Telemetry::Period is Telemetry { $period } + # For roundtripping multi method perl(Telemetry::Period:D:) { "Telemetry::Period.new(:cpu-user({ nqp::getattr_i(self,Telemetry,'$!cpu-user') @@ -346,6 +370,7 @@ class Telemetry::Period is Telemetry { method utilization() { $factor * self.cpus } } +# Creating Telemetry::Period objects ------------------------------------------- multi sub infix:<->(Telemetry:U \a, Telemetry:U \b) is export { nqp::create(Telemetry::Period) } @@ -411,22 +436,29 @@ multi sub infix:<->(Telemetry:D \a, Telemetry:D \b) is export { ) } +# Subroutines that are always exported ----------------------------------------- + +# Making a Telemetry object procedurally my @snaps; proto sub snap(|) is export { * } -multi sub snap(--> Nil) { @snaps.push(Telemetry.new) } +multi sub snap(--> Nil) { @snaps.push(Telemetry.new) } multi sub snap(@s --> Nil) { @s.push(Telemetry.new) } +# Starting the snapper / changing the period size my int $snapper-running; +my $snapper-wait; sub snapper($sleep = 0.1 --> Nil) is export { + $snapper-wait = $sleep; unless $snapper-running { snap; Thread.start(:app_lifetime, :name, { - loop { sleep $sleep; snap } + loop { sleep $snapper-wait; snap } }); $snapper-running = 1 } } +# Telemetry::Period objects from a list of Telemetry objects proto sub periods(|) is export { * } multi sub periods() { my @s = @snaps; @@ -436,6 +468,7 @@ multi sub periods() { } multi sub periods(@s) { (1..^@s).map: { @s[$_] - @s[$_ - 1] } } +# Telemetry reporting features ------------------------------------------------- proto sub report(|) is export { * } multi sub report(:$legend, :$header-repeat = 32) { my $s := nqp::clone(nqp::getattr(@snaps,List,'$!reified')); @@ -552,6 +585,7 @@ HEADER nqp::join("\n",$text) } +# Make sure we tell the world if we're implicitely told to do so --------------- END { if @snaps { snap; note report } } # vim: ft=perl6 expandtab sw=4 From 73e1faaa713baff2240f4c0ff20b75431de73044 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Wed, 1 Nov 2017 23:01:40 +0100 Subject: [PATCH 654/692] Increase the size of gtc/ttc, gfldex++ --- lib/Telemetry.pm6 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lib/Telemetry.pm6 b/lib/Telemetry.pm6 index 8d2d9582c2f..5bc2f0fbb00 100644 --- a/lib/Telemetry.pm6 +++ b/lib/Telemetry.pm6 @@ -507,13 +507,13 @@ my %format = [ "gtq", { hide0(.general-tasks-queued) }, "The number of tasks queued for execution in general worker threads"], general-tasks-completed => - [ " gtc", { hide0(.general-tasks-completed,4) }, + [ " gtc", { hide0(.general-tasks-completed,8) }, "The number of tasks completed in general worker threads"], ix-rss => [" ix-rss", { hide0(.ix-rss,10) }, "Integral shared text memory size (in bytes)"], max-rss => - [" max-rss", { .max-rss.fmt('%10d') }, + [" max-rss", { hide0(.max-rss,10) }, "Maximum resident set size (in bytes)"], supervisor => [ "s", { hide0(.supervisor,1) }, @@ -525,7 +525,7 @@ my %format = [ "ttq", { hide0(.timer-tasks-queued) }, "The number of tasks queued for execution in timer threads"], timer-tasks-completed => - [ "ttc", { hide0(.timer-tasks-completed) }, + [ " ttc", { hide0(.timer-tasks-completed,8) }, "The number of tasks completed in timer threads"], utilization => [ " util%", { .utilization.fmt('%6.2f') }, From cf1742dca0789a25a6a1f5d54d14f1b687d6ce7b Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Wed, 1 Nov 2017 23:30:27 +0100 Subject: [PATCH 655/692] More Telemetry goodness - add support for id-rss (which is usually 0 for me) - add legend by default when in END processing --- lib/Telemetry.pm6 | 31 +++++++++++++++++++++++++++---- 1 file changed, 27 insertions(+), 4 deletions(-) diff --git a/lib/Telemetry.pm6 b/lib/Telemetry.pm6 index 5bc2f0fbb00..1aea08e6ed1 100644 --- a/lib/Telemetry.pm6 +++ b/lib/Telemetry.pm6 @@ -9,6 +9,7 @@ constant STIME_SEC = 2; constant STIME_MSEC = 3; constant MAX_RSS = 4; constant IX_RSS = 5; +constant ID_RSS = 6; # Helper stuff ----------------------------------------------------------------- my num $start = Rakudo::Internals.INITTIME; @@ -57,6 +58,10 @@ sub ix-rss() is raw is export(:COLUMNS) { nqp::atpos_i(nqp::getrusage,IX_RSS) } +sub id-rss() is raw is export(:COLUMNS) { + nqp::atpos_i(nqp::getrusage,ID_RSS) +} + sub wallclock() is raw is export(:COLUMNS) { nqp::fromnum_I(1000000 * nqp::sub_n(nqp::time_n,$start),Int) } @@ -136,6 +141,7 @@ class Telemetry { has int $!cpu-sys; has int $!max-rss; has int $!ix-rss; + has int $!id-rss; has int $!wallclock; has int $!supervisor; has int $!general-workers; @@ -154,6 +160,7 @@ class Telemetry { + nqp::atpos_i(rusage,STIME_MSEC); $!max-rss = nqp::atpos_i(rusage,MAX_RSS); $!ix-rss = nqp::atpos_i(rusage,IX_RSS); + $!id-rss = nqp::atpos_i(rusage,ID_RSS); $!wallclock = nqp::fromnum_I(1000000 * nqp::sub_n(nqp::time_n,$start),Int); @@ -202,6 +209,9 @@ class Telemetry { multi method ix-rss(Telemetry:U:) is raw { ix-rss } multi method ix-rss(Telemetry:D:) is raw { $!ix-rss } + multi method id-rss(Telemetry:U:) is raw { id-rss } + multi method id-rss(Telemetry:D:) is raw { $!id-rss } + multi method wallclock(Telemetry:U:) is raw { wallclock } multi method wallclock(Telemetry:D:) is raw { $!wallclock } @@ -262,6 +272,7 @@ class Telemetry::Period is Telemetry { int :$cpu-sys, int :$max-rss, int :$ix-rss, + int :$id-rss, int :$wallclock, int :$supervisor, int :$general-workers, @@ -274,7 +285,7 @@ class Telemetry::Period is Telemetry { ) { self.new( $cpu-user, $cpu-sys, - $max-rss, $ix-rss, + $max-rss, $ix-rss, $id-rss, $wallclock, $supervisor, $general-workers, $general-tasks-queued, $general-tasks-completed, $timer-workers, $timer-tasks-queued, $timer-tasks-completed, @@ -288,6 +299,7 @@ class Telemetry::Period is Telemetry { int $cpu-sys, int $max-rss, int $ix-rss, + int $id-rss, int $wallclock, int $supervisor, int $general-workers, @@ -307,6 +319,8 @@ class Telemetry::Period is Telemetry { '$!max-rss', $max-rss); nqp::bindattr_i($period,Telemetry, '$!ix-rss', $ix-rss); + nqp::bindattr_i($period,Telemetry, + '$!id-rss', $id-rss); nqp::bindattr_i($period,Telemetry, '$!wallclock', $wallclock); nqp::bindattr_i($period,Telemetry, @@ -338,6 +352,8 @@ class Telemetry::Period is Telemetry { nqp::getattr_i(self,Telemetry,'$!max-rss') }), :ix-rss({ nqp::getattr_i(self,Telemetry,'$!ix-rss') + }), :id-rss({ + nqp::getattr_i(self,Telemetry,'$!id-rss') }), :wallclock({ nqp::getattr_i(self,Telemetry,'$!wallclock') }), :supervisor({ @@ -397,6 +413,10 @@ multi sub infix:<->(Telemetry:D \a, Telemetry:D \b) is export { nqp::getattr_i($a,Telemetry,'$!ix-rss'), nqp::getattr_i($b,Telemetry,'$!ix-rss') ), + nqp::sub_i( + nqp::getattr_i($a,Telemetry,'$!id-rss'), + nqp::getattr_i($b,Telemetry,'$!id-rss') + ), nqp::sub_i( nqp::getattr_i($a,Telemetry,'$!wallclock'), nqp::getattr_i($b,Telemetry,'$!wallclock') @@ -486,7 +506,7 @@ sub hide0(\value, int $size = 3) { value ?? value.fmt("%{$size}d") !! nqp::x(" ",$size) } -# Set up how to handle report generation +# Set up how to handle report generation (in alphabetical order) my %format = affinity-workers => [ " aw", { hide0(.affinity-workers) }, @@ -509,6 +529,9 @@ my %format = general-tasks-completed => [ " gtc", { hide0(.general-tasks-completed,8) }, "The number of tasks completed in general worker threads"], + id-rss => + [" id-rss", { hide0(.id-rss,10) }, + "Integral unshared data size (in bytes)"], ix-rss => [" ix-rss", { hide0(.ix-rss,10) }, "Integral shared text memory size (in bytes)"], @@ -578,7 +601,7 @@ HEADER nqp::push_s($text,''); nqp::push_s($text,'Legend:'); for %format{@cols} -> $col { - nqp::push_s($text," $col[0].trim-leading.fmt('%5s') $col[2]"); + nqp::push_s($text," $col[0].trim-leading.fmt('%9s') $col[2]"); } } @@ -586,6 +609,6 @@ HEADER } # Make sure we tell the world if we're implicitely told to do so --------------- -END { if @snaps { snap; note report } } +END { if @snaps { snap; note report(:legend) } } # vim: ft=perl6 expandtab sw=4 From 91e00e680174b2a414fd02ac8dfa8268e6145e2c Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Wed, 1 Nov 2017 23:41:24 +0100 Subject: [PATCH 656/692] Telemetry exports T, allowing for T --- lib/Telemetry.pm6 | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/lib/Telemetry.pm6 b/lib/Telemetry.pm6 index 1aea08e6ed1..c5af5620301 100644 --- a/lib/Telemetry.pm6 +++ b/lib/Telemetry.pm6 @@ -261,6 +261,8 @@ class Telemetry { multi method gist(Telemetry:D:) { "$.cpu / $!wallclock" } + + multi method AT-KEY(Telemetry:D: $key) { self."$key"() } } # Telemetry::Period ------------------------------------------------------------ @@ -608,6 +610,10 @@ HEADER nqp::join("\n",$text) } +# The special T functionality ----------------------------------------- + +sub T () is export { Telemetry.new } + # Make sure we tell the world if we're implicitely told to do so --------------- END { if @snaps { snap; note report(:legend) } } From 96751ee87c932e95a82e2bfcec64f7627fcb5fa7 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Thu, 2 Nov 2017 00:22:33 +0100 Subject: [PATCH 657/692] Add Telemetry is-rss,min-flt,maj-flt,nswap,inblock,outblock Which all return 0 apparently on MacOS --- lib/Telemetry.pm6 | 155 +++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 147 insertions(+), 8 deletions(-) diff --git a/lib/Telemetry.pm6 b/lib/Telemetry.pm6 index c5af5620301..16870b6f554 100644 --- a/lib/Telemetry.pm6 +++ b/lib/Telemetry.pm6 @@ -3,13 +3,19 @@ use nqp; # Constants indexing into the nqp::getrusage array ----------------------------- -constant UTIME_SEC = 0; -constant UTIME_MSEC = 1; -constant STIME_SEC = 2; -constant STIME_MSEC = 3; -constant MAX_RSS = 4; -constant IX_RSS = 5; -constant ID_RSS = 6; +constant UTIME_SEC = 0; +constant UTIME_MSEC = 1; +constant STIME_SEC = 2; +constant STIME_MSEC = 3; +constant MAX_RSS = 4; +constant IX_RSS = 5; +constant ID_RSS = 6; +constant IS_RSS = 8; +constant MIN_FLT = 9; +constant MAJ_FLT = 10; +constant NSWAP = 11; +constant INBLOCK = 12; +constant OUTBLOCK = 13; # Helper stuff ----------------------------------------------------------------- my num $start = Rakudo::Internals.INITTIME; @@ -62,6 +68,30 @@ sub id-rss() is raw is export(:COLUMNS) { nqp::atpos_i(nqp::getrusage,ID_RSS) } +sub is-rss() is raw is export(:COLUMNS) { + nqp::atpos_i(nqp::getrusage,IS_RSS) +} + +sub min-flt() is raw is export(:COLUMNS) { + nqp::atpos_i(nqp::getrusage,MIN_FLT) +} + +sub maj-flt() is raw is export(:COLUMNS) { + nqp::atpos_i(nqp::getrusage,MAJ_FLT) +} + +sub nswap() is raw is export(:COLUMNS) { + nqp::atpos_i(nqp::getrusage,NSWAP) +} + +sub inblock() is raw is export(:COLUMNS) { + nqp::atpos_i(nqp::getrusage,INBLOCK) +} + +sub outblock() is raw is export(:COLUMNS) { + nqp::atpos_i(nqp::getrusage,OUTBLOCK) +} + sub wallclock() is raw is export(:COLUMNS) { nqp::fromnum_I(1000000 * nqp::sub_n(nqp::time_n,$start),Int) } @@ -142,6 +172,12 @@ class Telemetry { has int $!max-rss; has int $!ix-rss; has int $!id-rss; + has int $!is-rss; + has int $!min-flt; + has int $!maj-flt; + has int $!nswap; + has int $!inblock; + has int $!outblock; has int $!wallclock; has int $!supervisor; has int $!general-workers; @@ -161,6 +197,12 @@ class Telemetry { $!max-rss = nqp::atpos_i(rusage,MAX_RSS); $!ix-rss = nqp::atpos_i(rusage,IX_RSS); $!id-rss = nqp::atpos_i(rusage,ID_RSS); + $!is-rss = nqp::atpos_i(rusage,IS_RSS); + $!min-flt = nqp::atpos_i(rusage,MIN_FLT); + $!maj-flt = nqp::atpos_i(rusage,MAJ_FLT); + $!nswap = nqp::atpos_i(rusage,NSWAP); + $!inblock = nqp::atpos_i(rusage,INBLOCK); + $!outblock = nqp::atpos_i(rusage,OUTBLOCK); $!wallclock = nqp::fromnum_I(1000000 * nqp::sub_n(nqp::time_n,$start),Int); @@ -212,6 +254,24 @@ class Telemetry { multi method id-rss(Telemetry:U:) is raw { id-rss } multi method id-rss(Telemetry:D:) is raw { $!id-rss } + multi method is-rss(Telemetry:U:) is raw { is-rss } + multi method is-rss(Telemetry:D:) is raw { $!is-rss } + + multi method min-flt(Telemetry:U:) is raw { min-flt } + multi method min-flt(Telemetry:D:) is raw { $!min-flt } + + multi method maj-flt(Telemetry:U:) is raw { maj-flt } + multi method maj-flt(Telemetry:D:) is raw { $!maj-flt } + + multi method nswap(Telemetry:U:) is raw { nswap } + multi method nswap(Telemetry:D:) is raw { $!nswap } + + multi method inblock(Telemetry:U:) is raw { inblock } + multi method inblock(Telemetry:D:) is raw { $!inblock } + + multi method outblock(Telemetry:U:) is raw { outblock } + multi method outblock(Telemetry:D:) is raw { $!outblock } + multi method wallclock(Telemetry:U:) is raw { wallclock } multi method wallclock(Telemetry:D:) is raw { $!wallclock } @@ -275,6 +335,12 @@ class Telemetry::Period is Telemetry { int :$max-rss, int :$ix-rss, int :$id-rss, + int :$is-rss, + int :$min-flt, + int :$maj-flt, + int :$nswap, + int :$inblock, + int :$outblock, int :$wallclock, int :$supervisor, int :$general-workers, @@ -287,7 +353,8 @@ class Telemetry::Period is Telemetry { ) { self.new( $cpu-user, $cpu-sys, - $max-rss, $ix-rss, $id-rss, + $max-rss, $ix-rss, $id-rss, $is-rss, $min-flt, $maj-flt, $nswap, + $inblock, $outblock, $wallclock, $supervisor, $general-workers, $general-tasks-queued, $general-tasks-completed, $timer-workers, $timer-tasks-queued, $timer-tasks-completed, @@ -302,6 +369,12 @@ class Telemetry::Period is Telemetry { int $max-rss, int $ix-rss, int $id-rss, + int $is-rss, + int $min-flt, + int $maj-flt, + int $nswap, + int $inblock, + int $outblock, int $wallclock, int $supervisor, int $general-workers, @@ -323,6 +396,18 @@ class Telemetry::Period is Telemetry { '$!ix-rss', $ix-rss); nqp::bindattr_i($period,Telemetry, '$!id-rss', $id-rss); + nqp::bindattr_i($period,Telemetry, + '$!is-rss', $is-rss); + nqp::bindattr_i($period,Telemetry, + '$!min-flt', $min-flt); + nqp::bindattr_i($period,Telemetry, + '$!maj-flt', $maj-flt); + nqp::bindattr_i($period,Telemetry, + '$!nswap', $nswap); + nqp::bindattr_i($period,Telemetry, + '$!inblock', $inblock); + nqp::bindattr_i($period,Telemetry, + '$!outblock', $outblock); nqp::bindattr_i($period,Telemetry, '$!wallclock', $wallclock); nqp::bindattr_i($period,Telemetry, @@ -356,6 +441,18 @@ class Telemetry::Period is Telemetry { nqp::getattr_i(self,Telemetry,'$!ix-rss') }), :id-rss({ nqp::getattr_i(self,Telemetry,'$!id-rss') + }), :is-rss({ + nqp::getattr_i(self,Telemetry,'$!is-rss') + }), :min-flt({ + nqp::getattr_i(self,Telemetry,'$!min-flt') + }), :maj-flt({ + nqp::getattr_i(self,Telemetry,'$!maj-flt') + }), :nswap({ + nqp::getattr_i(self,Telemetry,'$!nswap') + }), :inblock({ + nqp::getattr_i(self,Telemetry,'$!inblock') + }), :outblock({ + nqp::getattr_i(self,Telemetry,'$!outblock') }), :wallclock({ nqp::getattr_i(self,Telemetry,'$!wallclock') }), :supervisor({ @@ -419,6 +516,30 @@ multi sub infix:<->(Telemetry:D \a, Telemetry:D \b) is export { nqp::getattr_i($a,Telemetry,'$!id-rss'), nqp::getattr_i($b,Telemetry,'$!id-rss') ), + nqp::sub_i( + nqp::getattr_i($a,Telemetry,'$!is-rss'), + nqp::getattr_i($b,Telemetry,'$!is-rss') + ), + nqp::sub_i( + nqp::getattr_i($a,Telemetry,'$!min-flt'), + nqp::getattr_i($b,Telemetry,'$!min-flt') + ), + nqp::sub_i( + nqp::getattr_i($a,Telemetry,'$!maj-flt'), + nqp::getattr_i($b,Telemetry,'$!maj-flt') + ), + nqp::sub_i( + nqp::getattr_i($a,Telemetry,'$!nswap'), + nqp::getattr_i($b,Telemetry,'$!nswap') + ), + nqp::sub_i( + nqp::getattr_i($a,Telemetry,'$!inblock'), + nqp::getattr_i($b,Telemetry,'$!inblock') + ), + nqp::sub_i( + nqp::getattr_i($a,Telemetry,'$!outblock'), + nqp::getattr_i($b,Telemetry,'$!outblock') + ), nqp::sub_i( nqp::getattr_i($a,Telemetry,'$!wallclock'), nqp::getattr_i($b,Telemetry,'$!wallclock') @@ -534,12 +655,30 @@ my %format = id-rss => [" id-rss", { hide0(.id-rss,10) }, "Integral unshared data size (in bytes)"], + inblock => + ["inb", { hide0(.inblock) }, + "Number of block input operations"], + is-rss => + [" is-rss", { hide0(.id-rss,10) }, + "Integral unshared stack size (in bytes)"], ix-rss => [" ix-rss", { hide0(.ix-rss,10) }, "Integral shared text memory size (in bytes)"], + maj-flt => + ["aft", { hide0(.maj-flt,3) }, + "Number of page reclaims (ru_majflt)"], max-rss => [" max-rss", { hide0(.max-rss,10) }, "Maximum resident set size (in bytes)"], + min-flt => + ["ift", { hide0(.min-flt) }, + "Number of page reclaims (ru_minflt)"], + nswap => + ["nsw", { hide0(.nswap) }, + "Number of swaps"], + outblock => + ["oub", { hide0(.outblock) }, + "Number of block output operations"], supervisor => [ "s", { hide0(.supervisor,1) }, "The number of supervisors"], From 7e00908cb2727b96de146002b9159ab04a8735c0 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Thu, 2 Nov 2017 00:33:34 +0100 Subject: [PATCH 658/692] Normalize all Telemetry x-rss to Kbytes - on MacOS reported values are bytes - on Linux they are apparently Kbytes - Kbytes seems to be the more sensible scale --- lib/Telemetry.pm6 | 33 +++++++++++++++++---------------- 1 file changed, 17 insertions(+), 16 deletions(-) diff --git a/lib/Telemetry.pm6 b/lib/Telemetry.pm6 index 16870b6f554..dbf361f35b7 100644 --- a/lib/Telemetry.pm6 +++ b/lib/Telemetry.pm6 @@ -19,6 +19,7 @@ constant OUTBLOCK = 13; # Helper stuff ----------------------------------------------------------------- my num $start = Rakudo::Internals.INITTIME; +my int $b2kb = nqp::atkey(nqp::backendconfig,q/osname/) eq 'darwin' ?? 10 !! 0; sub completed(\workers) is raw { my int $elems = nqp::elems(workers); @@ -57,19 +58,19 @@ sub cpu-sys() is raw is export(:COLUMNS) { } sub max-rss() is raw is export(:COLUMNS) { - nqp::atpos_i(nqp::getrusage,MAX_RSS) + nqp::bitshiftr_i(nqp::atpos_i(nqp::getrusage,MAX_RSS),$b2kb) } sub ix-rss() is raw is export(:COLUMNS) { - nqp::atpos_i(nqp::getrusage,IX_RSS) + nqp::bitshiftr_i(nqp::atpos_i(nqp::getrusage,IX_RSS),$b2kb) } sub id-rss() is raw is export(:COLUMNS) { - nqp::atpos_i(nqp::getrusage,ID_RSS) + nqp::bitshiftr_i(nqp::atpos_i(nqp::getrusage,ID_RSS),$b2kb) } sub is-rss() is raw is export(:COLUMNS) { - nqp::atpos_i(nqp::getrusage,IS_RSS) + nqp::bitshiftr_i(nqp::atpos_i(nqp::getrusage,IS_RSS),$b2kb) } sub min-flt() is raw is export(:COLUMNS) { @@ -194,10 +195,10 @@ class Telemetry { + nqp::atpos_i(rusage,UTIME_MSEC); $!cpu-sys = nqp::atpos_i(rusage,STIME_SEC) * 1000000 + nqp::atpos_i(rusage,STIME_MSEC); - $!max-rss = nqp::atpos_i(rusage,MAX_RSS); - $!ix-rss = nqp::atpos_i(rusage,IX_RSS); - $!id-rss = nqp::atpos_i(rusage,ID_RSS); - $!is-rss = nqp::atpos_i(rusage,IS_RSS); + $!max-rss = nqp::bitshiftr_i(nqp::atpos_i(rusage,MAX_RSS),$b2kb); + $!ix-rss = nqp::bitshiftr_i(nqp::atpos_i(rusage,IX_RSS),$b2kb); + $!id-rss = nqp::bitshiftr_i(nqp::atpos_i(rusage,ID_RSS),$b2kb); + $!is-rss = nqp::bitshiftr_i(nqp::atpos_i(rusage,IS_RSS),$b2kb); $!min-flt = nqp::atpos_i(rusage,MIN_FLT); $!maj-flt = nqp::atpos_i(rusage,MAJ_FLT); $!nswap = nqp::atpos_i(rusage,NSWAP); @@ -653,23 +654,23 @@ my %format = [ " gtc", { hide0(.general-tasks-completed,8) }, "The number of tasks completed in general worker threads"], id-rss => - [" id-rss", { hide0(.id-rss,10) }, - "Integral unshared data size (in bytes)"], + [" id-rss", { hide0(.id-rss,8) }, + "Integral unshared data size (in Kbytes)"], inblock => ["inb", { hide0(.inblock) }, "Number of block input operations"], is-rss => - [" is-rss", { hide0(.id-rss,10) }, - "Integral unshared stack size (in bytes)"], + [" is-rss", { hide0(.id-rss,8) }, + "Integral unshared stack size (in Kbytes)"], ix-rss => - [" ix-rss", { hide0(.ix-rss,10) }, - "Integral shared text memory size (in bytes)"], + [" ix-rss", { hide0(.ix-rss,8) }, + "Integral shared text memory size (in Kbytes)"], maj-flt => ["aft", { hide0(.maj-flt,3) }, "Number of page reclaims (ru_majflt)"], max-rss => - [" max-rss", { hide0(.max-rss,10) }, - "Maximum resident set size (in bytes)"], + [" max-rss", { hide0(.max-rss,8) }, + "Maximum resident set size (in Kbytes)"], min-flt => ["ift", { hide0(.min-flt) }, "Number of page reclaims (ru_minflt)"], From d21c31e1d7235453f76025c3f9472566ec025989 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Thu, 2 Nov 2017 00:59:36 +0100 Subject: [PATCH 659/692] Add Telemetry msgsnd,msgrcv,nsignals,nvcsw,invcsw - Also add invcsw (involuntary context switches) to default report - this shows some data, at least on MacOS - This concludes all the fields in nqp::getrusage (*phew*) --- lib/Telemetry.pm6 | 119 +++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 117 insertions(+), 2 deletions(-) diff --git a/lib/Telemetry.pm6 b/lib/Telemetry.pm6 index dbf361f35b7..6aeb6787fb7 100644 --- a/lib/Telemetry.pm6 +++ b/lib/Telemetry.pm6 @@ -16,6 +16,11 @@ constant MAJ_FLT = 10; constant NSWAP = 11; constant INBLOCK = 12; constant OUTBLOCK = 13; +constant MSGSND = 14; +constant MSGRCV = 14; +constant NSIGNALS = 15; +constant NVCSW = 16; +constant INVCSW = 17; # Helper stuff ----------------------------------------------------------------- my num $start = Rakudo::Internals.INITTIME; @@ -93,6 +98,26 @@ sub outblock() is raw is export(:COLUMNS) { nqp::atpos_i(nqp::getrusage,OUTBLOCK) } +sub msgsnd() is raw is export(:COLUMNS) { + nqp::atpos_i(nqp::getrusage,MSGSND) +} + +sub msgrcv() is raw is export(:COLUMNS) { + nqp::atpos_i(nqp::getrusage,MSGRCV) +} + +sub nsignals() is raw is export(:COLUMNS) { + nqp::atpos_i(nqp::getrusage,NSIGNALS) +} + +sub nvcsw() is raw is export(:COLUMNS) { + nqp::atpos_i(nqp::getrusage,NVCSW) +} + +sub invcsw() is raw is export(:COLUMNS) { + nqp::atpos_i(nqp::getrusage,INVCSW) +} + sub wallclock() is raw is export(:COLUMNS) { nqp::fromnum_I(1000000 * nqp::sub_n(nqp::time_n,$start),Int) } @@ -179,6 +204,11 @@ class Telemetry { has int $!nswap; has int $!inblock; has int $!outblock; + has int $!msgsnd; + has int $!msgrcv; + has int $!nsignals; + has int $!nvcsw; + has int $!invcsw; has int $!wallclock; has int $!supervisor; has int $!general-workers; @@ -204,6 +234,11 @@ class Telemetry { $!nswap = nqp::atpos_i(rusage,NSWAP); $!inblock = nqp::atpos_i(rusage,INBLOCK); $!outblock = nqp::atpos_i(rusage,OUTBLOCK); + $!msgsnd = nqp::atpos_i(rusage,MSGSND); + $!msgrcv = nqp::atpos_i(rusage,MSGRCV); + $!nsignals = nqp::atpos_i(rusage,NSIGNALS); + $!nvcsw = nqp::atpos_i(rusage,NVCSW); + $!invcsw = nqp::atpos_i(rusage,INVCSW); $!wallclock = nqp::fromnum_I(1000000 * nqp::sub_n(nqp::time_n,$start),Int); @@ -273,6 +308,21 @@ class Telemetry { multi method outblock(Telemetry:U:) is raw { outblock } multi method outblock(Telemetry:D:) is raw { $!outblock } + multi method msgsnd(Telemetry:U:) is raw { msgsnd } + multi method msgsnd(Telemetry:D:) is raw { $!msgsnd } + + multi method msgrcv(Telemetry:U:) is raw { msgrcv } + multi method msgrcv(Telemetry:D:) is raw { $!msgrcv } + + multi method nsignals(Telemetry:U:) is raw { nsignals } + multi method nsignals(Telemetry:D:) is raw { $!nsignals } + + multi method nvcsw(Telemetry:U:) is raw { nvcsw } + multi method nvcsw(Telemetry:D:) is raw { $!nvcsw } + + multi method invcsw(Telemetry:U:) is raw { invcsw } + multi method invcsw(Telemetry:D:) is raw { $!invcsw } + multi method wallclock(Telemetry:U:) is raw { wallclock } multi method wallclock(Telemetry:D:) is raw { $!wallclock } @@ -342,6 +392,11 @@ class Telemetry::Period is Telemetry { int :$nswap, int :$inblock, int :$outblock, + int :$msgsnd, + int :$msgrcv, + int :$nsignals, + int :$nvcsw, + int :$invcsw, int :$wallclock, int :$supervisor, int :$general-workers, @@ -355,7 +410,7 @@ class Telemetry::Period is Telemetry { self.new( $cpu-user, $cpu-sys, $max-rss, $ix-rss, $id-rss, $is-rss, $min-flt, $maj-flt, $nswap, - $inblock, $outblock, + $inblock, $outblock, $msgsnd, $msgrcv, $nsignals, $nvcsw, $invcsw, $wallclock, $supervisor, $general-workers, $general-tasks-queued, $general-tasks-completed, $timer-workers, $timer-tasks-queued, $timer-tasks-completed, @@ -376,6 +431,11 @@ class Telemetry::Period is Telemetry { int $nswap, int $inblock, int $outblock, + int $msgsnd, + int $msgrcv, + int $nsignals, + int $nvcsw, + int $invcsw, int $wallclock, int $supervisor, int $general-workers, @@ -409,6 +469,16 @@ class Telemetry::Period is Telemetry { '$!inblock', $inblock); nqp::bindattr_i($period,Telemetry, '$!outblock', $outblock); + nqp::bindattr_i($period,Telemetry, + '$!msgsnd', $msgsnd); + nqp::bindattr_i($period,Telemetry, + '$!msgrcv', $msgrcv); + nqp::bindattr_i($period,Telemetry, + '$!nsignals', $nsignals); + nqp::bindattr_i($period,Telemetry, + '$!nvcsw', $nvcsw); + nqp::bindattr_i($period,Telemetry, + '$!invcsw', $invcsw); nqp::bindattr_i($period,Telemetry, '$!wallclock', $wallclock); nqp::bindattr_i($period,Telemetry, @@ -454,6 +524,16 @@ class Telemetry::Period is Telemetry { nqp::getattr_i(self,Telemetry,'$!inblock') }), :outblock({ nqp::getattr_i(self,Telemetry,'$!outblock') + }), :msgsnd({ + nqp::getattr_i(self,Telemetry,'$!msgsnd') + }), :msgrcv({ + nqp::getattr_i(self,Telemetry,'$!msgrcv') + }), :nsignals({ + nqp::getattr_i(self,Telemetry,'$!nsignals') + }), :nvcsw({ + nqp::getattr_i(self,Telemetry,'$!nvcsw') + }), :invcsw({ + nqp::getattr_i(self,Telemetry,'$!invcsw') }), :wallclock({ nqp::getattr_i(self,Telemetry,'$!wallclock') }), :supervisor({ @@ -541,6 +621,26 @@ multi sub infix:<->(Telemetry:D \a, Telemetry:D \b) is export { nqp::getattr_i($a,Telemetry,'$!outblock'), nqp::getattr_i($b,Telemetry,'$!outblock') ), + nqp::sub_i( + nqp::getattr_i($a,Telemetry,'$!msgsnd'), + nqp::getattr_i($b,Telemetry,'$!msgsnd') + ), + nqp::sub_i( + nqp::getattr_i($a,Telemetry,'$!msgrcv'), + nqp::getattr_i($b,Telemetry,'$!msgrcv') + ), + nqp::sub_i( + nqp::getattr_i($a,Telemetry,'$!nsignals'), + nqp::getattr_i($b,Telemetry,'$!nsignals') + ), + nqp::sub_i( + nqp::getattr_i($a,Telemetry,'$!nvcsw'), + nqp::getattr_i($b,Telemetry,'$!nvcsw') + ), + nqp::sub_i( + nqp::getattr_i($a,Telemetry,'$!invcsw'), + nqp::getattr_i($b,Telemetry,'$!invcsw') + ), nqp::sub_i( nqp::getattr_i($a,Telemetry,'$!wallclock'), nqp::getattr_i($b,Telemetry,'$!wallclock') @@ -659,6 +759,9 @@ my %format = inblock => ["inb", { hide0(.inblock) }, "Number of block input operations"], + invcsw => + [" ics", { hide0(.invcsw,8) }, + "Number of involuntary context switches"], is-rss => [" is-rss", { hide0(.id-rss,8) }, "Integral unshared stack size (in Kbytes)"], @@ -674,9 +777,21 @@ my %format = min-flt => ["ift", { hide0(.min-flt) }, "Number of page reclaims (ru_minflt)"], + msgrcv => + ["mrc", { hide0(.msgrcv) }, + "Number of messages received"], + msgsnd => + ["msd", { hide0(.msgsnd) }, + "Number of messages sent"], + nsignals => + ["ngs", { hide0(.nsignals) }, + "Number of signals received"], nswap => ["nsw", { hide0(.nswap) }, "Number of swaps"], + nvcsw => + [" vcs", { hide0(.nvcsw,4) }, + "Number of voluntary context switches"], outblock => ["oub", { hide0(.outblock) }, "Number of block output operations"], @@ -708,7 +823,7 @@ for %format.values -> \v { multi sub report( @s, - @cols = , + @cols = , :$legend, :$header-repeat = 32, ) { From 0dc4a0ebad21048a3a99ab0ad7c28b41b98f07b9 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Thu, 2 Nov 2017 10:01:36 +0100 Subject: [PATCH 660/692] Telemetry tweaks #1 for today - handle 0 wallclock better, apparently Windows has bigger granularity - add initial memory size (max-rss) to report --- lib/Telemetry.pm6 | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/lib/Telemetry.pm6 b/lib/Telemetry.pm6 index 6aeb6787fb7..ba35d90d542 100644 --- a/lib/Telemetry.pm6 +++ b/lib/Telemetry.pm6 @@ -555,14 +555,17 @@ class Telemetry::Period is Telemetry { }))" } + my int $cores = Kernel.cpu-cores; method cpus() { - nqp::add_i( - nqp::getattr_i(self,Telemetry,'$!cpu-user'), - nqp::getattr_i(self,Telemetry,'$!cpu-sys') - ) / nqp::getattr_i(self,Telemetry,'$!wallclock') + (my int $wallclock = nqp::getattr_i(self,Telemetry,'$!wallclock')) + ?? nqp::add_i( + nqp::getattr_i(self,Telemetry,'$!cpu-user'), + nqp::getattr_i(self,Telemetry,'$!cpu-sys') + ) / $wallclock + !! $cores } - my $factor = 100 / Kernel.cpu-cores; + my $factor = 100 / $cores; method utilization() { $factor * self.cpus } } @@ -811,7 +814,7 @@ my %format = [ " util%", { .utilization.fmt('%6.2f') }, "Percentage of CPU utilization (0..100%)"], wallclock => - ["wallclock", { .wallclock.fmt('%9d') }, + ["wallclock", { hide0(.wallclock,9) }, "Number of microseconds elapsed"], ; @@ -832,6 +835,7 @@ multi sub report( my $text := nqp::list_s(qq:to/HEADER/.chomp); Telemetry Report of Process #$*PID ({Instant.from-posix(nqp::time_i).DateTime}) Number of Snapshots: {+@s} +Initial Size: { @s[0].max-rss.fmt('%9d') } Kbytes Total Time: { ($total.wallclock / 1000000).fmt('%9.2f') } seconds Total CPU Usage: { ($total.cpu / 1000000).fmt('%9.2f') } seconds HEADER From be1e2879f37ec775547a472de1024e6140c3f5f5 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Thu, 2 Nov 2017 10:37:18 +0100 Subject: [PATCH 661/692] Make multi sub(:@c is copy) { } work Apparently this was looked over during the GLR --- src/Perl6/Metamodel/BOOTSTRAP.nqp | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/src/Perl6/Metamodel/BOOTSTRAP.nqp b/src/Perl6/Metamodel/BOOTSTRAP.nqp index 6c25eefe2ea..d616f4e0b79 100644 --- a/src/Perl6/Metamodel/BOOTSTRAP.nqp +++ b/src/Perl6/Metamodel/BOOTSTRAP.nqp @@ -440,11 +440,9 @@ my class Binder { # and a normal bind is a straightforward binding. if $flags +& $SIG_ELEM_ARRAY_SIGIL { if $flags +& $SIG_ELEM_IS_COPY { - # XXX GLR - nqp::die('replace this Array is copy logic'); - # my $bindee := nqp::create(Array); - # $bindee.STORE(nqp::decont($oval)); - # nqp::bindkey($lexpad, $varname, $bindee); + my $bindee := nqp::create(Array); + $bindee.STORE(nqp::decont($oval)); + nqp::bindkey($lexpad, $varname, $bindee); } else { nqp::bindkey($lexpad, $varname, nqp::decont($oval)); From c2baf95e1b37640370cbbddd65bc0c61d49da848 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Thu, 2 Nov 2017 10:45:02 +0100 Subject: [PATCH 662/692] Telemetry tweaks #2 for today - "columns" is now a named parameter to "report" - specify the columns you want to see, either by header or method name - %*ENV can now be used to set columns you want to see - if you don't specify any columns in the call to "report" --- lib/Telemetry.pm6 | 22 ++++++++++++++++------ 1 file changed, 16 insertions(+), 6 deletions(-) diff --git a/lib/Telemetry.pm6 b/lib/Telemetry.pm6 index ba35d90d542..c6c173352ca 100644 --- a/lib/Telemetry.pm6 +++ b/lib/Telemetry.pm6 @@ -717,12 +717,13 @@ multi sub periods(@s) { (1..^@s).map: { @s[$_] - @s[$_ - 1] } } # Telemetry reporting features ------------------------------------------------- proto sub report(|) is export { * } -multi sub report(:$legend, :$header-repeat = 32) { +multi sub report(:@columns, :$legend, :$header-repeat = 32) { my $s := nqp::clone(nqp::getattr(@snaps,List,'$!reified')); nqp::setelems(nqp::getattr(@snaps,List,'$!reified'),0); nqp::push($s,Telemetry.new) if nqp::elems($s) == 1; report( nqp::p6bindattrinvres(nqp::create(List),List,'$!reified',$s), + :@columns, :$legend, :$header-repeat, ); @@ -826,11 +827,20 @@ for %format.values -> \v { multi sub report( @s, - @cols = , + :@columns is copy, :$legend, :$header-repeat = 32, ) { + unless @columns { + if %*ENV -> $rrc { + @columns = $rrc.comb( /<[\w-]>+/ ); + } + else { + @columns = ; + } + } + my $total = @s[*-1] - @s[0]; my $text := nqp::list_s(qq:to/HEADER/.chomp); Telemetry Report of Process #$*PID ({Instant.from-posix(nqp::time_i).DateTime}) @@ -842,10 +852,10 @@ HEADER sub push-period($period) { nqp::push_s($text, - %format{@cols}>>.[1]>>.($period).join(' ').trim-trailing); + %format{@columns}>>.[1]>>.($period).join(' ').trim-trailing); } - my $header = "\n%format{@cols}>>.[0].join(' ')"; + my $header = "\n%format{@columns}>>.[0].join(' ')"; nqp::push_s($text,$header) unless $header-repeat; for periods(@s).kv -> $index, $period { @@ -854,14 +864,14 @@ HEADER push-period($period) } - nqp::push_s($text,%format{@cols}>>.[3].join(' ')); + nqp::push_s($text,%format{@columns}>>.[3].join(' ')); push-period($total); if $legend { nqp::push_s($text,''); nqp::push_s($text,'Legend:'); - for %format{@cols} -> $col { + for %format{@columns} -> $col { nqp::push_s($text," $col[0].trim-leading.fmt('%9s') $col[2]"); } } From 9f54bc989d00427d995169ea4a0ca14542ef9677 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Thu, 2 Nov 2017 16:10:10 +0100 Subject: [PATCH 663/692] Add X::NYI.workaround So we can give workaround information if necessary --- src/core/Exception.pm | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/core/Exception.pm b/src/core/Exception.pm index d2931a923b6..88760032f7d 100644 --- a/src/core/Exception.pm +++ b/src/core/Exception.pm @@ -780,9 +780,11 @@ my role X::Pod { } my class X::NYI is Exception { has $.feature; has $.did-you-mean; + has $.workaround; method message() { my $msg = "$.feature not yet implemented. Sorry."; $msg ~= "\nDid you mean: {$.did-you-mean.gist}?" if $.did-you-mean; + $msg ~= "\nWorkaround: $.workaround" if $.workaround; $msg } } From 0973b307addc04f21f604931bb2dbf94515bcafc Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Thu, 2 Nov 2017 16:28:44 +0100 Subject: [PATCH 664/692] Temporary fix for GH #1226 - throw an X::Comp::NYI for buildplan code 9 with a 4,5,6,7 - show a work around Can't help but wonder that if we recommend this workaround, why not automatically generate that code then? This could be done by adding another code block like TWEAK to the BUILDPLAN, with the correct code pre-generated. --- src/Perl6/Metamodel/BUILDPLAN.nqp | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/src/Perl6/Metamodel/BUILDPLAN.nqp b/src/Perl6/Metamodel/BUILDPLAN.nqp index 85aca424ec1..01e3a55027b 100644 --- a/src/Perl6/Metamodel/BUILDPLAN.nqp +++ b/src/Perl6/Metamodel/BUILDPLAN.nqp @@ -39,6 +39,26 @@ role Perl6::Metamodel::BUILDPLAN { if nqp::can($_, 'container_initializer') { my $ci := $_.container_initializer; if nqp::isconcrete($ci) { + + # GH #1226 + if nqp::can($_, 'build') { + my $default := $_.build; + if nqp::isconcrete($default) { + $*W.find_symbol(["X","Comp","NYI"]).new( + feature => + "Defaults on compound attribute types", + workaround => + "Create/Adapt TWEAK method in class " + ~ $obj.HOW.name($obj) + ~ ", e.g:\n method TWEAK() \{ " + ~ $_.name + ~ " = (initial values) unless %_<" + ~ nqp::substr($_.name,2) + ~ ">:exists }" + ).throw; + } + } + nqp::push(@plan,[9, $obj, $_.name, $ci]); next; } From 6dab5aad89c7b0ea11169df0ca55472ec73a35de Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Thu, 2 Nov 2017 16:51:31 +0100 Subject: [PATCH 665/692] Improve GH #1226 workaround suggestion, Zoffix++ --- src/Perl6/Metamodel/BUILDPLAN.nqp | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/Perl6/Metamodel/BUILDPLAN.nqp b/src/Perl6/Metamodel/BUILDPLAN.nqp index 01e3a55027b..7f897c6e8b4 100644 --- a/src/Perl6/Metamodel/BUILDPLAN.nqp +++ b/src/Perl6/Metamodel/BUILDPLAN.nqp @@ -50,11 +50,9 @@ role Perl6::Metamodel::BUILDPLAN { workaround => "Create/Adapt TWEAK method in class " ~ $obj.HOW.name($obj) - ~ ", e.g:\n method TWEAK() \{ " + ~ ", e.g:\n method TWEAK(:" ~ $_.name - ~ " = (initial values) unless %_<" - ~ nqp::substr($_.name,2) - ~ ">:exists }" + ~ ' = (initial values)) { }' ).throw; } } From e1a1b8d865249c833d447f87b48121a46c70a9f7 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Thu, 2 Nov 2017 18:04:32 +0100 Subject: [PATCH 666/692] Add support for Telemetry affinity-tasks-completed - also add this to the default report --- lib/Telemetry.pm6 | 85 ++++++++++++++++++++++++++++++++--------------- 1 file changed, 58 insertions(+), 27 deletions(-) diff --git a/lib/Telemetry.pm6 b/lib/Telemetry.pm6 index c6c173352ca..3b8f1c26dd8 100644 --- a/lib/Telemetry.pm6 +++ b/lib/Telemetry.pm6 @@ -191,6 +191,15 @@ sub affinity-workers() is raw is export(:COLUMNS) { ) } +sub affinity-tasks-completed() is raw is export(:COLUMNS) { + nqp::if( + nqp::istrue((my $workers := nqp::getattr( + nqp::decont($*SCHEDULER),ThreadPoolScheduler,'$!affinity-workers' + ))), + completed($workers) + ) +} + # Telemetry -------------------------------------------------------------------- class Telemetry { has int $!cpu-user; @@ -218,6 +227,7 @@ class Telemetry { has int $!timer-tasks-queued; has int $!timer-tasks-completed; has int $!affinity-workers; + has int $!affinity-tasks-completed; submethod BUILD() { my \rusage = nqp::getrusage; @@ -268,6 +278,7 @@ class Telemetry { if nqp::getattr($scheduler,ThreadPoolScheduler,'$!affinity-workers') -> \workers { $!affinity-workers = nqp::elems(workers); + $!affinity-tasks-completed = completed(workers); } } @@ -366,6 +377,13 @@ class Telemetry { multi method affinity-workers(Telemetry:U:) { affinity-workers } multi method affinity-workers(Telemetry:D:) { $!affinity-workers } + multi method affinity-tasks-completed(Telemetry:U:) is raw { + affinity-tasks-completed + } + multi method affinity-tasks-completed(Telemetry:D:) is raw { + $!affinity-tasks-completed + } + multi method Str(Telemetry:D:) { "$.cpu / $!wallclock" } @@ -406,6 +424,7 @@ class Telemetry::Period is Telemetry { int :$timer-tasks-queued, int :$timer-tasks-completed, int :$affinity-workers, + int :$affinity-tasks-completed, ) { self.new( $cpu-user, $cpu-sys, @@ -414,7 +433,7 @@ class Telemetry::Period is Telemetry { $wallclock, $supervisor, $general-workers, $general-tasks-queued, $general-tasks-completed, $timer-workers, $timer-tasks-queued, $timer-tasks-completed, - $affinity-workers + $affinity-workers, $affinity-tasks-completed, ) } @@ -445,58 +464,61 @@ class Telemetry::Period is Telemetry { int $timer-tasks-queued, int $timer-tasks-completed, int $affinity-workers, + int $affinity-tasks-completed, ) { my $period := nqp::create(Telemetry::Period); nqp::bindattr_i($period,Telemetry, - '$!cpu-user', $cpu-user); + '$!cpu-user', $cpu-user); nqp::bindattr_i($period,Telemetry, - '$!cpu-sys', $cpu-sys); + '$!cpu-sys', $cpu-sys); nqp::bindattr_i($period,Telemetry, - '$!max-rss', $max-rss); + '$!max-rss', $max-rss); nqp::bindattr_i($period,Telemetry, - '$!ix-rss', $ix-rss); + '$!ix-rss', $ix-rss); nqp::bindattr_i($period,Telemetry, - '$!id-rss', $id-rss); + '$!id-rss', $id-rss); nqp::bindattr_i($period,Telemetry, - '$!is-rss', $is-rss); + '$!is-rss', $is-rss); nqp::bindattr_i($period,Telemetry, - '$!min-flt', $min-flt); + '$!min-flt', $min-flt); nqp::bindattr_i($period,Telemetry, - '$!maj-flt', $maj-flt); + '$!maj-flt', $maj-flt); nqp::bindattr_i($period,Telemetry, - '$!nswap', $nswap); + '$!nswap', $nswap); nqp::bindattr_i($period,Telemetry, - '$!inblock', $inblock); + '$!inblock', $inblock); nqp::bindattr_i($period,Telemetry, - '$!outblock', $outblock); + '$!outblock', $outblock); nqp::bindattr_i($period,Telemetry, - '$!msgsnd', $msgsnd); + '$!msgsnd', $msgsnd); nqp::bindattr_i($period,Telemetry, - '$!msgrcv', $msgrcv); + '$!msgrcv', $msgrcv); nqp::bindattr_i($period,Telemetry, - '$!nsignals', $nsignals); + '$!nsignals', $nsignals); nqp::bindattr_i($period,Telemetry, - '$!nvcsw', $nvcsw); + '$!nvcsw', $nvcsw); nqp::bindattr_i($period,Telemetry, - '$!invcsw', $invcsw); + '$!invcsw', $invcsw); nqp::bindattr_i($period,Telemetry, - '$!wallclock', $wallclock); + '$!wallclock', $wallclock); nqp::bindattr_i($period,Telemetry, - '$!supervisor', $supervisor); + '$!supervisor', $supervisor); nqp::bindattr_i($period,Telemetry, - '$!general-workers', $general-workers); + '$!general-workers', $general-workers); nqp::bindattr_i($period,Telemetry, - '$!general-tasks-queued', $general-tasks-queued); + '$!general-tasks-queued', $general-tasks-queued); nqp::bindattr_i($period,Telemetry, - '$!general-tasks-completed',$general-tasks-completed); + '$!general-tasks-completed', $general-tasks-completed); nqp::bindattr_i($period,Telemetry, - '$!timer-workers', $timer-workers); + '$!timer-workers', $timer-workers); nqp::bindattr_i($period,Telemetry, - '$!timer-tasks-queued', $timer-tasks-queued); + '$!timer-tasks-queued', $timer-tasks-queued); nqp::bindattr_i($period,Telemetry, - '$!timer-tasks-completed', $timer-tasks-completed); + '$!timer-tasks-completed', $timer-tasks-completed); nqp::bindattr_i($period,Telemetry, - '$!affinity-workers', $affinity-workers); + '$!affinity-workers', $affinity-workers); + nqp::bindattr_i($period,Telemetry, + '$!affinity-tasks-completed',$affinity-tasks-completed); $period } @@ -552,6 +574,8 @@ class Telemetry::Period is Telemetry { nqp::getattr_i(self,Telemetry,'$!timer-tasks-completed') }), :affinity-workers({ nqp::getattr_i(self,Telemetry,'$!affinity-workers') + }), :affinity-tasks-completed({ + nqp::getattr_i(self,Telemetry,'$!affinity-tasks-completed') }))" } @@ -679,6 +703,10 @@ multi sub infix:<->(Telemetry:D \a, Telemetry:D \b) is export { nqp::sub_i( nqp::getattr_i($a,Telemetry,'$!affinity-workers'), nqp::getattr_i($b,Telemetry,'$!affinity-workers') + ), + nqp::sub_i( + nqp::getattr_i($a,Telemetry,'$!affinity-tasks-completed'), + nqp::getattr_i($b,Telemetry,'$!affinity-tasks-completed') ) ) } @@ -739,6 +767,9 @@ my %format = affinity-workers => [ " aw", { hide0(.affinity-workers) }, "The number of affinity threads"], + affinity-tasks-completed => + [ " atc", { hide0(.affinity-tasks-completed,8) }, + "The number of tasks completed in affinity threads"], cpu => [" cpu", { .cpu.fmt('%8d') }, "The amount of CPU used (in microseconds)"], @@ -837,7 +868,7 @@ multi sub report( @columns = $rrc.comb( /<[\w-]>+/ ); } else { - @columns = ; + @columns = ; } } From b380230dd99743dd8f16b219d2f24739714c2778 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Thu, 2 Nov 2017 18:59:25 +0100 Subject: [PATCH 667/692] Add support for Telemetry affinity-tasks-queued --- lib/Telemetry.pm6 | 80 +++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 74 insertions(+), 6 deletions(-) diff --git a/lib/Telemetry.pm6 b/lib/Telemetry.pm6 index 3b8f1c26dd8..eb813d22033 100644 --- a/lib/Telemetry.pm6 +++ b/lib/Telemetry.pm6 @@ -26,6 +26,7 @@ constant INVCSW = 17; my num $start = Rakudo::Internals.INITTIME; my int $b2kb = nqp::atkey(nqp::backendconfig,q/osname/) eq 'darwin' ?? 10 !! 0; +# calculate number of tasks completed for a worker list sub completed(\workers) is raw { my int $elems = nqp::elems(workers); my int $completed; @@ -43,6 +44,25 @@ sub completed(\workers) is raw { $completed } +# calculate number of tasks queued for an affinity worker list, which has +# a separate queue for each worker +sub queued(\workers) is raw { + my int $elems = nqp::elems(workers); + my int $queued; + my int $i = -1; + nqp::while( + nqp::islt_i(($i = nqp::add_i($i,1)),$elems), + nqp::stmts( + (my $w := nqp::atpos(workers,$i)), + ($queued = nqp::add_i( + $queued, + nqp::elems(nqp::getattr($w,$w.WHAT,'$!queue')) + )) + ) + ); + $queued +} + # Subroutines that are exported with :COLUMNS ---------------------------------- sub cpu() is raw is export(:COLUMNS) { my \rusage = nqp::getrusage; @@ -191,6 +211,15 @@ sub affinity-workers() is raw is export(:COLUMNS) { ) } +sub affinity-tasks-queued() is raw is export(:COLUMNS) { + nqp::if( + nqp::istrue((my $workers := nqp::getattr( + nqp::decont($*SCHEDULER),ThreadPoolScheduler,'$!affinity-workers' + ))), + queued($workers) + ) +} + sub affinity-tasks-completed() is raw is export(:COLUMNS) { nqp::if( nqp::istrue((my $workers := nqp::getattr( @@ -227,6 +256,7 @@ class Telemetry { has int $!timer-tasks-queued; has int $!timer-tasks-completed; has int $!affinity-workers; + has int $!affinity-tasks-queued; has int $!affinity-tasks-completed; submethod BUILD() { @@ -277,8 +307,26 @@ class Telemetry { } if nqp::getattr($scheduler,ThreadPoolScheduler,'$!affinity-workers') -> \workers { - $!affinity-workers = nqp::elems(workers); - $!affinity-tasks-completed = completed(workers); + my int $elems = $!affinity-workers = nqp::elems(workers); + my int $completed; + my int $queued; + my int $i = -1; + nqp::while( + nqp::islt_i(($i = nqp::add_i($i,1)),$elems), + nqp::stmts( + (my $w := nqp::atpos(workers,$i)), + ($completed = nqp::add_i( + $completed, + nqp::getattr_i($w,$w.WHAT,'$!total') + )), + ($queued = nqp::add_i( + $queued, + nqp::elems(nqp::getattr($w,$w.WHAT,'$!queue')) + )) + ) + ); + $!affinity-tasks-queued = $queued; + $!affinity-tasks-completed = $completed; } } @@ -377,6 +425,13 @@ class Telemetry { multi method affinity-workers(Telemetry:U:) { affinity-workers } multi method affinity-workers(Telemetry:D:) { $!affinity-workers } + multi method affinity-tasks-queued(Telemetry:U:) is raw { + affinity-tasks-queued + } + multi method affinity-tasks-queued(Telemetry:D:) is raw { + $!affinity-tasks-queued + } + multi method affinity-tasks-completed(Telemetry:U:) is raw { affinity-tasks-completed } @@ -424,6 +479,7 @@ class Telemetry::Period is Telemetry { int :$timer-tasks-queued, int :$timer-tasks-completed, int :$affinity-workers, + int :$affinity-tasks-queued, int :$affinity-tasks-completed, ) { self.new( @@ -433,7 +489,7 @@ class Telemetry::Period is Telemetry { $wallclock, $supervisor, $general-workers, $general-tasks-queued, $general-tasks-completed, $timer-workers, $timer-tasks-queued, $timer-tasks-completed, - $affinity-workers, $affinity-tasks-completed, + $affinity-workers, $affinity-tasks-queued, $affinity-tasks-completed, ) } @@ -464,6 +520,7 @@ class Telemetry::Period is Telemetry { int $timer-tasks-queued, int $timer-tasks-completed, int $affinity-workers, + int $affinity-tasks-queued, int $affinity-tasks-completed, ) { my $period := nqp::create(Telemetry::Period); @@ -517,6 +574,8 @@ class Telemetry::Period is Telemetry { '$!timer-tasks-completed', $timer-tasks-completed); nqp::bindattr_i($period,Telemetry, '$!affinity-workers', $affinity-workers); + nqp::bindattr_i($period,Telemetry, + '$!affinity-tasks-queued',$affinity-tasks-queued); nqp::bindattr_i($period,Telemetry, '$!affinity-tasks-completed',$affinity-tasks-completed); $period @@ -574,6 +633,8 @@ class Telemetry::Period is Telemetry { nqp::getattr_i(self,Telemetry,'$!timer-tasks-completed') }), :affinity-workers({ nqp::getattr_i(self,Telemetry,'$!affinity-workers') + }), :affinity-tasks-queued({ + nqp::getattr_i(self,Telemetry,'$!affinity-tasks-queued') }), :affinity-tasks-completed({ nqp::getattr_i(self,Telemetry,'$!affinity-tasks-completed') }))" @@ -704,6 +765,10 @@ multi sub infix:<->(Telemetry:D \a, Telemetry:D \b) is export { nqp::getattr_i($a,Telemetry,'$!affinity-workers'), nqp::getattr_i($b,Telemetry,'$!affinity-workers') ), + nqp::sub_i( + nqp::getattr_i($a,Telemetry,'$!affinity-tasks-queued'), + nqp::getattr_i($b,Telemetry,'$!affinity-tasks-queued') + ), nqp::sub_i( nqp::getattr_i($a,Telemetry,'$!affinity-tasks-completed'), nqp::getattr_i($b,Telemetry,'$!affinity-tasks-completed') @@ -764,12 +829,15 @@ sub hide0(\value, int $size = 3) { # Set up how to handle report generation (in alphabetical order) my %format = - affinity-workers => - [ " aw", { hide0(.affinity-workers) }, - "The number of affinity threads"], affinity-tasks-completed => [ " atc", { hide0(.affinity-tasks-completed,8) }, "The number of tasks completed in affinity threads"], + affinity-tasks-queued => + [ "atq", { hide0(.affinity-tasks-queued) }, + "The number of tasks queued for execution in affinity threads"], + affinity-workers => + [ " aw", { hide0(.affinity-workers) }, + "The number of affinity threads"], cpu => [" cpu", { .cpu.fmt('%8d') }, "The amount of CPU used (in microseconds)"], From ef84aafc016e03bd0aad539041537a58c6f036ed Mon Sep 17 00:00:00 2001 From: Nick Logan Date: Thu, 2 Nov 2017 15:11:03 -0400 Subject: [PATCH 668/692] Remove invalid close() candidate Supply has no close method --- src/core/io_operators.pm | 1 - 1 file changed, 1 deletion(-) diff --git a/src/core/io_operators.pm b/src/core/io_operators.pm index c9c156c0793..106d254ef95 100644 --- a/src/core/io_operators.pm +++ b/src/core/io_operators.pm @@ -109,7 +109,6 @@ multi sub getc (IO::Handle:D $fh = $*ARGFILES) { $fh.getc } proto sub close(|) { * } multi sub close(IO::Handle:D $fh) { $fh.close } multi sub close(Channel:D $channel) { $channel.close } -multi sub close(Supply:D $supply) { $supply.close } proto sub slurp(|) { * } multi sub slurp(IO::Handle:D $fh = $*ARGFILES, |c) { $fh.slurp(|c) } From dbf0a21f9007261be5f964c5013e0b6e2a0faa4c Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Thu, 2 Nov 2017 23:42:47 +0000 Subject: [PATCH 669/692] Bump NQP --- tools/build/NQP_REVISION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/build/NQP_REVISION b/tools/build/NQP_REVISION index 5cf66d791e5..36034bd782b 100644 --- a/tools/build/NQP_REVISION +++ b/tools/build/NQP_REVISION @@ -1 +1 @@ -2017.10-10-g626ea0206 +2017.10-32-ga3f7bb8 From fccc75152d723f5ba91794d997bdcbcc39118058 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Fri, 3 Nov 2017 14:51:56 +0100 Subject: [PATCH 670/692] Quite extensive refactor of Telemetry - just store the nqp::getrusage struct instead of already dissecting - makes Telemetry.new about 15% faster - adapt all instance method logic accordingly - moves burden to Telemetry::Period creation, but that's when we need and all of the snapping is already done - store wallclock internall as nqp::time_n value, without conversion - makes Telemetry new about 5% faster - outside API is still microseconds - adapt all calculations depending on wallclock accordingly - use arrays of names of rusage struct and scheduler info - instead of writing it all out - remove "ics" from the default report - not sure what info it really gives anyway - make proto's use {*} as per new guidelines - makes source-file about 20% smaller, hopefully aiding in maintainability --- lib/Telemetry.pm6 | 505 ++++++++++++++-------------------------------- 1 file changed, 150 insertions(+), 355 deletions(-) diff --git a/lib/Telemetry.pm6 b/lib/Telemetry.pm6 index eb813d22033..b1064416ca0 100644 --- a/lib/Telemetry.pm6 +++ b/lib/Telemetry.pm6 @@ -21,6 +21,7 @@ constant MSGRCV = 14; constant NSIGNALS = 15; constant NVCSW = 16; constant INVCSW = 17; +constant RUSAGE_ELEMS = 18; # Helper stuff ----------------------------------------------------------------- my num $start = Rakudo::Internals.INITTIME; @@ -63,6 +64,20 @@ sub queued(\workers) is raw { $queued } +# usable names of attributes that are part of getrusage struct +constant @rusage_names = << "" "" "" "" # first 4 are special + max-rss ix-rss id-rss is-rss min-flt maj-flt nswap + inblock outblock msgsnd msgrcv nsignals nvcsw invcsw +>>; + +# names of attributes that are native integers +constant @scheduler_names = < + $!supervisor + $!general-workers $!general-tasks-queued $!general-tasks-completed + $!timer-workers $!timer-tasks-queued $!timer-tasks-completed + $!affinity-workers $!affinity-tasks-queued $!affinity-tasks-completed +>; + # Subroutines that are exported with :COLUMNS ---------------------------------- sub cpu() is raw is export(:COLUMNS) { my \rusage = nqp::getrusage; @@ -231,23 +246,8 @@ sub affinity-tasks-completed() is raw is export(:COLUMNS) { # Telemetry -------------------------------------------------------------------- class Telemetry { - has int $!cpu-user; - has int $!cpu-sys; - has int $!max-rss; - has int $!ix-rss; - has int $!id-rss; - has int $!is-rss; - has int $!min-flt; - has int $!maj-flt; - has int $!nswap; - has int $!inblock; - has int $!outblock; - has int $!msgsnd; - has int $!msgrcv; - has int $!nsignals; - has int $!nvcsw; - has int $!invcsw; - has int $!wallclock; + has Mu $!rusage; + has num $!wallclock; has int $!supervisor; has int $!general-workers; has int $!general-tasks-queued; @@ -260,28 +260,8 @@ class Telemetry { has int $!affinity-tasks-completed; submethod BUILD() { - my \rusage = nqp::getrusage; - $!cpu-user = nqp::atpos_i(rusage,UTIME_SEC) * 1000000 - + nqp::atpos_i(rusage,UTIME_MSEC); - $!cpu-sys = nqp::atpos_i(rusage,STIME_SEC) * 1000000 - + nqp::atpos_i(rusage,STIME_MSEC); - $!max-rss = nqp::bitshiftr_i(nqp::atpos_i(rusage,MAX_RSS),$b2kb); - $!ix-rss = nqp::bitshiftr_i(nqp::atpos_i(rusage,IX_RSS),$b2kb); - $!id-rss = nqp::bitshiftr_i(nqp::atpos_i(rusage,ID_RSS),$b2kb); - $!is-rss = nqp::bitshiftr_i(nqp::atpos_i(rusage,IS_RSS),$b2kb); - $!min-flt = nqp::atpos_i(rusage,MIN_FLT); - $!maj-flt = nqp::atpos_i(rusage,MAJ_FLT); - $!nswap = nqp::atpos_i(rusage,NSWAP); - $!inblock = nqp::atpos_i(rusage,INBLOCK); - $!outblock = nqp::atpos_i(rusage,OUTBLOCK); - $!msgsnd = nqp::atpos_i(rusage,MSGSND); - $!msgrcv = nqp::atpos_i(rusage,MSGRCV); - $!nsignals = nqp::atpos_i(rusage,NSIGNALS); - $!nvcsw = nqp::atpos_i(rusage,NVCSW); - $!invcsw = nqp::atpos_i(rusage,INVCSW); - - $!wallclock = - nqp::fromnum_I(1000000 * nqp::sub_n(nqp::time_n,$start),Int); + $!rusage := nqp::getrusage; + $!wallclock = nqp::time_n; my $scheduler := nqp::decont($*SCHEDULER); $!supervisor = 1 @@ -332,58 +312,85 @@ class Telemetry { } multi method cpu(Telemetry:U:) is raw { cpu } - multi method cpu(Telemetry:D:) is raw { nqp::add_i($!cpu-user,$!cpu-sys) } + multi method cpu(Telemetry:D:) is raw { + nqp::atpos_i($!rusage,UTIME_SEC) * 1000000 + + nqp::atpos_i($!rusage,UTIME_MSEC) + + nqp::atpos_i($!rusage,STIME_SEC) * 1000000 + + nqp::atpos_i($!rusage,STIME_MSEC) + } - multi method cpu-user(Telemetry:U:) is raw { cpu-user } - multi method cpu-user(Telemetry:D:) is raw { $!cpu-user } + multi method cpu-user(Telemetry:U:) is raw { cpu-user } + multi method cpu-user(Telemetry:D:) is raw { + nqp::atpos_i($!rusage,UTIME_SEC) * 1000000 + + nqp::atpos_i($!rusage,UTIME_MSEC) + } - multi method cpu-sys(Telemetry:U:) is raw { cpu-sys } - multi method cpu-sys(Telemetry:D:) is raw { $!cpu-sys } + multi method cpu-sys(Telemetry:U:) is raw { cpu-sys } + multi method cpu-sys(Telemetry:D:) is raw { + nqp::atpos_i($!rusage,STIME_SEC) * 1000000 + + nqp::atpos_i($!rusage,STIME_MSEC) + } - multi method max-rss(Telemetry:U:) is raw { max-rss } - multi method max-rss(Telemetry:D:) is raw { $!max-rss } + multi method max-rss(Telemetry:U:) is raw { max-rss } + multi method max-rss(Telemetry:D:) is raw { + nqp::bitshiftr_i(nqp::atpos_i($!rusage,MAX_RSS),$b2kb) + } - multi method ix-rss(Telemetry:U:) is raw { ix-rss } - multi method ix-rss(Telemetry:D:) is raw { $!ix-rss } + multi method ix-rss(Telemetry:U:) is raw { ix-rss } + multi method ix-rss(Telemetry:D:) is raw { + nqp::bitshiftr_i(nqp::atpos_i($!rusage,IX_RSS),$b2kb) + } multi method id-rss(Telemetry:U:) is raw { id-rss } - multi method id-rss(Telemetry:D:) is raw { $!id-rss } + multi method id-rss(Telemetry:D:) is raw { + nqp::bitshiftr_i(nqp::atpos_i($!rusage,ID_RSS),$b2kb) + } - multi method is-rss(Telemetry:U:) is raw { is-rss } - multi method is-rss(Telemetry:D:) is raw { $!is-rss } + multi method is-rss(Telemetry:U:) is raw { is-rss } + multi method is-rss(Telemetry:D:) is raw { + nqp::bitshiftr_i(nqp::atpos_i($!rusage,IS_RSS),$b2kb) + } - multi method min-flt(Telemetry:U:) is raw { min-flt } - multi method min-flt(Telemetry:D:) is raw { $!min-flt } + multi method min-flt(Telemetry:U:) is raw { min-flt } + multi method min-flt(Telemetry:D:) is raw { nqp::atpos_i($!rusage,MIN_FLT) } - multi method maj-flt(Telemetry:U:) is raw { maj-flt } - multi method maj-flt(Telemetry:D:) is raw { $!maj-flt } + multi method maj-flt(Telemetry:U:) is raw { maj-flt } + multi method maj-flt(Telemetry:D:) is raw { nqp::atpos_i($!rusage,MAJ_FLT) } - multi method nswap(Telemetry:U:) is raw { nswap } - multi method nswap(Telemetry:D:) is raw { $!nswap } + multi method nswap(Telemetry:U:) is raw { nswap } + multi method nswap(Telemetry:D:) is raw { nqp::atpos_i($!rusage,NSWAP) } - multi method inblock(Telemetry:U:) is raw { inblock } - multi method inblock(Telemetry:D:) is raw { $!inblock } + multi method inblock(Telemetry:U:) is raw { inblock } + multi method inblock(Telemetry:D:) is raw { + nqp::atpos_i($!rusage,INBLOCK) + } - multi method outblock(Telemetry:U:) is raw { outblock } - multi method outblock(Telemetry:D:) is raw { $!outblock } + multi method outblock(Telemetry:U:) is raw { outblock } + multi method outblock(Telemetry:D:) is raw { + nqp::atpos_i($!rusage,OUTBLOCK) + } - multi method msgsnd(Telemetry:U:) is raw { msgsnd } - multi method msgsnd(Telemetry:D:) is raw { $!msgsnd } + multi method msgsnd(Telemetry:U:) is raw { msgsnd } + multi method msgsnd(Telemetry:D:) is raw { nqp::atpos_i($!rusage,MSGSND) } - multi method msgrcv(Telemetry:U:) is raw { msgrcv } - multi method msgrcv(Telemetry:D:) is raw { $!msgrcv } + multi method msgrcv(Telemetry:U:) is raw { msgrcv } + multi method msgrcv(Telemetry:D:) is raw { nqp::atpos_i($!rusage,MSGRCV) } - multi method nsignals(Telemetry:U:) is raw { nsignals } - multi method nsignals(Telemetry:D:) is raw { $!nsignals } + multi method nsignals(Telemetry:U:) is raw { nsignals } + multi method nsignals(Telemetry:D:) is raw { + nqp::atpos_i($!rusage,NSIGNALS) + } - multi method nvcsw(Telemetry:U:) is raw { nvcsw } - multi method nvcsw(Telemetry:D:) is raw { $!nvcsw } + multi method nvcsw(Telemetry:U:) is raw { nvcsw } + multi method nvcsw(Telemetry:D:) is raw { nqp::atpos_i($!rusage,NVCSW) } - multi method invcsw(Telemetry:U:) is raw { invcsw } - multi method invcsw(Telemetry:D:) is raw { $!invcsw } + multi method invcsw(Telemetry:U:) is raw { invcsw } + multi method invcsw(Telemetry:D:) is raw { nqp::atpos_i($!rusage,INVCSW) } - multi method wallclock(Telemetry:U:) is raw { wallclock } - multi method wallclock(Telemetry:D:) is raw { $!wallclock } + multi method wallclock(Telemetry:U:) is raw { wallclock } + multi method wallclock(Telemetry:D:) is raw { + nqp::fromnum_I(1000000 * nqp::sub_n($!wallclock,$start),Int) + } multi method supervisor(Telemetry:U:) is raw { supervisor } multi method supervisor(Telemetry:D:) is raw { $!supervisor } @@ -440,10 +447,10 @@ class Telemetry { } multi method Str(Telemetry:D:) { - "$.cpu / $!wallclock" + "$.cpu / $.wallclock" } multi method gist(Telemetry:D:) { - "$.cpu / $!wallclock" + "$.cpu / $.wallclock" } multi method AT-KEY(Telemetry:D: $key) { self."$key"() } @@ -471,182 +478,51 @@ class Telemetry::Period is Telemetry { int :$nvcsw, int :$invcsw, int :$wallclock, - int :$supervisor, - int :$general-workers, - int :$general-tasks-queued, - int :$general-tasks-completed, - int :$timer-workers, - int :$timer-tasks-queued, - int :$timer-tasks-completed, - int :$affinity-workers, - int :$affinity-tasks-queued, - int :$affinity-tasks-completed, - ) { - self.new( - $cpu-user, $cpu-sys, - $max-rss, $ix-rss, $id-rss, $is-rss, $min-flt, $maj-flt, $nswap, - $inblock, $outblock, $msgsnd, $msgrcv, $nsignals, $nvcsw, $invcsw, - $wallclock, $supervisor, - $general-workers, $general-tasks-queued, $general-tasks-completed, - $timer-workers, $timer-tasks-queued, $timer-tasks-completed, - $affinity-workers, $affinity-tasks-queued, $affinity-tasks-completed, - ) - } - - # The internal .new with faster positional parameter interface - multi method new(Telemetry::Period: - int $cpu-user, - int $cpu-sys, - int $max-rss, - int $ix-rss, - int $id-rss, - int $is-rss, - int $min-flt, - int $maj-flt, - int $nswap, - int $inblock, - int $outblock, - int $msgsnd, - int $msgrcv, - int $nsignals, - int $nvcsw, - int $invcsw, - int $wallclock, - int $supervisor, - int $general-workers, - int $general-tasks-queued, - int $general-tasks-completed, - int $timer-workers, - int $timer-tasks-queued, - int $timer-tasks-completed, - int $affinity-workers, - int $affinity-tasks-queued, - int $affinity-tasks-completed, + # non-special handling of other native integer nameds caught in %_ ) { - my $period := nqp::create(Telemetry::Period); - nqp::bindattr_i($period,Telemetry, - '$!cpu-user', $cpu-user); - nqp::bindattr_i($period,Telemetry, - '$!cpu-sys', $cpu-sys); - nqp::bindattr_i($period,Telemetry, - '$!max-rss', $max-rss); - nqp::bindattr_i($period,Telemetry, - '$!ix-rss', $ix-rss); - nqp::bindattr_i($period,Telemetry, - '$!id-rss', $id-rss); - nqp::bindattr_i($period,Telemetry, - '$!is-rss', $is-rss); - nqp::bindattr_i($period,Telemetry, - '$!min-flt', $min-flt); - nqp::bindattr_i($period,Telemetry, - '$!maj-flt', $maj-flt); - nqp::bindattr_i($period,Telemetry, - '$!nswap', $nswap); - nqp::bindattr_i($period,Telemetry, - '$!inblock', $inblock); - nqp::bindattr_i($period,Telemetry, - '$!outblock', $outblock); - nqp::bindattr_i($period,Telemetry, - '$!msgsnd', $msgsnd); - nqp::bindattr_i($period,Telemetry, - '$!msgrcv', $msgrcv); - nqp::bindattr_i($period,Telemetry, - '$!nsignals', $nsignals); - nqp::bindattr_i($period,Telemetry, - '$!nvcsw', $nvcsw); - nqp::bindattr_i($period,Telemetry, - '$!invcsw', $invcsw); - nqp::bindattr_i($period,Telemetry, - '$!wallclock', $wallclock); - nqp::bindattr_i($period,Telemetry, - '$!supervisor', $supervisor); - nqp::bindattr_i($period,Telemetry, - '$!general-workers', $general-workers); - nqp::bindattr_i($period,Telemetry, - '$!general-tasks-queued', $general-tasks-queued); - nqp::bindattr_i($period,Telemetry, - '$!general-tasks-completed', $general-tasks-completed); - nqp::bindattr_i($period,Telemetry, - '$!timer-workers', $timer-workers); - nqp::bindattr_i($period,Telemetry, - '$!timer-tasks-queued', $timer-tasks-queued); - nqp::bindattr_i($period,Telemetry, - '$!timer-tasks-completed', $timer-tasks-completed); - nqp::bindattr_i($period,Telemetry, - '$!affinity-workers', $affinity-workers); - nqp::bindattr_i($period,Telemetry, - '$!affinity-tasks-queued',$affinity-tasks-queued); - nqp::bindattr_i($period,Telemetry, - '$!affinity-tasks-completed',$affinity-tasks-completed); + my $period := nqp::create(self); + + # set all fields in the rusage struct + my \rusage = nqp::getrusage; # make sure we get the same thing + nqp::bindpos_i(rusage, UTIME_SEC,$cpu-user div 1000000); + nqp::bindpos_i(rusage,UTIME_MSEC,$cpu-user % 1000000); + nqp::bindpos_i(rusage, STIME_SEC,$cpu-sys div 1000000); + nqp::bindpos_i(rusage,STIME_MSEC,$cpu-sys % 1000000); + for @rusage_names.kv -> int $i, $name { + nqp::bindpos_i($period,$i,%_{$name.substr(2)}) + if $name && %_.EXISTS-KEY($name.substr(2)) + } + + # create object with special cases + nqp::bindattr($period,Telemetry,'$!rusage',rusage); + nqp::bindattr_n($period,Telemetry,'$!wallclock', + nqp::add_n($start,$wallclock / 1000000) + ); + + # diff all attribute_i attributes + nqp::bindattr_i($period,Telemetry,$_,%_{.substr(2)}) + if %_{.substr(2)}:exists for @scheduler_names; + $period } # For roundtripping multi method perl(Telemetry::Period:D:) { - "Telemetry::Period.new(:cpu-user({ - nqp::getattr_i(self,Telemetry,'$!cpu-user') - }), :cpu-sys({ - nqp::getattr_i(self,Telemetry,'$!cpu-sys') - }), :max-rss({ - nqp::getattr_i(self,Telemetry,'$!max-rss') - }), :ix-rss({ - nqp::getattr_i(self,Telemetry,'$!ix-rss') - }), :id-rss({ - nqp::getattr_i(self,Telemetry,'$!id-rss') - }), :is-rss({ - nqp::getattr_i(self,Telemetry,'$!is-rss') - }), :min-flt({ - nqp::getattr_i(self,Telemetry,'$!min-flt') - }), :maj-flt({ - nqp::getattr_i(self,Telemetry,'$!maj-flt') - }), :nswap({ - nqp::getattr_i(self,Telemetry,'$!nswap') - }), :inblock({ - nqp::getattr_i(self,Telemetry,'$!inblock') - }), :outblock({ - nqp::getattr_i(self,Telemetry,'$!outblock') - }), :msgsnd({ - nqp::getattr_i(self,Telemetry,'$!msgsnd') - }), :msgrcv({ - nqp::getattr_i(self,Telemetry,'$!msgrcv') - }), :nsignals({ - nqp::getattr_i(self,Telemetry,'$!nsignals') - }), :nvcsw({ - nqp::getattr_i(self,Telemetry,'$!nvcsw') - }), :invcsw({ - nqp::getattr_i(self,Telemetry,'$!invcsw') - }), :wallclock({ - nqp::getattr_i(self,Telemetry,'$!wallclock') - }), :supervisor({ - nqp::getattr_i(self,Telemetry,'$!supervisor') - }), :general-workers({ - nqp::getattr_i(self,Telemetry,'$!general-workers') - }), :general-tasks-queued({ - nqp::getattr_i(self,Telemetry,'$!general-tasks-queued') - }), :general-tasks-completed({ - nqp::getattr_i(self,Telemetry,'$!general-tasks-completed') - }), :timer-workers({ - nqp::getattr_i(self,Telemetry,'$!timer-workers') - }), :timer-tasks-queued({ - nqp::getattr_i(self,Telemetry,'$!timer-tasks-queued') - }), :timer-tasks-completed({ - nqp::getattr_i(self,Telemetry,'$!timer-tasks-completed') - }), :affinity-workers({ - nqp::getattr_i(self,Telemetry,'$!affinity-workers') - }), :affinity-tasks-queued({ - nqp::getattr_i(self,Telemetry,'$!affinity-tasks-queued') - }), :affinity-tasks-completed({ - nqp::getattr_i(self,Telemetry,'$!affinity-tasks-completed') - }))" + my \rusage := nqp::getattr(self,Telemetry,'$!rusage'); + + "Telemetry::Period.new(:cpu-user($.cpu-user),:cpu-sys($.cpu-sys)," + ~ @rusage_names.kv.map( -> int $i, $name { + ":$name\({nqp::atpos_i(rusage,$i)})" if $name + }).join(",") + ~ @scheduler_names.map({ + ":$_.substr(2)\({nqp::getattr_i(self,Telemetry,$_)})" + }).join(",") } my int $cores = Kernel.cpu-cores; method cpus() { - (my int $wallclock = nqp::getattr_i(self,Telemetry,'$!wallclock')) - ?? nqp::add_i( - nqp::getattr_i(self,Telemetry,'$!cpu-user'), - nqp::getattr_i(self,Telemetry,'$!cpu-sys') - ) / $wallclock + (my int $wallclock = self.wallclock) + ?? self.cpu / $wallclock !! $cores } @@ -663,124 +539,43 @@ multi sub infix:<->(Telemetry:U \a, Telemetry:D \b) is export { a.new - b } multi sub infix:<->(Telemetry:D \a, Telemetry:D \b) is export { my $a := nqp::decont(a); my $b := nqp::decont(b); - - Telemetry::Period.new( - nqp::sub_i( - nqp::getattr_i($a,Telemetry,'$!cpu-user'), - nqp::getattr_i($b,Telemetry,'$!cpu-user') - ), - nqp::sub_i( - nqp::getattr_i($a,Telemetry,'$!cpu-sys'), - nqp::getattr_i($b,Telemetry,'$!cpu-sys') - ), - nqp::sub_i( - nqp::getattr_i($a,Telemetry,'$!max-rss'), - nqp::getattr_i($b,Telemetry,'$!max-rss') - ), - nqp::sub_i( - nqp::getattr_i($a,Telemetry,'$!ix-rss'), - nqp::getattr_i($b,Telemetry,'$!ix-rss') - ), - nqp::sub_i( - nqp::getattr_i($a,Telemetry,'$!id-rss'), - nqp::getattr_i($b,Telemetry,'$!id-rss') - ), - nqp::sub_i( - nqp::getattr_i($a,Telemetry,'$!is-rss'), - nqp::getattr_i($b,Telemetry,'$!is-rss') - ), - nqp::sub_i( - nqp::getattr_i($a,Telemetry,'$!min-flt'), - nqp::getattr_i($b,Telemetry,'$!min-flt') - ), - nqp::sub_i( - nqp::getattr_i($a,Telemetry,'$!maj-flt'), - nqp::getattr_i($b,Telemetry,'$!maj-flt') - ), - nqp::sub_i( - nqp::getattr_i($a,Telemetry,'$!nswap'), - nqp::getattr_i($b,Telemetry,'$!nswap') - ), - nqp::sub_i( - nqp::getattr_i($a,Telemetry,'$!inblock'), - nqp::getattr_i($b,Telemetry,'$!inblock') - ), - nqp::sub_i( - nqp::getattr_i($a,Telemetry,'$!outblock'), - nqp::getattr_i($b,Telemetry,'$!outblock') - ), - nqp::sub_i( - nqp::getattr_i($a,Telemetry,'$!msgsnd'), - nqp::getattr_i($b,Telemetry,'$!msgsnd') - ), - nqp::sub_i( - nqp::getattr_i($a,Telemetry,'$!msgrcv'), - nqp::getattr_i($b,Telemetry,'$!msgrcv') - ), - nqp::sub_i( - nqp::getattr_i($a,Telemetry,'$!nsignals'), - nqp::getattr_i($b,Telemetry,'$!nsignals') - ), - nqp::sub_i( - nqp::getattr_i($a,Telemetry,'$!nvcsw'), - nqp::getattr_i($b,Telemetry,'$!nvcsw') - ), - nqp::sub_i( - nqp::getattr_i($a,Telemetry,'$!invcsw'), - nqp::getattr_i($b,Telemetry,'$!invcsw') - ), - nqp::sub_i( - nqp::getattr_i($a,Telemetry,'$!wallclock'), - nqp::getattr_i($b,Telemetry,'$!wallclock') - ), - nqp::sub_i( - nqp::getattr_i($a,Telemetry,'$!supervisor'), - nqp::getattr_i($b,Telemetry,'$!supervisor') - ), - nqp::sub_i( - nqp::getattr_i($a,Telemetry,'$!general-workers'), - nqp::getattr_i($b,Telemetry,'$!general-workers') - ), - nqp::sub_i( - nqp::getattr_i($a,Telemetry,'$!general-tasks-queued'), - nqp::getattr_i($b,Telemetry,'$!general-tasks-queued') - ), - nqp::sub_i( - nqp::getattr_i($a,Telemetry,'$!general-tasks-completed'), - nqp::getattr_i($b,Telemetry,'$!general-tasks-completed') - ), - nqp::sub_i( - nqp::getattr_i($a,Telemetry,'$!timer-workers'), - nqp::getattr_i($b,Telemetry,'$!timer-workers') - ), - nqp::sub_i( - nqp::getattr_i($a,Telemetry,'$!timer-tasks-queued'), - nqp::getattr_i($b,Telemetry,'$!timer-tasks-queued') - ), - nqp::sub_i( - nqp::getattr_i($a,Telemetry,'$!timer-tasks-completed'), - nqp::getattr_i($b,Telemetry,'$!timer-tasks-completed') - ), - nqp::sub_i( - nqp::getattr_i($a,Telemetry,'$!affinity-workers'), - nqp::getattr_i($b,Telemetry,'$!affinity-workers') - ), - nqp::sub_i( - nqp::getattr_i($a,Telemetry,'$!affinity-tasks-queued'), - nqp::getattr_i($b,Telemetry,'$!affinity-tasks-queued') - ), - nqp::sub_i( - nqp::getattr_i($a,Telemetry,'$!affinity-tasks-completed'), - nqp::getattr_i($b,Telemetry,'$!affinity-tasks-completed') + + # create diff of rusage structs + my Mu \rusage-a = nqp::decont(nqp::getattr($a,Telemetry,'$!rusage')); + my Mu \rusage-b = nqp::decont(nqp::getattr($b,Telemetry,'$!rusage')); + my Mu \rusage = nqp::clone(rusage-a); # make sure correct type + my int $i = -1; + nqp::while( + ++$i < RUSAGE_ELEMS, + nqp::bindpos_i(rusage,$i, + nqp::sub_i(nqp::atpos_i(rusage-a,$i),nqp::atpos_i(rusage-b,$i)) ) - ) + ); + + # create object with special cases + my $period := nqp::create(Telemetry::Period); + nqp::bindattr($period,Telemetry,'$!rusage',rusage); + nqp::bindattr_n($period,Telemetry,'$!wallclock', + nqp::add_n($start,nqp::sub_n( + nqp::getattr_n($a,Telemetry,'$!wallclock'), + nqp::getattr_n($b,Telemetry,'$!wallclock') + )) + ); + + # diff all attribute_i attributes + nqp::bindattr_i($period,Telemetry,$_,nqp::sub_i( + nqp::getattr_i($a,Telemetry,$_), + nqp::getattr_i($b,Telemetry,$_) + )) for @scheduler_names; + + $period } # Subroutines that are always exported ----------------------------------------- # Making a Telemetry object procedurally my @snaps; -proto sub snap(|) is export { * } +proto sub snap(|) is export {*} multi sub snap(--> Nil) { @snaps.push(Telemetry.new) } multi sub snap(@s --> Nil) { @s.push(Telemetry.new) } @@ -799,7 +594,7 @@ sub snapper($sleep = 0.1 --> Nil) is export { } # Telemetry::Period objects from a list of Telemetry objects -proto sub periods(|) is export { * } +proto sub periods(|) is export {*} multi sub periods() { my @s = @snaps; @snaps = (); @@ -809,7 +604,7 @@ multi sub periods() { multi sub periods(@s) { (1..^@s).map: { @s[$_] - @s[$_ - 1] } } # Telemetry reporting features ------------------------------------------------- -proto sub report(|) is export { * } +proto sub report(|) is export {*} multi sub report(:@columns, :$legend, :$header-repeat = 32) { my $s := nqp::clone(nqp::getattr(@snaps,List,'$!reified')); nqp::setelems(nqp::getattr(@snaps,List,'$!reified'),0); @@ -936,7 +731,7 @@ multi sub report( @columns = $rrc.comb( /<[\w-]>+/ ); } else { - @columns = ; + @columns = ; } } From 1c2c7d845e87b5e876c8c705f879df7e49f0c1b0 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Fri, 3 Nov 2017 16:44:31 +0100 Subject: [PATCH 671/692] Added formatting capabilities to Telemetry report - :@format named parameter - expects a list with lists of: column name, method name, format, legend - format *without* the preceding '%' --- lib/Telemetry.pm6 | 249 +++++++++++++++++++++++++++------------------- 1 file changed, 144 insertions(+), 105 deletions(-) diff --git a/lib/Telemetry.pm6 b/lib/Telemetry.pm6 index b1064416ca0..ebdcb825539 100644 --- a/lib/Telemetry.pm6 +++ b/lib/Telemetry.pm6 @@ -605,7 +605,7 @@ multi sub periods(@s) { (1..^@s).map: { @s[$_] - @s[$_ - 1] } } # Telemetry reporting features ------------------------------------------------- proto sub report(|) is export {*} -multi sub report(:@columns, :$legend, :$header-repeat = 32) { +multi sub report(:@columns, :$legend, :$header-repeat = 32, :@format) { my $s := nqp::clone(nqp::getattr(@snaps,List,'$!reified')); nqp::setelems(nqp::getattr(@snaps,List,'$!reified'),0); nqp::push($s,Telemetry.new) if nqp::elems($s) == 1; @@ -614,116 +614,143 @@ multi sub report(:@columns, :$legend, :$header-repeat = 32) { :@columns, :$legend, :$header-repeat, + :@format, ); } -# Convert to spaces if numeric value is 0 -sub hide0(\value, int $size = 3) { - value ?? value.fmt("%{$size}d") !! nqp::x(" ",$size) +# some constants for the %format list +constant COLUMN = 0; # short name +constant METHOD = 1; # method name +constant FORMAT = 2; # format (without % prefixed) +constant LEGEND = 3; # legend +constant HEADER = 4; # generated: column header +constant FOOTER = 5; # generated: column footer +constant DISPLAY = 6; # generated: code to execute to display + +sub prepare-format(@raw) is raw { + my %format; + + for @raw -> @info is copy { + my str $column = @info[COLUMN]; + my str $method = @info[METHOD]; + my str $format = @info[FORMAT]; + my int $width = $format; # natives have p5 semantics + my str $empty = nqp::x(" ",$width); + + @info[HEADER] = $column.fmt("%{$width}s"); + @info[FOOTER] = nqp::x("-",$width); + @info[DISPLAY] = -> \value{ value ?? value.fmt("%$format") !! $empty } + + %format{$column} = @info; + %format{$method} = @info if $method ne $column; + } + + %format } +# Set after first run. Unfortunately, cannot do this at compile time as +# apparently we have a bug serializing code blocks living inside data +# structures such as this one. +my %default_format; + # Set up how to handle report generation (in alphabetical order) -my %format = - affinity-tasks-completed => - [ " atc", { hide0(.affinity-tasks-completed,8) }, - "The number of tasks completed in affinity threads"], - affinity-tasks-queued => - [ "atq", { hide0(.affinity-tasks-queued) }, - "The number of tasks queued for execution in affinity threads"], - affinity-workers => - [ " aw", { hide0(.affinity-workers) }, - "The number of affinity threads"], - cpu => - [" cpu", { .cpu.fmt('%8d') }, - "The amount of CPU used (in microseconds)"], - cpu-user => - ["cpu-user", { .cpu.fmt('%8d') }, - "The amount of CPU used in user code (in microseconds)"], - cpu-sys => - [" cpu-sys", { .cpu.fmt('%8d') }, - "The amount of CPU used in system overhead (in microseconds)"], - general-workers => - [ " gw", { hide0(.general-workers) }, - "The number of general worker threads"], - general-tasks-queued => - [ "gtq", { hide0(.general-tasks-queued) }, - "The number of tasks queued for execution in general worker threads"], - general-tasks-completed => - [ " gtc", { hide0(.general-tasks-completed,8) }, - "The number of tasks completed in general worker threads"], - id-rss => - [" id-rss", { hide0(.id-rss,8) }, - "Integral unshared data size (in Kbytes)"], - inblock => - ["inb", { hide0(.inblock) }, - "Number of block input operations"], - invcsw => - [" ics", { hide0(.invcsw,8) }, - "Number of involuntary context switches"], - is-rss => - [" is-rss", { hide0(.id-rss,8) }, - "Integral unshared stack size (in Kbytes)"], - ix-rss => - [" ix-rss", { hide0(.ix-rss,8) }, - "Integral shared text memory size (in Kbytes)"], - maj-flt => - ["aft", { hide0(.maj-flt,3) }, - "Number of page reclaims (ru_majflt)"], - max-rss => - [" max-rss", { hide0(.max-rss,8) }, - "Maximum resident set size (in Kbytes)"], - min-flt => - ["ift", { hide0(.min-flt) }, - "Number of page reclaims (ru_minflt)"], - msgrcv => - ["mrc", { hide0(.msgrcv) }, - "Number of messages received"], - msgsnd => - ["msd", { hide0(.msgsnd) }, - "Number of messages sent"], - nsignals => - ["ngs", { hide0(.nsignals) }, - "Number of signals received"], - nswap => - ["nsw", { hide0(.nswap) }, - "Number of swaps"], - nvcsw => - [" vcs", { hide0(.nvcsw,4) }, - "Number of voluntary context switches"], - outblock => - ["oub", { hide0(.outblock) }, - "Number of block output operations"], - supervisor => - [ "s", { hide0(.supervisor,1) }, - "The number of supervisors"], - timer-workers => - [ " tw", { hide0(.timer-workers) }, - "The number of timer threads"], - timer-tasks-queued => - [ "ttq", { hide0(.timer-tasks-queued) }, - "The number of tasks queued for execution in timer threads"], - timer-tasks-completed => - [ " ttc", { hide0(.timer-tasks-completed,8) }, - "The number of tasks completed in timer threads"], - utilization => - [ " util%", { .utilization.fmt('%6.2f') }, - "Percentage of CPU utilization (0..100%)"], - wallclock => - ["wallclock", { hide0(.wallclock,9) }, - "Number of microseconds elapsed"], +constant @default_format = + << + atc affinity-tasks-completed 8d + "The number of tasks completed in affinity threads" + >>,<< + atq affinity-tasks-queued 3d + "The number of tasks queued for execution in affinity threads" + >>,<< + aw affinity-workers 3d + "The number of affinity threads" + >>,<< + cpu cpu 8d + "The amount of CPU used (in microseconds)" + >>,<< + cpu-user cpu-user 8d + "The amount of CPU used in user code (in microseconds)" + >>,<< + cpu-sys cpu-sys 8d + "The amount of CPU used in system overhead (in microseconds)" + >>,<< + gw general-workers 3d + "The number of general worker threads" + >>,<< + gtq general-tasks-queued 3d + "The number of tasks queued for execution in general worker threads" + >>,<< + gtc general-tasks-completed 8d + "The number of tasks completed in general worker threads" + >>,<< + id-rss id-rss 8d + "Integral unshared data size (in Kbytes)" + >>,<< + inb inblock 3d + "Number of block input operations" + >>,<< + invcsw invcsw 8d + "Number of involuntary context switches" + >>,<< + is-rss is-rss 8d + "Integral unshared stack size (in Kbytes)" + >>,<< + ix-rss ix-rss 8d + "Integral shared text memory size (in Kbytes)" + >>,<< + aft maj-flt 3d + "Number of page reclaims (ru_majflt)" + >>,<< + max-rss max-rss 8d + "Maximum resident set size (in Kbytes)" + >>,<< + ift min-flt 3d + "Number of page reclaims (ru_minflt)" + >>,<< + mrc msgrcv 3d + "Number of messages received" + >>,<< + msd msgsnd 3d + "Number of messages sent" + >>,<< + ngs nsignals 3d + "Number of signals received" + >>,<< + nsw nswap 3d + "Number of swaps" + >>,<< + vcs nvcsw 4d + "Number of voluntary context switches" + >>,<< + oub outblock 3d + "Number of block output operations" + >>,<< + s supervisor 1d + "The number of supervisors" + >>,<< + tw timer-workers 3d + "The number of timer threads" + >>,<< + ttq timer-tasks-queued 3d + "The number of tasks queued for execution in timer threads" + >>,<< + ttc timer-tasks-completed 8d + "The number of tasks completed in timer threads" + >>,<< + util% utilization 6.2f + "Percentage of CPU utilization (0..100%)" + >>,<< + wallclock wallclock 9d + "Number of microseconds elapsed" + >> ; -# Set footer and make sure we can also use the header key as an indicator -for %format.values -> \v { - v[3] = '-' x v[0].chars; - %format{v[0].trim} = v; -} - multi sub report( @s, :@columns is copy, :$legend, :$header-repeat = 32, + :@format, ) { unless @columns { @@ -735,21 +762,33 @@ multi sub report( } } + # get / calculate the format info we need + my %format := %default_format + ?? %default_format + !! @format + ?? prepare-format(@format) + !! (%default_format := prepare-format(@default_format)); + my $total = @s[*-1] - @s[0]; my $text := nqp::list_s(qq:to/HEADER/.chomp); Telemetry Report of Process #$*PID ({Instant.from-posix(nqp::time_i).DateTime}) Number of Snapshots: {+@s} Initial Size: { @s[0].max-rss.fmt('%9d') } Kbytes -Total Time: { ($total.wallclock / 1000000).fmt('%9.2f') } seconds -Total CPU Usage: { ($total.cpu / 1000000).fmt('%9.2f') } seconds +Total Time: { (%format[DISPLAY]($total.wallclock)) } seconds +Total CPU Usage: { (%format[DISPLAY]($total.cpu)) } seconds HEADER - sub push-period($period) { + + my @formats = %format{@columns}; + sub push-period($period --> Nil) { nqp::push_s($text, - %format{@columns}>>.[1]>>.($period).join(' ').trim-trailing); + @formats.map( -> @info { + @info[DISPLAY]($period."@info[METHOD]"()) + }).join(' ').trim-trailing + ) } - my $header = "\n%format{@columns}>>.[0].join(' ')"; + my $header = "\n%format{@columns}>>.[HEADER].join(' ')"; nqp::push_s($text,$header) unless $header-repeat; for periods(@s).kv -> $index, $period { @@ -758,7 +797,7 @@ HEADER push-period($period) } - nqp::push_s($text,%format{@columns}>>.[3].join(' ')); + nqp::push_s($text,%format{@columns}>>.[FOOTER].join(' ')); push-period($total); @@ -766,7 +805,7 @@ HEADER nqp::push_s($text,''); nqp::push_s($text,'Legend:'); for %format{@columns} -> $col { - nqp::push_s($text," $col[0].trim-leading.fmt('%9s') $col[2]"); + nqp::push_s($text,"$col[COLUMN].fmt("%9s") $col[LEGEND]"); } } From cd9f66eff53d337a10f4cad742e83330bb193b2f Mon Sep 17 00:00:00 2001 From: MasterDuke17 Date: Fri, 3 Nov 2017 14:04:35 -0400 Subject: [PATCH 672/692] Test for RT #132291 --- t/05-messages/02-errors.t | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/t/05-messages/02-errors.t b/t/05-messages/02-errors.t index f51bb2b713f..9953d52e4ca 100644 --- a/t/05-messages/02-errors.t +++ b/t/05-messages/02-errors.t @@ -2,11 +2,18 @@ use lib ; use Test; use Test::Helpers; -plan 1; +plan 2; # RT #132295 is-run 「:2(1)」, :err{.contains: 「use 1.base(2) instead」}, :status(* !== 0), ':2(1) suggests using 1.base(2)'; +# RT #132291 + +throws-like { for [:a] X [:b] -> ($i, $j) { } }, + Exception, + message => / '' /, + "anonymous subs get '' in arity error messages"; + # vim: ft=perl6 expandtab sw=4 From 8b24bf5cd4ce3eac171e781acd1257ff19c61a7c Mon Sep 17 00:00:00 2001 From: usev6 Date: Fri, 3 Nov 2017 21:15:32 +0100 Subject: [PATCH 673/692] [jvm] Also do a type check when assigning Nil Fixes GH#1225, pmurias++ --- .../org/perl6/rakudo/RakudoContainerSpec.java | 32 ++++++++++--------- 1 file changed, 17 insertions(+), 15 deletions(-) diff --git a/src/vm/jvm/runtime/org/perl6/rakudo/RakudoContainerSpec.java b/src/vm/jvm/runtime/org/perl6/rakudo/RakudoContainerSpec.java index a6f4bb85d37..d99359e07db 100644 --- a/src/vm/jvm/runtime/org/perl6/rakudo/RakudoContainerSpec.java +++ b/src/vm/jvm/runtime/org/perl6/rakudo/RakudoContainerSpec.java @@ -54,21 +54,23 @@ private void checkStore(ThreadContext tc, SixModelObject cont, SixModelObject va "Cannot assign to a readonly variable or a value"); } - if (value.st.WHAT != gcx.Nil) { - SixModelObject of = desc.get_attribute_boxed(tc, - gcx.ContainerDescriptor, "$!of", RakOps.HINT_CD_OF); - long ok = Ops.istype(value, of, tc); - if (ok == 0) { - desc.get_attribute_native(tc, gcx.ContainerDescriptor, "$!name", RakOps.HINT_CD_NAME); - String name = tc.native_s; - SixModelObject thrower = RakOps.getThrower(tc, "X::TypeCheck::Assignment"); - if (thrower == null) - throw ExceptionHandling.dieInternal(tc, - "Type check failed in assignment to '" + name + "'"); - else - Ops.invokeDirect(tc, thrower, - storeThrower, new Object[] { name, value, of }); - } + if (value.st.WHAT == gcx.Nil) { + value = desc.get_attribute_boxed(tc, + gcx.ContainerDescriptor, "$!default", RakOps.HINT_CD_DEFAULT); + } + SixModelObject of = desc.get_attribute_boxed(tc, + gcx.ContainerDescriptor, "$!of", RakOps.HINT_CD_OF); + long ok = Ops.istype(value, of, tc); + if (ok == 0) { + desc.get_attribute_native(tc, gcx.ContainerDescriptor, "$!name", RakOps.HINT_CD_NAME); + String name = tc.native_s; + SixModelObject thrower = RakOps.getThrower(tc, "X::TypeCheck::Assignment"); + if (thrower == null) + throw ExceptionHandling.dieInternal(tc, + "Type check failed in assignment to '" + name + "'"); + else + Ops.invokeDirect(tc, thrower, + storeThrower, new Object[] { name, value, of }); } } public void store(ThreadContext tc, SixModelObject cont, SixModelObject value) { From 102fbd51796ad31efb7d99e30473bde6e45999fa Mon Sep 17 00:00:00 2001 From: Daniel Green Date: Fri, 3 Nov 2017 21:37:26 -0400 Subject: [PATCH 674/692] Convert the rest of the `{ * }` to `{*}` --- src/core.d/await.pm | 2 +- src/core/Array.pm | 4 +-- src/core/Baggy.pm | 16 +++++----- src/core/Bool.pm | 46 ++++++++++++++-------------- src/core/Buf.pm | 8 ++--- src/core/Code.pm | 2 +- src/core/CompUnit/Loader.pm | 2 +- src/core/Deprecations.pm | 2 +- src/core/Distribution.pm | 2 +- src/core/Hash.pm | 4 +-- src/core/IO/CatHandle.pm | 20 ++++++------ src/core/IO/Handle.pm | 16 +++++----- src/core/Instant.pm | 2 +- src/core/IterationBuffer.pm | 4 +-- src/core/JVM/IOAsyncFile.pm | 2 +- src/core/JVM/KeyReducer.pm | 2 +- src/core/Junction.pm | 10 +++--- src/core/Kernel.pm | 2 +- src/core/Map.pm | 2 +- src/core/Match.pm | 4 +-- src/core/Order.pm | 2 +- src/core/Pair.pm | 2 +- src/core/Proc.pm | 2 +- src/core/Promise.pm | 8 ++--- src/core/Rakudo/Iterator.pm | 2 +- src/core/Regex.pm | 2 +- src/core/Seq.pm | 2 +- src/core/Setty.pm | 10 +++--- src/core/Slip.pm | 2 +- src/core/SlippyIterator.pm | 4 +-- src/core/Stringy.pm | 28 ++++++++--------- src/core/Supply.pm | 10 +++--- src/core/TypedArray.pm | 4 +-- src/core/VM.pm | 2 +- src/core/array_slice.pm | 4 +-- src/core/asyncops.pm | 2 +- src/core/multidim_slice.pm | 2 +- src/core/native_array.pm | 8 ++--- src/core/set_addition.pm | 2 +- src/core/set_difference.pm | 2 +- src/core/set_intersection.pm | 2 +- src/core/set_multiply.pm | 2 +- src/core/set_operators.pm | 6 ++-- src/core/set_symmetric_difference.pm | 2 +- src/core/set_union.pm | 2 +- src/core/stubs.pm | 2 +- src/core/traits.pm | 18 +++++------ 47 files changed, 143 insertions(+), 143 deletions(-) diff --git a/src/core.d/await.pm b/src/core.d/await.pm index e360380482f..e07a5f820ec 100644 --- a/src/core.d/await.pm +++ b/src/core.d/await.pm @@ -8,7 +8,7 @@ my role X::Await::Died { } } -proto sub await(|) { * } +proto sub await(|) {*} multi sub await() { die "Must specify an Awaitable to await (got an empty list)"; } diff --git a/src/core/Array.pm b/src/core/Array.pm index b41f3d42258..788e83c94d7 100644 --- a/src/core/Array.pm +++ b/src/core/Array.pm @@ -179,7 +179,7 @@ my class Array { # declared in BOOTSTRAP ) } - proto method new(|) { * } + proto method new(|) {*} multi method new(:$shape!) { nqp::if( nqp::defined($shape), @@ -223,7 +223,7 @@ my class Array { # declared in BOOTSTRAP nqp::create(self).STORE(@values) } - proto method STORE(|) { * } + proto method STORE(|) {*} multi method STORE(Array:D: Iterable:D \iterable) { nqp::iscont(iterable) ?? self!STORE-ONE(iterable) diff --git a/src/core/Baggy.pm b/src/core/Baggy.pm index 51d0cd0af94..71660a9b069 100644 --- a/src/core/Baggy.pm +++ b/src/core/Baggy.pm @@ -198,7 +198,7 @@ my role Baggy does QuantHash { } }.new($!elems)) } - proto method kxxv(|) { * } + proto method kxxv(|) {*} multi method kxxv(Baggy:D:) { Seq.new(class :: does Rakudo::Iterator::Mappy { has Mu $!key; @@ -355,7 +355,7 @@ my role Baggy does QuantHash { } #--- selection methods - proto method grabpairs (|) { * } + proto method grabpairs (|) {*} multi method grabpairs(Baggy:D:) { nqp::if( $!elems && nqp::elems($!elems), @@ -393,7 +393,7 @@ my role Baggy does QuantHash { }.new($!elems, $count)) } - proto method pickpairs(|) { * } + proto method pickpairs(|) {*} multi method pickpairs(Baggy:D:) { nqp::if( $!elems && nqp::elems($!elems), @@ -419,12 +419,12 @@ my role Baggy does QuantHash { }.new($!elems, $count)) } - proto method grab(|) { * } + proto method grab(|) {*} multi method grab(Baggy:D: |c) { X::Immutable.new( method => 'grab', typename => self.^name ).throw; } - proto method pick(|) { * } + proto method pick(|) {*} multi method pick(Baggy:D:) { self.roll } multi method pick(Baggy:D: Callable:D $calculate) { self.pick( $calculate(self.total) ) @@ -538,7 +538,7 @@ my role Baggy does QuantHash { )) } - proto method roll(|) { * } + proto method roll(|) {*} multi method roll(Baggy:D:) { nqp::if( $!elems && (my $total := self.total), @@ -597,7 +597,7 @@ my role Baggy does QuantHash { } #--- classification method - proto method classify-list(|) { * } + proto method classify-list(|) {*} multi method classify-list( &test, \list) { fail X::Cannot::Lazy.new(:action) if list.is-lazy; my \iter = (nqp::istype(list, Iterable) ?? list !! list.list).iterator; @@ -629,7 +629,7 @@ my role Baggy does QuantHash { self.classify-list(&test, @list, |c); } - proto method categorize-list(|) { * } + proto method categorize-list(|) {*} multi method categorize-list( &test, \list ) { fail X::Cannot::Lazy.new(:action) if list.is-lazy; my \iter = (nqp::istype(list, Iterable) ?? list !! list.list).iterator; diff --git a/src/core/Bool.pm b/src/core/Bool.pm index 95f7a90c22c..466de05152d 100644 --- a/src/core/Bool.pm +++ b/src/core/Bool.pm @@ -1,13 +1,13 @@ # enum Bool declared in BOOTSTRAP BEGIN { - Bool.^add_method('Bool', my proto method Bool(|) { * }); - Bool.^add_method('gist', my proto method gist(|) { * }); - Bool.^add_method('Numeric', my proto method Numeric(|) { * }); - Bool.^add_method('Int', my proto method Int(|) { * }); - Bool.^add_method('ACCEPTS', my proto method ACCEPTS(|) { * }); - Bool.^add_method('pick', my proto method pick(|) { * }); - Bool.^add_method('roll', my proto method roll(|) { * }); - Bool.^add_method('perl', my proto method perl(|) { * }); + Bool.^add_method('Bool', my proto method Bool(|) {*}); + Bool.^add_method('gist', my proto method gist(|) {*}); + Bool.^add_method('Numeric', my proto method Numeric(|) {*}); + Bool.^add_method('Int', my proto method Int(|) {*}); + Bool.^add_method('ACCEPTS', my proto method ACCEPTS(|) {*}); + Bool.^add_method('pick', my proto method pick(|) {*}); + Bool.^add_method('roll', my proto method roll(|) {*}); + Bool.^add_method('perl', my proto method perl(|) {*}); } BEGIN { Bool.^add_multi_method('Bool', my multi method Bool(Bool:D:) { self }); @@ -63,52 +63,52 @@ multi sub postfix:<-->(Bool:D $a is rw) { } } -proto sub prefix:(Mu $) is pure { * } +proto sub prefix:(Mu $) is pure {*} multi sub prefix:(Bool:D \a) { a } multi sub prefix:(Bool:U \a) { Bool::False } multi sub prefix:(Mu \a) { a.Bool } -proto sub prefix:(Mu $) is pure { * } +proto sub prefix:(Mu $) is pure {*} multi sub prefix:(Bool:D \a) { a } multi sub prefix:(Bool:U \a) { Bool::False } multi sub prefix:(Mu \a) { a.Bool } -proto sub prefix:(Mu $) is pure { * } +proto sub prefix:(Mu $) is pure {*} multi sub prefix:(Bool \a) { nqp::p6bool(nqp::not_i(nqp::istrue(a))) } multi sub prefix:(Mu \a) { nqp::p6bool(nqp::not_i(nqp::istrue(a))) } -proto sub prefix:(Mu $) is pure { * } +proto sub prefix:(Mu $) is pure {*} multi sub prefix:(Bool \a) { nqp::p6bool(nqp::not_i(nqp::istrue(a))) } multi sub prefix:(Mu \a) { nqp::p6bool(nqp::not_i(nqp::istrue(a))) } -proto sub prefix:(Mu $) is pure { * } +proto sub prefix:(Mu $) is pure {*} multi sub prefix:(Mu \a) { not a } -proto sub infix:(Mu $?, Mu $?) is pure { * } +proto sub infix:(Mu $?, Mu $?) is pure {*} multi sub infix:(Mu $x = Bool::True) { $x.Bool } multi sub infix:(Mu \a, Mu \b) { a.Bool && b.Bool } -proto sub infix:(Mu $?, Mu $?) is pure { * } +proto sub infix:(Mu $?, Mu $?) is pure {*} multi sub infix:(Mu $x = Bool::False) { $x.Bool } multi sub infix:(Mu \a, Mu \b) { a.Bool || b.Bool } -proto sub infix:(Mu $?, Mu $?) is pure { * } +proto sub infix:(Mu $?, Mu $?) is pure {*} multi sub infix:(Mu $x = Bool::False) { $x.Bool } multi sub infix:(Mu \a, Mu \b) { nqp::p6bool(nqp::ifnull(nqp::xor(a.Bool,b.Bool), 0)) } # These operators are normally handled as macros in the compiler; # we define them here for use as arguments to functions. -proto sub infix:<&&>(|) { * } +proto sub infix:<&&>(|) {*} multi sub infix:<&&>(Mu $x = Bool::True) { $x } multi sub infix:<&&>(Mu \a, &b) { a && b() } multi sub infix:<&&>(Mu \a, Mu \b) { a && b } -proto sub infix:<||>(|) { * } +proto sub infix:<||>(|) {*} multi sub infix:<||>(Mu $x = Bool::False) { $x } multi sub infix:<||>(Mu \a, &b) { a || b() } multi sub infix:<||>(Mu \a, Mu \b) { a || b } -proto sub infix:<^^>(|) { * } +proto sub infix:<^^>(|) {*} multi sub infix:<^^>(Mu $x = Bool::False) { $x } multi sub infix:<^^>(Mu \a, &b) { a ^^ b() } multi sub infix:<^^>(Mu \a, Mu \b) { a ^^ b } @@ -124,22 +124,22 @@ multi sub infix:<^^>(+@a) { $a; } -proto sub infix:(|) { * } +proto sub infix:(|) {*} multi sub infix:(Mu $x = Any) { $x } multi sub infix:(Mu \a, &b) { a // b } multi sub infix:(Mu \a, Mu \b) { a // b } -proto sub infix:(|) { * } +proto sub infix:(|) {*} multi sub infix:(Mu $x = Bool::True) { $x } multi sub infix:(Mu \a, &b) { a && b } multi sub infix:(Mu \a, Mu \b) { a && b } -proto sub infix:(|) { * } +proto sub infix:(|) {*} multi sub infix:(Mu $x = Bool::False) { $x } multi sub infix:(Mu \a, &b) { a || b } multi sub infix:(Mu \a, Mu \b) { a || b } -proto sub infix:(|) { * } +proto sub infix:(|) {*} multi sub infix:(Mu $x = Bool::False) { $x } multi sub infix:(Mu \a, &b) { a ^^ b } multi sub infix:(Mu \a, Mu \b) { a ^^ b } diff --git a/src/core/Buf.pm b/src/core/Buf.pm index dcaa14c44ff..8789833e624 100644 --- a/src/core/Buf.pm +++ b/src/core/Buf.pm @@ -47,7 +47,7 @@ my role Blob[::T = uint8] does Positional[T] does Stringy is repr('VMArray') is } multi method new(Blob: *@values) { self.new(@values) } - proto method allocate(|) { * } + proto method allocate(|) {*} multi method allocate(Blob:U: Int $elements) { nqp::setelems(nqp::create(self),$elements) } @@ -115,7 +115,7 @@ my role Blob[::T = uint8] does Positional[T] does Stringy is repr('VMArray') is multi method Str(Blob:D:) { X::Buf::AsStr.new(method => 'Str' ).throw } multi method Stringy(Blob:D:) { X::Buf::AsStr.new(method => 'Stringy' ).throw } - proto method decode(|) { * } + proto method decode(|) {*} multi method decode(Blob:D:) { nqp::p6box_s(nqp::decode(self, 'utf8')) } @@ -248,7 +248,7 @@ my role Blob[::T = uint8] does Positional[T] does Stringy is repr('VMArray') is nqp::join($delim.Str,$list) } - proto method unpack(|) { * } + proto method unpack(|) {*} multi method unpack(Blob:D: Str:D $template) { nqp::isnull(nqp::getlexcaller('EXPERIMENTAL-PACK')) and X::Experimental.new( feature => "the 'unpack' method", @@ -618,7 +618,7 @@ constant buf16 = Buf[uint16]; constant buf32 = Buf[uint32]; constant buf64 = Buf[uint64]; -proto sub pack(|) { * } +proto sub pack(|) {*} multi sub pack(Str $template, *@items) { nqp::isnull(nqp::getlexcaller('EXPERIMENTAL-PACK')) and X::Experimental.new( feature => "the 'pack' function", diff --git a/src/core/Code.pm b/src/core/Code.pm index 2cb88736a08..8f349203118 100644 --- a/src/core/Code.pm +++ b/src/core/Code.pm @@ -14,7 +14,7 @@ my class Code does Callable { # declared in BOOTSTRAP method signature(Code:D:) { $!signature } - proto method prec(|) { * } + proto method prec(|) {*} multi method prec() { my % } multi method prec(Str:D $) { '' } diff --git a/src/core/CompUnit/Loader.pm b/src/core/CompUnit/Loader.pm index aa833b37d2a..e7350d62499 100644 --- a/src/core/CompUnit/Loader.pm +++ b/src/core/CompUnit/Loader.pm @@ -30,7 +30,7 @@ class CompUnit::Loader is repr('Uninstantiable') { } # Load a pre-compiled file - proto method load-precompilation-file(|) { * } + proto method load-precompilation-file(|) {*} multi method load-precompilation-file(IO::Path $path --> CompUnit::Handle:D) { my $handle := CompUnit::Handle.new; my $*CTXSAVE := $handle; diff --git a/src/core/Deprecations.pm b/src/core/Deprecations.pm index c724a16ba54..dfa12051135 100644 --- a/src/core/Deprecations.pm +++ b/src/core/Deprecations.pm @@ -14,7 +14,7 @@ class Deprecation { ($!file||"",$!type||"",$!package||"",$!name).join(':'); } - proto method report (|) { * } + proto method report (|) {*} multi method report (Deprecation:U:) { return Nil unless %DEPRECATIONS; diff --git a/src/core/Distribution.pm b/src/core/Distribution.pm index 2d67684e3b6..a3eeadd96c9 100644 --- a/src/core/Distribution.pm +++ b/src/core/Distribution.pm @@ -240,7 +240,7 @@ class Distribution::Resources does Associative { has Str $.repo; has Str $.repo-name; - proto method BUILD(|) { * } + proto method BUILD(|) {*} multi method BUILD(:$!dist-id, CompUnit::Repository :$repo --> Nil) { unless $repo.can('name') and $!repo-name = $repo.name and $!repo-name ne '' { diff --git a/src/core/Hash.pm b/src/core/Hash.pm index 3d4114334e5..4f6f1174639 100644 --- a/src/core/Hash.pm +++ b/src/core/Hash.pm @@ -311,7 +311,7 @@ my class Hash { # declared in BOOTSTRAP self } - proto method classify-list(|) { * } + proto method classify-list(|) {*} multi method classify-list( &test, \list, :&as ) { fail X::Cannot::Lazy.new(:action) if list.is-lazy; my \iter = (nqp::istype(list, Iterable) ?? list !! list.list).iterator; @@ -371,7 +371,7 @@ my class Hash { # declared in BOOTSTRAP self.classify-list(&test, @list, |c); } - proto method categorize-list(|) { * } + proto method categorize-list(|) {*} multi method categorize-list( &test, \list, :&as ) { fail X::Cannot::Lazy.new(:action) if list.is-lazy; my \iter = (nqp::istype(list, Iterable) ?? list !! list.list).iterator; diff --git a/src/core/IO/CatHandle.pm b/src/core/IO/CatHandle.pm index 8aae64497af..45da9b4e175 100644 --- a/src/core/IO/CatHandle.pm +++ b/src/core/IO/CatHandle.pm @@ -271,7 +271,7 @@ my class IO::CatHandle is IO::Handle { ($!active-handle = Nil)) } - proto method encoding(|) { * } + proto method encoding(|) {*} multi method encoding(::?CLASS:D:) { $!encoding || Nil } multi method encoding(::?CLASS:D: $enc is copy) { $!encoding = nqp::if( @@ -352,26 +352,26 @@ my class IO::CatHandle is IO::Handle { # | / # |/ # (⛣) - proto method flush (|) { * } + proto method flush (|) {*} multi method flush (|) { die X::NYI.new: :feature } - proto method out-buffer (|) { * } + proto method out-buffer (|) {*} multi method out-buffer (|) { die X::NYI.new: :feature } - proto method print (|) { * } + proto method print (|) {*} multi method print (|) { die X::NYI.new: :feature } - proto method printf (|) { * } + proto method printf (|) {*} multi method printf (|) { die X::NYI.new: :feature } - proto method print-nl (|) { * } + proto method print-nl (|) {*} multi method print-nl (|) { die X::NYI.new: :feature } - proto method put (|) { * } + proto method put (|) {*} multi method put (|) { die X::NYI.new: :feature } - proto method say (|) { * } + proto method say (|) {*} multi method say (|) { die X::NYI.new: :feature } - proto method write (|) { * } + proto method write (|) {*} multi method write (|) { die X::NYI.new: :feature } # /|\ # Don't die on this one, as doing so breaks .Capture - # proto method nl-out (|) { * } + # proto method nl-out (|) {*} # multi method nl-out (|) { # die X::NYI.new: :feature # } diff --git a/src/core/IO/Handle.pm b/src/core/IO/Handle.pm index dc66e518398..55ff9116d0d 100644 --- a/src/core/IO/Handle.pm +++ b/src/core/IO/Handle.pm @@ -325,7 +325,7 @@ my class IO::Handle { self.slurp(:$close).split: |c } - proto method words (|) { * } + proto method words (|) {*} multi method words(IO::Handle:D \SELF: $limit, :$close) { $!decoder or die X::IO::BinaryMode.new(:trying); nqp::istype($limit,Whatever) || $limit == Inf @@ -488,7 +488,7 @@ my class IO::Handle { ).new(self) } - proto method lines (|) { * } + proto method lines (|) {*} multi method lines(IO::Handle:D \SELF: $limit, :$close) { nqp::istype($limit,Whatever) || $limit == Inf ?? self.lines(:$close) @@ -580,7 +580,7 @@ my class IO::Handle { } } - proto method seek(|) { * } + proto method seek(|) {*} multi method seek(IO::Handle:D: Int:D $offset, SeekType:D $whence = SeekFromBeginning) { my int $rewind = 0; if $!decoder { @@ -644,7 +644,7 @@ my class IO::Handle { self.print(sprintf |c); } - proto method print(|) { * } + proto method print(|) {*} multi method print(IO::Handle:D: Str:D \x --> True) { $!decoder or die X::IO::BinaryMode.new(:trying); self.write-internal($!encoder.encode-chars(x)); @@ -653,7 +653,7 @@ my class IO::Handle { self.print(@list.join); } - proto method put(|) { * } + proto method put(|) {*} multi method put(IO::Handle:D: Str:D \x --> True) { $!decoder or die X::IO::BinaryMode.new(:trying); self.write-internal($!encoder.encode-chars( @@ -687,7 +687,7 @@ my class IO::Handle { self.write-internal($!encoder.encode-chars($!nl-out)); } - proto method slurp-rest(|) { * } + proto method slurp-rest(|) {*} multi method slurp-rest(IO::Handle:D: :$bin! where *.so, :$close --> Buf:D) { # NOTE: THIS METHOD WILL BE DEPRECATED IN 6.d in favour of .slurp() # Testing of it in roast master has been removed and only kept in 6.c @@ -743,7 +743,7 @@ my class IO::Handle { $!decoder.consume-all-chars() } - proto method spurt(|) { * } + proto method spurt(|) {*} multi method spurt(IO::Handle:D: Blob $data, :$close) { LEAVE self.close if $close; self.write-internal($data); @@ -769,7 +769,7 @@ my class IO::Handle { nqp::flushfh($!PIO); } - proto method encoding(|) { * } + proto method encoding(|) {*} multi method encoding(IO::Handle:D:) { $!encoding // Nil } multi method encoding(IO::Handle:D: $new-encoding is copy) { with $new-encoding { diff --git a/src/core/Instant.pm b/src/core/Instant.pm index 80b2f8d11e1..1b0f1919629 100644 --- a/src/core/Instant.pm +++ b/src/core/Instant.pm @@ -12,7 +12,7 @@ my class Instant is Cool does Real { method new(*@) { X::Cannot::New.new(class => self).throw } - proto method from-posix(|) { * } + proto method from-posix(|) {*} multi method from-posix($posix) { nqp::create(Instant).SET-SELF( Rakudo::Internals.tai-from-posix($posix,0).Rat diff --git a/src/core/IterationBuffer.pm b/src/core/IterationBuffer.pm index b32fef5c213..2c1d5e559f4 100644 --- a/src/core/IterationBuffer.pm +++ b/src/core/IterationBuffer.pm @@ -19,7 +19,7 @@ my class IterationBuffer { method push(Mu \value) { nqp::push(self, value) } - proto method AT-POS(|) { * } + proto method AT-POS(|) {*} multi method AT-POS(IterationBuffer:D: int $pos) is raw { nqp::atpos(self, $pos) } @@ -27,7 +27,7 @@ my class IterationBuffer { nqp::atpos(self, $pos) } - proto method BIND-POS(|) { * } + proto method BIND-POS(|) {*} multi method BIND-POS(IterationBuffer:D: int $pos, Mu \value) { nqp::bindpos(self, $pos, value) } diff --git a/src/core/JVM/IOAsyncFile.pm b/src/core/JVM/IOAsyncFile.pm index 72fd7ed6bb3..ee8b1272c08 100644 --- a/src/core/JVM/IOAsyncFile.pm +++ b/src/core/JVM/IOAsyncFile.pm @@ -6,7 +6,7 @@ my class IO::Async::File { has $.chomp = Bool::True; has $.path; - proto method open(|) { * } + proto method open(|) {*} multi method open($path? is copy, :$r, :$w, :$a, :$bin, :$chomp = Bool::True, :enc(:$encoding) = 'utf8') { $path //= $!path; diff --git a/src/core/JVM/KeyReducer.pm b/src/core/JVM/KeyReducer.pm index 1974a9ef09d..c8651289216 100644 --- a/src/core/JVM/KeyReducer.pm +++ b/src/core/JVM/KeyReducer.pm @@ -26,7 +26,7 @@ my class KeyReducer { $!obtained = False; } - proto method contribute(|) { * } + proto method contribute(|) {*} multi method contribute(KeyReducer:D: %h) { $!lock.lock(); if $!exception { diff --git a/src/core/Junction.pm b/src/core/Junction.pm index c8aefaec895..be8f2c30405 100644 --- a/src/core/Junction.pm +++ b/src/core/Junction.pm @@ -47,7 +47,7 @@ my class Junction { # declared in BOOTSTRAP ) } - proto method new(|) { * } + proto method new(|) {*} multi method new(Junction: \values, Str :$type!) { nqp::create(Junction)!SET-SELF($type,values) } @@ -351,19 +351,19 @@ my class Junction { # declared in BOOTSTRAP } } -proto sub any(|) is pure { * } +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 { * } +proto sub all(|) is pure {*} multi sub all(@values) { @values.all } multi sub all(+values) { values.all } -proto sub one(|) is pure { * } +proto sub one(|) is pure {*} multi sub one(@values) { @values.one } multi sub one(+values) { values.one } -proto sub none(|) is pure { * } +proto sub none(|) is pure {*} multi sub none(@values) { @values.none } multi sub none(+values) { values.none } diff --git a/src/core/Kernel.pm b/src/core/Kernel.pm index 2031e44056d..0e891a7d5e4 100644 --- a/src/core/Kernel.pm +++ b/src/core/Kernel.pm @@ -147,7 +147,7 @@ class Kernel does Systemic { has %!signals-by-Str; has $!signals-by-Str-setup = False; - proto method signal (|) { * } + proto method signal (|) {*} multi method signal(Kernel:D: Str:D $signal --> Int:D) { unless $!signals-by-Str-setup { $!signals-setup-lock.protect: { diff --git a/src/core/Map.pm b/src/core/Map.pm index 1e4c304c501..0441be65d90 100644 --- a/src/core/Map.pm +++ b/src/core/Map.pm @@ -306,7 +306,7 @@ my class Map does Iterable does Associative { # declared in BOOTSTRAP nqp::p6bindattrinvres(self,Map,'$!storage',$storage) } - proto method STORE_AT_KEY(|) { * } + proto method STORE_AT_KEY(|) {*} multi method STORE_AT_KEY(Str:D \key, Mu \value --> Nil) { nqp::bindkey($!storage, nqp::unbox_s(key), nqp::decont(value)) } diff --git a/src/core/Match.pm b/src/core/Match.pm index 8befc67abad..4581eef0799 100644 --- a/src/core/Match.pm +++ b/src/core/Match.pm @@ -203,7 +203,7 @@ my class Match is Capture is Cool does NQPMatchRole { # INTERPOLATE's parameters are non-optional since the ops for optional params # aren't currently JITted on MoarVM - proto method INTERPOLATE(|) { * } + proto method INTERPOLATE(|) {*} multi method INTERPOLATE(Callable:D \var, $, $, $, $, $) { # Call it if it is a routine. This will capture if requested. @@ -765,7 +765,7 @@ my class Match is Capture is Cool does NQPMatchRole { self.Mu::WHICH # skip Capture's as Match is not a value type } - proto method Bool(|) { * } + proto method Bool(|) {*} multi method Bool(Match:U:) { False } multi method Bool(Match:D:) { nqp::p6bool($!pos >= $!from) } diff --git a/src/core/Order.pm b/src/core/Order.pm index ce3f3c063b4..d4986ac719d 100644 --- a/src/core/Order.pm +++ b/src/core/Order.pm @@ -6,7 +6,7 @@ sub ORDER(int $i) { nqp::iseq_i($i,0) ?? Same !! nqp::islt_i($i,0) ?? Less !! More } -proto sub infix:(Mu $, Mu $) is pure { * } +proto sub infix:(Mu $, Mu $) is pure {*} multi sub infix:(\a, \b) { nqp::eqaddr(a,b) ?? Same diff --git a/src/core/Pair.pm b/src/core/Pair.pm index 0b0bbfd3242..8504fbaa9d3 100644 --- a/src/core/Pair.pm +++ b/src/core/Pair.pm @@ -3,7 +3,7 @@ my class Pair does Associative { has $.value is rw is default(Nil); has Mu $!WHICH; - proto method new(|) { * } + proto method new(|) {*} # This candidate is needed because it currently JITS better multi method new(Pair: Cool:D \key, Mu \value) { my \p := nqp::p6bindattrinvres( diff --git a/src/core/Proc.pm b/src/core/Proc.pm index 4cfdc47eafb..e229c5fb15d 100644 --- a/src/core/Proc.pm +++ b/src/core/Proc.pm @@ -185,7 +185,7 @@ my class Proc { $is-spawned } - proto method status(|) { * } + proto method status(|) {*} multi method status($new_status) { $!exitcode = $new_status +> 8; $!signal = $new_status +& 0xFF; diff --git a/src/core/Promise.pm b/src/core/Promise.pm index 2091eb94dbb..aefbcd32f8d 100644 --- a/src/core/Promise.pm +++ b/src/core/Promise.pm @@ -67,7 +67,7 @@ my class Promise does Awaitable { $vow } - proto method kept(|) { * } + proto method kept(|) {*} multi method kept(Promise:U:) { my \rv := self.new; rv!keep(True); @@ -79,7 +79,7 @@ my class Promise does Awaitable { rv; } - proto method keep(|) { * } + proto method keep(|) {*} multi method keep(Promise:D:) { self.vow.keep(True) } @@ -96,7 +96,7 @@ my class Promise does Awaitable { }); } - proto method broken(|) { * } + proto method broken(|) {*} multi method broken(Promise:U:) { my \rv := self.new; rv!break("Died"); @@ -108,7 +108,7 @@ my class Promise does Awaitable { rv; } - proto method break(|) { * } + proto method break(|) {*} multi method break(Promise:D:) { self.vow.break("Died") } diff --git a/src/core/Rakudo/Iterator.pm b/src/core/Rakudo/Iterator.pm index f3bb84557d0..a39d57b7de7 100644 --- a/src/core/Rakudo/Iterator.pm +++ b/src/core/Rakudo/Iterator.pm @@ -574,7 +574,7 @@ class Rakudo::Iterator { # data from the Callable is exhausted. No checks for Slips are done, # so they will be passed on as is. Also optionally takes a flag to # mark the iterator as lazy or not: default is False (not lazy) - proto method Callable(|) { * } + proto method Callable(|) {*} multi method Callable(&callable) { class :: does Iterator { has &!callable; diff --git a/src/core/Regex.pm b/src/core/Regex.pm index 13639ac45b0..fe092426db9 100644 --- a/src/core/Regex.pm +++ b/src/core/Regex.pm @@ -8,7 +8,7 @@ my class Regex { # declared in BOOTSTRAP # cache cursor initialization lookup my $cursor-init := Match.^lookup("!cursor_init"); - proto method ACCEPTS(|) { * } + proto method ACCEPTS(|) {*} multi method ACCEPTS(Regex:D: Mu:U \a) { False } diff --git a/src/core/Seq.pm b/src/core/Seq.pm index e2c94f569ce..c7f99fc6c4e 100644 --- a/src/core/Seq.pm +++ b/src/core/Seq.pm @@ -146,7 +146,7 @@ my class Seq is Cool does Iterable does Sequence { ) } - proto method from-loop(|) { * } + proto method from-loop(|) {*} multi method from-loop(&body) { Seq.new(Rakudo::Iterator.Loop(&body)) } diff --git a/src/core/Setty.pm b/src/core/Setty.pm index 77b4df9b1b6..88ef2280fed 100644 --- a/src/core/Setty.pm +++ b/src/core/Setty.pm @@ -171,10 +171,10 @@ my role Setty does QuantHash { ) } - proto method grab(|) { * } - proto method grabpairs(|) { * } + proto method grab(|) {*} + proto method grabpairs(|) {*} - proto method pick(|) { * } + proto method pick(|) {*} multi method pick(Setty:D:) { self.roll } multi method pick(Setty:D: Callable:D $calculate) { self.pick( $calculate(self.elems) ) @@ -194,7 +194,7 @@ my role Setty does QuantHash { }.new($!elems, $count)) } - proto method pickpairs(|) { * } + proto method pickpairs(|) {*} multi method pickpairs(Setty:D:) { Pair.new(self.roll,True) } multi method pickpairs(Setty:D: Callable:D $calculate) { self.pickpairs( $calculate(self.elems) ) @@ -214,7 +214,7 @@ my role Setty does QuantHash { }.new($!elems, $count)) } - proto method roll(|) { * } + proto method roll(|) {*} multi method roll(Setty:D:) { nqp::if( $!elems, diff --git a/src/core/Slip.pm b/src/core/Slip.pm index 33254b0c555..dc0c961df97 100644 --- a/src/core/Slip.pm +++ b/src/core/Slip.pm @@ -37,7 +37,7 @@ my class Slip { # is List } # The slip(...) function creates a Slip. -proto slip(|) { * } +proto slip(|) {*} multi slip() { Empty } multi slip(@args) { @args.Slip } multi slip(+args) { args.Slip } diff --git a/src/core/SlippyIterator.pm b/src/core/SlippyIterator.pm index fd6d0f2276c..e463d3fa1d5 100644 --- a/src/core/SlippyIterator.pm +++ b/src/core/SlippyIterator.pm @@ -7,7 +7,7 @@ my role SlippyIterator does Iterator { # The current Slip we're iterating. has $!slip-iter; - proto method start-slip(|) { * } + proto method start-slip(|) {*} multi method start-slip(Slip:U $slip) { $slip } @@ -42,7 +42,7 @@ my role SlippyIterator does Iterator { ) } - proto method slip-all(|) { * } + proto method slip-all(|) {*} multi method slip-all(Slip:U $slip, $target) { $target.push($slip) } diff --git a/src/core/Stringy.pm b/src/core/Stringy.pm index 5512c97aac5..711b925ff93 100644 --- a/src/core/Stringy.pm +++ b/src/core/Stringy.pm @@ -11,16 +11,16 @@ multi sub infix:(Stringy:D \a, Stringy:D \b) { ) } -proto sub prefix:<~>($) is pure { * } +proto sub prefix:<~>($) is pure {*} multi sub prefix:<~>(\a) { a.Stringy } multi sub prefix:<~>(int $a) { nqp::p6box_s($a) } multi sub prefix:<~>(num $a) { nqp::p6box_s($a) } -proto sub infix:<~>(|) is pure { * } +proto sub infix:<~>(|) is pure {*} multi sub infix:<~>($x = '') { $x.Stringy } multi sub infix:<~>(\a, \b) { a.Stringy ~ b.Stringy } -proto sub infix:(Mu $?, Mu $?) is pure { * } +proto sub infix:(Mu $?, Mu $?) is pure {*} multi sub infix:() { Failure.new("No zero-arg meaning for infix:") } multi sub infix:($x) { $x.Stringy } multi sub infix:($s, Num:D $n) { @@ -31,48 +31,48 @@ multi sub infix:($s, Num:D $n) { multi sub infix:($s, Any:D $n) { $s.Stringy x $n.Int } multi sub infix:($s, Any:U $n) { $s.Stringy x $n.Numeric.Int } -proto sub infix:(Mu $?, Mu $?) is pure { * } +proto sub infix:(Mu $?, Mu $?) is pure {*} multi sub infix:(\a, \b) { a.Stringy cmp b.Stringy } -proto sub infix:(Mu $?, Mu $?) is pure { * } +proto sub infix:(Mu $?, Mu $?) is pure {*} multi sub infix:($x?) { Bool::True } multi sub infix:(\a, \b) { a.Stringy eq b.Stringy } -proto sub infix:(Mu $?, Mu $?) is pure { * } +proto sub infix:(Mu $?, Mu $?) is pure {*} multi sub infix:($x?) { Bool::True } multi sub infix:(Mu \a, Mu \b) { a !eq b } multi sub infix:(Any \a, Any \b) { a.Stringy ne b.Stringy } -proto sub infix:(Mu $?, Mu $?) is pure { * } +proto sub infix:(Mu $?, Mu $?) is pure {*} multi sub infix:($x?) { Bool::True } multi sub infix:(\a, \b) { a.Stringy lt b.Stringy } -proto sub infix:(Mu $?, Mu $?) is pure { * } +proto sub infix:(Mu $?, Mu $?) is pure {*} multi sub infix:($x?) { Bool::True } multi sub infix:(\a, \b) { a.Stringy le b.Stringy } -proto sub infix:(Mu $?, Mu $?) is pure { * } +proto sub infix:(Mu $?, Mu $?) is pure {*} multi sub infix:($x?) { Bool::True } multi sub infix:(\a, \b) { a.Stringy gt b.Stringy } -proto sub infix:(Mu $?, Mu $?) is pure { * } +proto sub infix:(Mu $?, Mu $?) is pure {*} multi sub infix:($x?) { Bool::True } multi sub infix:(\a, \b) { a.Stringy ge b.Stringy } -proto sub infix:<~|>(Mu $?, Mu $?) is pure { * } +proto sub infix:<~|>(Mu $?, Mu $?) is pure {*} multi sub infix:<~|>($x = '') { $x.Stringy } multi sub infix:<~|>(\a, \b) { a.Stringy ~| b.Stringy } -proto sub infix:<~^>(Mu $?, Mu $?) is pure { * } +proto sub infix:<~^>(Mu $?, Mu $?) is pure {*} multi sub infix:<~^>($x = '') { $x.Stringy } multi sub infix:<~^>(\a, \b) { a.Stringy ~^ b.Stringy } -proto sub infix:<~&>(Mu $?, Mu $?) is pure { * } +proto sub infix:<~&>(Mu $?, Mu $?) is pure {*} multi sub infix:<~&>() { Failure.new("No zero-arg meaning for infix:<~&>") } multi sub infix:<~&>($x) { $x.Stringy } multi sub infix:<~&>(\a, \b) { a.Stringy ~& b.Stringy } -proto sub prefix:<~^>(Mu $) is pure { * } +proto sub prefix:<~^>(Mu $) is pure {*} multi sub prefix:<~^>(\a) { ~^ a.Stringy } # vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Supply.pm b/src/core/Supply.pm index f13ab1ae705..1c7a0de6552 100644 --- a/src/core/Supply.pm +++ b/src/core/Supply.pm @@ -59,7 +59,7 @@ my class Supplier::Preserving { ... } my class Supply does Awaitable { has Tappable $!tappable; - proto method new(|) { * } + proto method new(|) {*} multi method new() { X::Supply::New.new.throw } @@ -604,7 +604,7 @@ my class Supply does Awaitable { } } - proto method classify(|) { * } + proto method classify(|) {*} multi method classify(Supply:D: &mapper ) { self!classify(&mapper); } @@ -615,7 +615,7 @@ my class Supply does Awaitable { self!classify({ @mapper[$^a] }); } - proto method categorize (|) { * } + proto method categorize (|) {*} multi method categorize(Supply:D: &mapper ) { self!classify(&mapper, :multi); } @@ -1292,7 +1292,7 @@ my class Supply does Awaitable { } } - proto method throttle(|) { * } + proto method throttle(|) {*} multi method throttle(Supply:D $self: Int() $elems, Real() $seconds, @@ -1585,7 +1585,7 @@ my class Supplier { $!taplist.done(); } - proto method quit($) { * } + proto method quit($) {*} multi method quit(Supplier:D: Exception $ex) { $!taplist.quit($ex); } diff --git a/src/core/TypedArray.pm b/src/core/TypedArray.pm index 02c76569ae3..53ca430a031 100644 --- a/src/core/TypedArray.pm +++ b/src/core/TypedArray.pm @@ -2,7 +2,7 @@ my role TypedArray[::TValue] does Positional[TValue] { - proto method new(|) { * } + proto method new(|) {*} multi method new(:$shape!) { set-descriptor(nqp::if( nqp::defined($shape), @@ -58,7 +58,7 @@ # must have a proto here to hide the candidates in Array # otherwise we could bind any value to the Array - proto method BIND-POS(|) { * } + proto method BIND-POS(|) {*} # these BIND-POSses are identical to Array's, except for bindval multi method BIND-POS(Array:D: int $pos, TValue \bindval) is raw { diff --git a/src/core/VM.pm b/src/core/VM.pm index 4ef162f77bb..a181d51ae90 100644 --- a/src/core/VM.pm +++ b/src/core/VM.pm @@ -69,7 +69,7 @@ class VM does Systemic { !! $platform-name.IO } - proto method osname(|) { * } + proto method osname(|) {*} multi method osname(VM:U:) { #?if jvm nqp::lc(nqp::atkey(nqp::jvmgetproperties,'os.name')) diff --git a/src/core/array_slice.pm b/src/core/array_slice.pm index 8523cd3cc2a..5db5ec8fe36 100644 --- a/src/core/array_slice.pm +++ b/src/core/array_slice.pm @@ -10,7 +10,7 @@ # if called with an Int. Before it does so, it may cause the calling code # to switch to a memoized version of an iterator by modifying variables in # the caller's scope. -proto sub POSITIONS(|) { * } +proto sub POSITIONS(|) {*} multi sub POSITIONS( \SELF, \pos, @@ -87,7 +87,7 @@ multi sub POSITIONS( pos-list } -proto sub postcircumfix:<[ ]>(|) is nodal { * } +proto sub postcircumfix:<[ ]>(|) is nodal {*} multi sub postcircumfix:<[ ]>( \SELF, Any:U $type, |c ) is raw { die "Unable to call postcircumfix {try SELF.VAR.name}[ $type.gist() ] with a type object\n" diff --git a/src/core/asyncops.pm b/src/core/asyncops.pm index 0dc5ec2bd02..dca4240b5fe 100644 --- a/src/core/asyncops.pm +++ b/src/core/asyncops.pm @@ -13,7 +13,7 @@ my role X::Await::Died { } } -proto sub await(|) { * } +proto sub await(|) {*} multi sub await() { die "Must specify a Promise or Channel to await on (got an empty list)"; } diff --git a/src/core/multidim_slice.pm b/src/core/multidim_slice.pm index 584185db1ae..194d043fe4b 100644 --- a/src/core/multidim_slice.pm +++ b/src/core/multidim_slice.pm @@ -1,5 +1,5 @@ # all sub postcircumfix [;] candidates here please -proto sub postcircumfix:<[; ]>(|) is nodal { * } +proto sub postcircumfix:<[; ]>(|) is nodal {*} sub MD-ARRAY-SLICE-ONE-POSITION(\SELF, \indices, \idx, int $dim, \target) is raw { my int $next-dim = $dim + 1; diff --git a/src/core/native_array.pm b/src/core/native_array.pm index f7085bc63c2..29acd9b25d7 100644 --- a/src/core/native_array.pm +++ b/src/core/native_array.pm @@ -27,7 +27,7 @@ my class array does Iterable { !! nqp::create(self) } - proto method STORE(|) { * } + proto method STORE(|) {*} multi method STORE(array:D: *@values) { self.STORE(@values) } multi method push(array:D: **@values) { self.append(@values) } @@ -1031,7 +1031,7 @@ my class array does Iterable { ) } - proto method STORE(|) { * } + proto method STORE(|) {*} multi method STORE(::?CLASS:D: Mu \item) { X::Assignment::ToShaped.new(shape => self.shape).throw } @@ -2752,7 +2752,7 @@ my class array does Iterable { die "Cannot delete from a natively typed array"; } - proto method ASSIGN-POS(|) { * } # Hide candidates from Any + proto method ASSIGN-POS(|) {*} # Hide candidates from Any multi method ASSIGN-POS(Any:U \SELF: \pos, Mu \assignee) { # auto-viv SELF.AT-POS(pos) = assignee; } @@ -2773,7 +2773,7 @@ my class array does Iterable { multi method elems(array:D:) { nqp::elems(self) } method shape() { (*,) } - proto method Int(|) { * } + proto method Int(|) {*} multi method Int(array:D:) { nqp::elems(self) } multi method end(array:D:) { nqp::elems(self) - 1 } diff --git a/src/core/set_addition.pm b/src/core/set_addition.pm index 3bf3f174b81..62df81eeeeb 100644 --- a/src/core/set_addition.pm +++ b/src/core/set_addition.pm @@ -2,7 +2,7 @@ # (+) baggy addition (ASCII) # ⊎ baggy addition -proto sub infix:<(+)>(|) is pure { * } +proto sub infix:<(+)>(|) is pure {*} multi sub infix:<(+)>() { bag() } multi sub infix:<(+)>(Bag:D $a) { $a } multi sub infix:<(+)>(Mix:D $a) { $a } diff --git a/src/core/set_difference.pm b/src/core/set_difference.pm index 73213b168ad..3b5d66a0055 100644 --- a/src/core/set_difference.pm +++ b/src/core/set_difference.pm @@ -2,7 +2,7 @@ # (-) set difference (ASCII) # ∖ set difference -proto sub infix:<(-)>(|) is pure { * } +proto sub infix:<(-)>(|) is pure {*} multi sub infix:<(-)>() { set() } multi sub infix:<(-)>(QuantHash:D $a) { $a } # Set/Bag/Mix multi sub infix:<(-)>(SetHash:D $a) { $a.Set } diff --git a/src/core/set_intersection.pm b/src/core/set_intersection.pm index 6391f74f39d..0f131b298d4 100644 --- a/src/core/set_intersection.pm +++ b/src/core/set_intersection.pm @@ -2,7 +2,7 @@ # (&) intersection (ASCII) # ∩ intersection -proto sub infix:<(&)>(|) is pure { * } +proto sub infix:<(&)>(|) is pure {*} multi sub infix:<(&)>() { set() } multi sub infix:<(&)>(QuantHash:D $a) { $a } # Set/Bag/Mix multi sub infix:<(&)>(SetHash:D $a) { $a.Set } diff --git a/src/core/set_multiply.pm b/src/core/set_multiply.pm index 389695439c1..07d6cd50843 100644 --- a/src/core/set_multiply.pm +++ b/src/core/set_multiply.pm @@ -2,7 +2,7 @@ # (.) set multiplication (ASCII) # ⊍ set multiplication -proto sub infix:<(.)>(|) is pure { * } +proto sub infix:<(.)>(|) is pure {*} multi sub infix:<(.)>() { bag() } multi sub infix:<(.)>(Bag:D $a) { $a } multi sub infix:<(.)>(Mix:D $a) { $a } diff --git a/src/core/set_operators.pm b/src/core/set_operators.pm index 731fc67bd77..7da80a96ade 100644 --- a/src/core/set_operators.pm +++ b/src/core/set_operators.pm @@ -1,12 +1,12 @@ -proto sub set(|) { * } +proto sub set(|) {*} multi sub set() { BEGIN nqp::create(Set) } multi sub set(*@a --> Set:D) { Set.new(@a) } -proto sub bag(|) { * } +proto sub bag(|) {*} multi sub bag() { BEGIN nqp::create(Bag) } multi sub bag(*@a --> Bag:D) { Bag.new(@a) } -proto sub mix(|) { * } +proto sub mix(|) {*} multi sub mix() { BEGIN nqp::create(Mix) } multi sub mix(*@a --> Mix:D) { Mix.new(@a) } diff --git a/src/core/set_symmetric_difference.pm b/src/core/set_symmetric_difference.pm index 48a00cb3690..9d408228694 100644 --- a/src/core/set_symmetric_difference.pm +++ b/src/core/set_symmetric_difference.pm @@ -2,7 +2,7 @@ # (^) set symmetric difference (Texas) # ⊖ set symmetric difference -proto sub infix:<(^)>(|) is pure { * } +proto sub infix:<(^)>(|) is pure {*} multi sub infix:<(^)>() { set() } multi sub infix:<(^)>(QuantHash:D $a) { $a } # Set/Bag/Mix multi sub infix:<(^)>(SetHash:D $a) { $a.Set } diff --git a/src/core/set_union.pm b/src/core/set_union.pm index 1cc4fe5c9d7..83c9957084c 100644 --- a/src/core/set_union.pm +++ b/src/core/set_union.pm @@ -2,7 +2,7 @@ # (|) union (ASCII) # ∪ union -proto sub infix:<(|)>(|) is pure { * } +proto sub infix:<(|)>(|) is pure {*} multi sub infix:<(|)>() { set() } multi sub infix:<(|)>(QuantHash:D $a) { $a } # Set/Bag/Mix multi sub infix:<(|)>(SetHash:D $a) { $a.Set } diff --git a/src/core/stubs.pm b/src/core/stubs.pm index 6ea786e1bf5..d81de9c6d6b 100644 --- a/src/core/stubs.pm +++ b/src/core/stubs.pm @@ -61,7 +61,7 @@ sub DYNAMIC(\name) is raw { # actually appear in the setting). { my class Dummy { - our proto method AUTOGEN(::T $: |) { * } + our proto method AUTOGEN(::T $: |) {*} } Dummy.HOW.set_autogen_proto(&Dummy::AUTOGEN); } diff --git a/src/core/traits.pm b/src/core/traits.pm index 3a55ad7a1f5..05d0c1232eb 100644 --- a/src/core/traits.pm +++ b/src/core/traits.pm @@ -10,7 +10,7 @@ my class X::Comp::Trait::Unknown { ... } my class X::Experimental { ... } my class Pod::Block::Declarator { ... } -proto sub trait_mod:(|) { * } +proto sub trait_mod:(|) {*} multi sub trait_mod:(Mu:U $child, Mu:U $parent) { if $parent.HOW.archetypes.inheritable() { $child.^add_parent($parent); @@ -158,7 +158,7 @@ multi sub trait_mod:(Routine:D $r, :$onlystar!) { multi sub trait_mod:(Routine:D $r, :prec(%spec)!) { my role Precedence { has %!prec; - proto method prec(|) { * } + proto method prec(|) {*} multi method prec() is raw { %!prec } multi method prec(Str:D $key) { nqp::ifnull( @@ -306,7 +306,7 @@ multi sub trait_mod:(Mu:U $docee, :$trailing_docs!) { Rakudo::Internals.SET_TRAILING_DOCS($docee.HOW, $trailing_docs); } -proto sub trait_mod:(|) { * } +proto sub trait_mod:(|) {*} multi sub trait_mod:(Mu:U $doee, Mu:U $role) { if $role.HOW.archetypes.composable() { $doee.^add_role($role) @@ -322,7 +322,7 @@ multi sub trait_mod:(Mu:U $doee, Mu:U $role) { } } -proto sub trait_mod:(|) { * } +proto sub trait_mod:(|) {*} multi sub trait_mod:(Mu:U $target, Mu:U $type) { # XXX Ensure we can do this, die if not. $target.^set_of($type); @@ -360,7 +360,7 @@ multi sub trait_mod:(Routine:D $r, :$nodal!) { }) if $nodal; } -proto sub trait_mod:(|) { * } +proto sub trait_mod:(|) {*} multi sub trait_mod:(Routine:D $target, Mu:U $type) { my $sig := $target.signature; X::Redeclaration.new(what => 'return type for', symbol => $target, @@ -370,7 +370,7 @@ multi sub trait_mod:(Routine:D $target, Mu:U $type) { $target.^mixin(Callable.^parameterize($type)) } -proto sub trait_mod:(|) { * } +proto sub trait_mod:(|) {*} multi sub trait_mod:(Attribute:D $target, $thunk) { $target does role { has $.handles; @@ -465,7 +465,7 @@ multi sub trait_mod:(Method:D $m, &thunk) { 0; } -proto sub trait_mod:(|) { * } +proto sub trait_mod:(|) {*} multi sub trait_mod:(Attribute:D $attr, |c ) { X::Comp::Trait::Unknown.new( file => $?FILE, @@ -480,12 +480,12 @@ multi sub trait_mod:(Attribute $attr, Mu :$build!) { # internal usage $attr.set_build($build) } -proto sub trait_mod:(|) { * } +proto sub trait_mod:(|) {*} multi sub trait_mod:(Mu:U $truster, Mu:U $trustee) { $truster.^add_trustee($trustee); } -proto sub trait_mod:(|) { * } +proto sub trait_mod:(|) {*} multi sub trait_mod:(Mu:U $child, Mu:U $parent) { if $parent.HOW.archetypes.inheritable() { $child.^add_parent($parent, :hides); From 6bca84fa1a7a13e5083c784315d7153d0cc7e0db Mon Sep 17 00:00:00 2001 From: MasterDuke17 Date: Sat, 4 Nov 2017 00:14:39 -0400 Subject: [PATCH 675/692] Add some INTERPOLATE variations Create INTERPOLATE_ASSERTION and some multis to pull functionality out of the regular INTERPOLATE multis. Makes `/ $rx /` and `/ <$rx> /` a bit faster. --- src/Perl6/Actions.nqp | 8 +- src/core/Match.pm | 174 ++++++++++++++++++++++++++++++++---------- 2 files changed, 136 insertions(+), 46 deletions(-) diff --git a/src/Perl6/Actions.nqp b/src/Perl6/Actions.nqp index 7720d540097..f52744a369c 100644 --- a/src/Perl6/Actions.nqp +++ b/src/Perl6/Actions.nqp @@ -10011,7 +10011,7 @@ class Perl6::RegexActions is QRegex::P6Regex::Actions does STDActions { method assertion:sym<{ }>($/) { make QAST::Regex.new( QAST::NodeList.new( - QAST::SVal.new( :value('INTERPOLATE') ), + QAST::SVal.new( :value('INTERPOLATE_ASSERTION') ), $.ast, QAST::IVal.new( :value(%*RX && %*RX ?? 3 !! %*RX ?? 2 !! %*RX ?? 1 !! 0) ), QAST::IVal.new( :value(monkey_see_no_eval($/)) ), @@ -10049,7 +10049,7 @@ class Perl6::RegexActions is QRegex::P6Regex::Actions does STDActions { } else { make QAST::Regex.new( QAST::NodeList.new( - QAST::SVal.new( :value('INTERPOLATE') ), + QAST::SVal.new( :value('INTERPOLATE_ASSERTION') ), wanted($.ast, 'assertvar2'), QAST::IVal.new( :value(%*RX && %*RX ?? 3 !! %*RX ?? 2 !! %*RX ?? 1 !! 0) ), QAST::IVal.new( :value(monkey_see_no_eval($/)) ), @@ -10211,7 +10211,7 @@ class Perl6::P5RegexActions is QRegex::P5Regex::Actions does STDActions { method p5metachar:sym<(??{ })>($/) { make QAST::Regex.new( QAST::NodeList.new( - QAST::SVal.new( :value('INTERPOLATE') ), + QAST::SVal.new( :value($*INTERPOLATION ?? 'INTERPOLATE_ASSERTION' !! 'INTERPOLATE') ), $.ast, QAST::IVal.new( :value(%*RX ?? 1 !! 0) ), QAST::IVal.new( :value(monkey_see_no_eval($/)) ), @@ -10227,7 +10227,7 @@ class Perl6::P5RegexActions is QRegex::P5Regex::Actions does STDActions { method p5metachar:sym($/) { make QAST::Regex.new( QAST::NodeList.new( - QAST::SVal.new( :value('INTERPOLATE') ), + QAST::SVal.new( :value($*INTERPOLATION ?? 'INTERPOLATE_ASSERTION' !! 'INTERPOLATE') ), wanted($.ast, 'p5var'), QAST::IVal.new( :value(%*RX ?? 1 !! 0) ), QAST::IVal.new( :value(monkey_see_no_eval($/)) ), diff --git a/src/core/Match.pm b/src/core/Match.pm index 4581eef0799..72803874019 100644 --- a/src/core/Match.pm +++ b/src/core/Match.pm @@ -210,7 +210,7 @@ my class Match is Capture is Cool does NQPMatchRole { (var)(self) } - multi method INTERPOLATE(Iterable:D \var, int \im, int \monkey, int \s, int \a, \context) { + multi method INTERPOLATE(Iterable:D \var, int \im, int \monkey, int \s, $, \context) { my $maxmatch; my \cur := self.'!cursor_start_cur'(); my str $tgt = cur.target; @@ -245,19 +245,8 @@ my class Match is Capture is Cool does NQPMatchRole { my Mu $topic := nqp::atpos(list,$j); nqp::bindpos(alts,$j,$topic); - # We are in a regex assertion, the strings we get will - # be treated as regex rules. - if a { - return cur.'!cursor_start_cur'() - if nqp::istype($topic,Associative); - my $rx := MAKE_REGEX($topic,im == 1 || im == 3,im == 2 || im == 3,monkey,context); - nfa.mergesubstates($start,0,nqp::decont($fate), - nqp::findmethod($rx,'NFA')($rx), - Mu); - } - # A Regex already. - elsif nqp::istype($topic,Regex) { + if nqp::istype($topic,Regex) { nfa.mergesubstates($start,0,nqp::decont($fate), nqp::findmethod($topic,'NFA')($topic), Mu); @@ -308,19 +297,8 @@ my class Match is Capture is Cool does NQPMatchRole { my $match; my int $len; - # We are in a regex assertion, the strings we get will be - # treated as regex rules. - if a { - return cur.'!cursor_start_cur'() - if nqp::istype($topic,Associative); - - my $rx := MAKE_REGEX($topic,im == 1 || im == 3,im == 2 || im == 3,monkey,context); - $match := self.$rx; - $len = $match.pos - $match.from; - } - # A Regex already. - elsif nqp::istype($topic,Regex) { + if nqp::istype($topic,Regex) { $match := self.$topic; $len = $match.pos - $match.from; } @@ -410,11 +388,8 @@ my class Match is Capture is Cool does NQPMatchRole { !! cur } - multi method INTERPOLATE(Associative:D \var, int \im, $, $, int \a, \context) { + multi method INTERPOLATE(Associative:D \var, int \im, $, $, $, \context) { my \cur := self.'!cursor_start_cur'(); - if a { - return cur.'!cursor_start_cur'() - } my $maxmatch; my str $tgt = cur.target; @@ -508,7 +483,7 @@ my class Match is Capture is Cool does NQPMatchRole { !! cur } - multi method INTERPOLATE(Regex:D \var, int \im, int \monkey, $, int \a, $) { + multi method INTERPOLATE(Regex:D \var, int \im, int \monkey, $, $, $) { my $maxmatch; my \cur := self.'!cursor_start_cur'(); @@ -534,7 +509,7 @@ my class Match is Capture is Cool does NQPMatchRole { !! cur } - multi method INTERPOLATE(Mu:D \var, int \im, int \monkey, $, int \a, \context) { + multi method INTERPOLATE(Mu:D \var, int \im, int \monkey, $, $, \context) { my $maxmatch; my \cur = self.'!cursor_start_cur'(); my str $tgt = cur.target; @@ -546,17 +521,9 @@ my class Match is Capture is Cool does NQPMatchRole { my $match; my int $len; - # We are in a regex assertion, the strings we get will be - # treated as regex rules. - if a { - my $rx := MAKE_REGEX(var,im == 1 || im == 3,im == 2 || im == 3,monkey,context); - $match := self.$rx; - $len = $match.pos - $match.from; - } - # The pattern is a zero length string. $len and and $topic_str # are used later on if this condition does not hold. - elsif nqp::iseq_i(($len = nqp::chars($topic_str = var.Str)),0) { + if nqp::iseq_i(($len = nqp::chars($topic_str = var.Str)),0) { $match = 1; } @@ -630,6 +597,106 @@ my class Match is Capture is Cool does NQPMatchRole { $maxmatch := $match; } + nqp::isge_i($maxlen,0) + ?? cur.'!cursor_pass'(nqp::add_i($pos,$maxlen), '') + !! cur + } + + multi method INTERPOLATE(Mu:U \var, $, $, $, $, $) { + self."!cursor_start_cur"() + } + + proto method INTERPOLATE_ASSERTION(|) {*} + + multi method INTERPOLATE_ASSERTION(Associative:D $, $, $, $, $, $) { + return self.'!cursor_start_cur'().'!cursor_start_cur'() + } + + multi method INTERPOLATE_ASSERTION(Iterable:D \var, int \im, int \monkey, int \s, $, \context) { + my $maxmatch; + my \cur := self.'!cursor_start_cur'(); + my str $tgt = cur.target; + my int $eos = nqp::chars($tgt); + + my int $maxlen = -1; + my int $pos = nqp::getattr_i(cur, $?CLASS, '$!from'); + my int $start = 1; + my int $nomod = im == 0; + + my Mu $order := nqp::list(); + + # Looks something we need to loop over + if !nqp::iscont(var) { + my \varlist := var.list; + my int $elems = varlist.elems; # reifies + my \list := nqp::getattr(varlist,List,'$!reified'); + + # Order matters for sequential matching, so no NFA involved. + if s { + $order := list; + } + + # prepare to run the NFA if var is array-ish. + else { + my Mu \nfa := QRegex::NFA.new; + my Mu \alts := nqp::setelems(nqp::list,$elems); + my int $fate = 0; + my int $j = -1; + + while nqp::islt_i(++$j,$elems) { + my Mu $topic := nqp::atpos(list,$j); + nqp::bindpos(alts,$j,$topic); + + # We are in a regex assertion, the strings we get will + # be treated as regex rules. + return cur.'!cursor_start_cur'() if nqp::istype($topic,Associative); + my $rx := MAKE_REGEX($topic,im == 1 || im == 3,im == 2 || im == 3,monkey,context); + nfa.mergesubstates($start,0,nqp::decont($fate),nqp::findmethod($rx,'NFA')($rx),Mu); + + ++$fate; + } + + # Now run the NFA + my Mu \fates := nqp::findmethod(nfa,'run')(nfa,$tgt,$pos); + my int $count = nqp::elems(fates); + nqp::setelems($order,$count); + $j = -1; + nqp::bindpos($order,$j,nqp::atpos(alts,nqp::atpos_i(fates,$j))) + while nqp::islt_i(++$j,$count); + } + } + + # Use the var as it is if it's not array-ish. + else { + nqp::push($order, var); + } + + my str $topic_str; + my int $omax = nqp::elems($order); + my int $o = -1; + while nqp::islt_i(++$o,$omax) { + my Mu $topic := nqp::atpos($order,$o); + my $match; + my int $len; + + # We are in a regex assertion, the strings we get will be + # treated as regex rules. + return cur.'!cursor_start_cur'() + if nqp::istype($topic,Associative); + + my $rx := MAKE_REGEX($topic,im == 1 || im == 3,im == 2 || im == 3,monkey,context); + $match := self.$rx; + $len = $match.pos - $match.from; + + if $match + && nqp::isgt_i($len,$maxlen) + && nqp::isle_i(nqp::add_i($pos,$len),$eos) { + $maxlen = $len; + $maxmatch := $match; + last if s; # stop here for sequential alternation + } + } + nqp::istype($maxmatch, Match) ?? $maxmatch !! nqp::isge_i($maxlen,0) @@ -637,8 +704,31 @@ my class Match is Capture is Cool does NQPMatchRole { !! cur } - multi method INTERPOLATE(Mu:U \var, $, $, $, $, $) { - self."!cursor_start_cur"() + multi method INTERPOLATE_ASSERTION(Mu:D \var, int \im, int \monkey, $, $, \context) { + my $maxmatch; + my \cur = self.'!cursor_start_cur'(); + + my int $maxlen = -1; + my int $pos = nqp::getattr_i(cur, $?CLASS, '$!from'); + + # We are in a regex assertion, the strings we get will be + # treated as regex rules. + my $rx := MAKE_REGEX(var,im == 1 || im == 3,im == 2 || im == 3,monkey,context); + my $match := self.$rx; + my int $len = $match.pos - $match.from; + + if $match + && nqp::isgt_i($len,$maxlen) + && nqp::isle_i(nqp::add_i($pos,$len),nqp::chars(cur.target)) { + $maxlen = $len; + $maxmatch := $match; + } + + nqp::istype($maxmatch, Match) + ?? $maxmatch + !! nqp::isge_i($maxlen,0) + ?? cur.'!cursor_pass'(nqp::add_i($pos,$maxlen), '') + !! cur } method CALL_SUBRULE($rule, |c) { From a8c789ecac77e0a696cc12c2e0b9cea42809f272 Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 4 Nov 2017 15:30:31 +0000 Subject: [PATCH 676/692] Bump NQP --- tools/build/NQP_REVISION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/build/NQP_REVISION b/tools/build/NQP_REVISION index 36034bd782b..1fd82b9f14b 100644 --- a/tools/build/NQP_REVISION +++ b/tools/build/NQP_REVISION @@ -1 +1 @@ -2017.10-32-ga3f7bb8 +2017.10-45-ga25acd1 From 629e8684e145aa3c47489ecc44534f39cffe2e5d Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sat, 4 Nov 2017 16:30:34 +0000 Subject: [PATCH 677/692] Bump NQP --- tools/build/NQP_REVISION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/build/NQP_REVISION b/tools/build/NQP_REVISION index 1fd82b9f14b..0f0d9d876f4 100644 --- a/tools/build/NQP_REVISION +++ b/tools/build/NQP_REVISION @@ -1 +1 @@ -2017.10-45-ga25acd1 +2017.10-46-gf263b9c From 2f12bea11424e3b27b0efa6dab78cd20150c7497 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sat, 4 Nov 2017 19:38:34 +0100 Subject: [PATCH 678/692] Telemetry tweaks - make sure order of @format *is* actually alphabetical - add blurb about supervisor thread in report header --- lib/Telemetry.pm6 | 40 +++++++++++++++++++++++++++++----------- 1 file changed, 29 insertions(+), 11 deletions(-) diff --git a/lib/Telemetry.pm6 b/lib/Telemetry.pm6 index ebdcb825539..15b9fe5967c 100644 --- a/lib/Telemetry.pm6 +++ b/lib/Telemetry.pm6 @@ -666,7 +666,7 @@ constant @default_format = "The number of affinity threads" >>,<< cpu cpu 8d - "The amount of CPU used (in microseconds)" + "The total amount of CPU used (in microseconds)" >>,<< cpu-user cpu-user 8d "The amount of CPU used in user code (in microseconds)" @@ -674,14 +674,14 @@ constant @default_format = cpu-sys cpu-sys 8d "The amount of CPU used in system overhead (in microseconds)" >>,<< - gw general-workers 3d - "The number of general worker threads" + gtc general-tasks-completed 8d + "The number of tasks completed in general worker threads" >>,<< gtq general-tasks-queued 3d "The number of tasks queued for execution in general worker threads" >>,<< - gtc general-tasks-completed 8d - "The number of tasks completed in general worker threads" + gw general-workers 3d + "The number of general worker threads" >>,<< id-rss id-rss 8d "Integral unshared data size (in Kbytes)" @@ -728,14 +728,14 @@ constant @default_format = s supervisor 1d "The number of supervisors" >>,<< - tw timer-workers 3d - "The number of timer threads" + ttc timer-tasks-completed 8d + "The number of tasks completed in timer threads" >>,<< ttq timer-tasks-queued 3d "The number of tasks queued for execution in timer threads" >>,<< - ttc timer-tasks-completed 8d - "The number of tasks completed in timer threads" + tw timer-workers 3d + "The number of timer threads" >>,<< util% utilization 6.2f "Percentage of CPU utilization (0..100%)" @@ -769,16 +769,34 @@ multi sub report( ?? prepare-format(@format) !! (%default_format := prepare-format(@default_format)); - my $total = @s[*-1] - @s[0]; + my $first = @s[0]; + my $last = @s[*-1]; + my $total = $last - $first; my $text := nqp::list_s(qq:to/HEADER/.chomp); Telemetry Report of Process #$*PID ({Instant.from-posix(nqp::time_i).DateTime}) +HEADER + + if $first.supervisor { + nqp::push_s($text,"Supervisor thread ran for the whole period."); + } + elsif !$last.supervisor { + nqp::push_s($text,"No supervisor thread has been running."); + } + else { + my $started = @s.first: *.supervisor; + nqp::push_s($text,"Supervisor thread ran for { + (100 * ($started.wallclock - $first.wallclock) / $total.wallclock) + .fmt("%5.2f") + }% of the time."); + } + + nqp::push_s($text,qq:to/HEADER/.chomp); Number of Snapshots: {+@s} Initial Size: { @s[0].max-rss.fmt('%9d') } Kbytes Total Time: { (%format[DISPLAY]($total.wallclock)) } seconds Total CPU Usage: { (%format[DISPLAY]($total.cpu)) } seconds HEADER - my @formats = %format{@columns}; sub push-period($period --> Nil) { nqp::push_s($text, From 4ed91ed64440f7b32c64e482887f2a68d6fed953 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sat, 4 Nov 2017 20:15:09 +0100 Subject: [PATCH 679/692] More Telemetry tweaks - default for :header-repeat is now %*ENV // 32 - default for :legend is now %*ENV // 1 - corrected report header for cpu/wallclock: we want seconds, not microseconds --- lib/Telemetry.pm6 | 34 +++++++++++++++++++++++----------- 1 file changed, 23 insertions(+), 11 deletions(-) diff --git a/lib/Telemetry.pm6 b/lib/Telemetry.pm6 index 15b9fe5967c..26ff1d1b8c8 100644 --- a/lib/Telemetry.pm6 +++ b/lib/Telemetry.pm6 @@ -605,7 +605,7 @@ multi sub periods(@s) { (1..^@s).map: { @s[$_] - @s[$_ - 1] } } # Telemetry reporting features ------------------------------------------------- proto sub report(|) is export {*} -multi sub report(:@columns, :$legend, :$header-repeat = 32, :@format) { +multi sub report(:@columns, :$legend, :$header-repeat, :@format) { my $s := nqp::clone(nqp::getattr(@snaps,List,'$!reified')); nqp::setelems(nqp::getattr(@snaps,List,'$!reified'),0); nqp::push($s,Telemetry.new) if nqp::elems($s) == 1; @@ -747,12 +747,13 @@ constant @default_format = multi sub report( @s, - :@columns is copy, - :$legend, - :$header-repeat = 32, + :@columns is copy, + :$header-repeat is copy, + :$legend is copy, :@format, ) { + # determine columns to be displayed unless @columns { if %*ENV -> $rrc { @columns = $rrc.comb( /<[\w-]>+/ ); @@ -762,6 +763,16 @@ multi sub report( } } + # set header repeat flag + without $header-repeat { + $header-repeat = $_.Int with %*ENV // 32; + } + + # set legend flag + without $legend { + $legend = $_.Int with %*ENV // 1; + } + # get / calculate the format info we need my %format := %default_format ?? %default_format @@ -776,25 +787,26 @@ multi sub report( Telemetry Report of Process #$*PID ({Instant.from-posix(nqp::time_i).DateTime}) HEADER + # give the supervisor blurb if $first.supervisor { - nqp::push_s($text,"Supervisor thread ran for the whole period."); + nqp::push_s($text,"Supervisor thread ran for the whole time"); } elsif !$last.supervisor { - nqp::push_s($text,"No supervisor thread has been running."); + nqp::push_s($text,"No supervisor thread has been running"); } else { my $started = @s.first: *.supervisor; nqp::push_s($text,"Supervisor thread ran for { - (100 * ($started.wallclock - $first.wallclock) / $total.wallclock) + (100 * ($last.wallclock - $started.wallclock) / $total.wallclock) .fmt("%5.2f") - }% of the time."); + }% of the time"); } nqp::push_s($text,qq:to/HEADER/.chomp); Number of Snapshots: {+@s} Initial Size: { @s[0].max-rss.fmt('%9d') } Kbytes -Total Time: { (%format[DISPLAY]($total.wallclock)) } seconds -Total CPU Usage: { (%format[DISPLAY]($total.cpu)) } seconds +Total Time: { ($total.wallclock / 1000000).fmt('%9.2f') } seconds +Total CPU Usage: { ($total.cpu / 1000000).fmt('%9.2f') } seconds HEADER my @formats = %format{@columns}; @@ -835,6 +847,6 @@ HEADER sub T () is export { Telemetry.new } # Make sure we tell the world if we're implicitely told to do so --------------- -END { if @snaps { snap; note report(:legend) } } +END { if @snaps { snap; note report } } # vim: ft=perl6 expandtab sw=4 From c4d373c51433ee58b2f44955e98c8d741ec29bb1 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sat, 4 Nov 2017 21:42:15 +0100 Subject: [PATCH 680/692] Expose basic CPU usage information: Kernel.cpu-usage For situations like the Benchmark module, we don't want to have to load a lot of stuff. This gives the bare-bones of the stuff we need there. --- src/core/Kernel.pm | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/core/Kernel.pm b/src/core/Kernel.pm index 0e891a7d5e4..9d145487f8b 100644 --- a/src/core/Kernel.pm +++ b/src/core/Kernel.pm @@ -170,6 +170,14 @@ class Kernel does Systemic { multi method signal(Kernel:D: Int:D \signal --> Int:D) { signal } method cpu-cores() is raw { nqp::cpucores } + + method cpu-usage() is raw { + my \rusage = nqp::getrusage(); + nqp::atpos_i(rusage, nqp::const::RUSAGE_UTIME_SEC) * 1000000 + + nqp::atpos_i(rusage, nqp::const::RUSAGE_UTIME_MSEC) + + nqp::atpos_i(rusage, nqp::const::RUSAGE_STIME_SEC) * 1000000 + + nqp::atpos_i(rusage, nqp::const::RUSAGE_STIME_MSEC) + } } Rakudo::Internals.REGISTER-DYNAMIC: '$*KERNEL', { From fea5612cb89cf5a49acd5b8ecee84eaee7073e74 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sat, 4 Nov 2017 22:10:46 +0100 Subject: [PATCH 681/692] Allow for "use Telemetry " Allow selective import of all subs that are available with :COLUMNS. --- lib/Telemetry.pm6 | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/lib/Telemetry.pm6 b/lib/Telemetry.pm6 index 26ff1d1b8c8..59aa5c6e611 100644 --- a/lib/Telemetry.pm6 +++ b/lib/Telemetry.pm6 @@ -846,6 +846,12 @@ HEADER sub T () is export { Telemetry.new } +# Provide limited export capability -------------------------------------------- + +sub EXPORT(*@args) { + (EXPORT::COLUMNS::{ @args.map: "&" ~ * }:p).Map +} + # Make sure we tell the world if we're implicitely told to do so --------------- END { if @snaps { snap; note report } } From 360eb2289f95442fda874f4cc3e18e32152ad9a5 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sat, 4 Nov 2017 22:18:46 +0100 Subject: [PATCH 682/692] Oops, we want the default exports available as well - so not only slice through EXPORT::COLUMNS, but also EXPORT::DEFAULT --- lib/Telemetry.pm6 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/lib/Telemetry.pm6 b/lib/Telemetry.pm6 index 59aa5c6e611..4c8df54aa01 100644 --- a/lib/Telemetry.pm6 +++ b/lib/Telemetry.pm6 @@ -849,7 +849,10 @@ sub T () is export { Telemetry.new } # Provide limited export capability -------------------------------------------- sub EXPORT(*@args) { - (EXPORT::COLUMNS::{ @args.map: "&" ~ * }:p).Map + ( + |(EXPORT::COLUMNS::{ @args.map: '&' ~ * }:p), + |(EXPORT::DEFAULT::{ @args.map: '&' ~ * }:p), + ).Map } # Make sure we tell the world if we're implicitely told to do so --------------- From 9344d35de8a56f73f5b174cd7e1def6a48e62d07 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sun, 5 Nov 2017 11:50:02 +0100 Subject: [PATCH 683/692] Add :stop / :reset parameters to snapper() - :reset allows you to forget about the snaps made so far - :stop allows you to stop the snapper --- lib/Telemetry.pm6 | 19 ++++++++++++++----- 1 file changed, 14 insertions(+), 5 deletions(-) diff --git a/lib/Telemetry.pm6 b/lib/Telemetry.pm6 index 4c8df54aa01..c313cc3f76c 100644 --- a/lib/Telemetry.pm6 +++ b/lib/Telemetry.pm6 @@ -582,14 +582,23 @@ multi sub snap(@s --> Nil) { @s.push(Telemetry.new) } # Starting the snapper / changing the period size my int $snapper-running; my $snapper-wait; -sub snapper($sleep = 0.1 --> Nil) is export { +sub snapper($sleep = 0.1, :$stop, :$reset --> Nil) is export { + $snapper-wait = $sleep; - unless $snapper-running { - snap; + nqp::bindattr(@snaps,List,'$!reified',nqp::list) if $reset; + + if $snapper-running { + $snapper-running = 0 if $stop; + } + else { + $snapper-running = 1; Thread.start(:app_lifetime, :name, { - loop { sleep $snapper-wait; snap } + snap; + while $snapper-running { + sleep $snapper-wait; + snap + } }); - $snapper-running = 1 } } From d5fc6cbb9e94fab41e64e27dbaee17b40042fac7 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sun, 5 Nov 2017 12:01:37 +0100 Subject: [PATCH 684/692] Don't start a snapper if not running and :stop --- lib/Telemetry.pm6 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/Telemetry.pm6 b/lib/Telemetry.pm6 index c313cc3f76c..a37f4b11d5b 100644 --- a/lib/Telemetry.pm6 +++ b/lib/Telemetry.pm6 @@ -590,7 +590,7 @@ sub snapper($sleep = 0.1, :$stop, :$reset --> Nil) is export { if $snapper-running { $snapper-running = 0 if $stop; } - else { + elsif !$stop { $snapper-running = 1; Thread.start(:app_lifetime, :name, { snap; From 3e4ef2e0fcc5091c793a538407be58e3b91da8ba Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sun, 5 Nov 2017 12:53:40 +0100 Subject: [PATCH 685/692] Add :csv option to report - which defaults to RAKUDO_REPORT_CSV setting - also made report() itself hopefully a bit less racy --- lib/Telemetry.pm6 | 119 +++++++++++++++++++++++++++++----------------- 1 file changed, 75 insertions(+), 44 deletions(-) diff --git a/lib/Telemetry.pm6 b/lib/Telemetry.pm6 index a37f4b11d5b..b1e3d89c402 100644 --- a/lib/Telemetry.pm6 +++ b/lib/Telemetry.pm6 @@ -614,15 +614,21 @@ multi sub periods(@s) { (1..^@s).map: { @s[$_] - @s[$_ - 1] } } # Telemetry reporting features ------------------------------------------------- proto sub report(|) is export {*} -multi sub report(:@columns, :$legend, :$header-repeat, :@format) { - my $s := nqp::clone(nqp::getattr(@snaps,List,'$!reified')); - nqp::setelems(nqp::getattr(@snaps,List,'$!reified'),0); +multi sub report(:@columns, :$legend, :$header-repeat, :$csv, :@format) { + + # race condition, but should be safe enough because installing new list + # and all access is done using HLL ops, so those will either see the old + # or the new nqp::list, and thus push to either the old or the new. + my $s := nqp::getattr(@snaps,List,'$!reified'); + nqp::bindattr(@snaps,List,'$!reified',nqp::list); + nqp::push($s,Telemetry.new) if nqp::elems($s) == 1; report( nqp::p6bindattrinvres(nqp::create(List),List,'$!reified',$s), :@columns, :$legend, :$header-repeat, + :$csv, :@format, ); } @@ -759,6 +765,7 @@ multi sub report( :@columns is copy, :$header-repeat is copy, :$legend is copy, + :$csv is copy, :@format, ) { @@ -782,6 +789,11 @@ multi sub report( $legend = $_.Int with %*ENV // 1; } + # set csv flag + without $csv { + $csv = $_.Int with %*ENV // 1; + } + # get / calculate the format info we need my %format := %default_format ?? %default_format @@ -789,62 +801,81 @@ multi sub report( ?? prepare-format(@format) !! (%default_format := prepare-format(@default_format)); - my $first = @s[0]; - my $last = @s[*-1]; - my $total = $last - $first; - my $text := nqp::list_s(qq:to/HEADER/.chomp); + # some initializations + my @formats = %format{@columns}; + my $text := nqp::list_s; + + # only want CSV ready output + if $csv { + nqp::push_s($text,%format{@columns}>>.[COLUMN].join(' ')); + for periods(@s) -> $period { + nqp::push_s($text, + @formats.map( -> @info { + $period."@info[METHOD]"() + }).join(' ') + ) + } + } + + # standard text output + else { + my $first = @s[0]; + my $last = @s[*-1]; + my $total = $last - $first; + my $header = "\n%format{@columns}>>.[HEADER].join(' ')"; + + nqp::push_s($text,qq:to/HEADER/.chomp); Telemetry Report of Process #$*PID ({Instant.from-posix(nqp::time_i).DateTime}) HEADER - # give the supervisor blurb - if $first.supervisor { - nqp::push_s($text,"Supervisor thread ran for the whole time"); - } - elsif !$last.supervisor { - nqp::push_s($text,"No supervisor thread has been running"); - } - else { - my $started = @s.first: *.supervisor; - nqp::push_s($text,"Supervisor thread ran for { - (100 * ($last.wallclock - $started.wallclock) / $total.wallclock) - .fmt("%5.2f") - }% of the time"); - } + # give the supervisor blurb + if $first.supervisor { + nqp::push_s($text,"Supervisor thread ran for the whole time"); + } + elsif !$last.supervisor { + nqp::push_s($text,"No supervisor thread has been running"); + } + else { + my $started = @s.first: *.supervisor; + nqp::push_s($text,"Supervisor thread ran for { + (100 * ($last.wallclock - $started.wallclock) / $total.wallclock) + .fmt("%5.2f") + }% of the time"); + } - nqp::push_s($text,qq:to/HEADER/.chomp); + nqp::push_s($text,qq:to/HEADER/.chomp); Number of Snapshots: {+@s} Initial Size: { @s[0].max-rss.fmt('%9d') } Kbytes Total Time: { ($total.wallclock / 1000000).fmt('%9.2f') } seconds Total CPU Usage: { ($total.cpu / 1000000).fmt('%9.2f') } seconds HEADER - my @formats = %format{@columns}; - sub push-period($period --> Nil) { - nqp::push_s($text, - @formats.map( -> @info { - @info[DISPLAY]($period."@info[METHOD]"()) - }).join(' ').trim-trailing - ) - } + sub push-period($period --> Nil) { + nqp::push_s($text, + @formats.map( -> @info { + @info[DISPLAY]($period."@info[METHOD]"()) + }).join(' ').trim-trailing + ) + } - my $header = "\n%format{@columns}>>.[HEADER].join(' ')"; - nqp::push_s($text,$header) unless $header-repeat; + nqp::push_s($text,$header) unless $header-repeat; - for periods(@s).kv -> $index, $period { - nqp::push_s($text,$header) - if $header-repeat && $index %% $header-repeat; - push-period($period) - } + for periods(@s).kv -> $index, $period { + nqp::push_s($text,$header) + if $header-repeat && $index %% $header-repeat; + push-period($period) + } - nqp::push_s($text,%format{@columns}>>.[FOOTER].join(' ')); + nqp::push_s($text,%format{@columns}>>.[FOOTER].join(' ')); - push-period($total); + push-period($total); - if $legend { - nqp::push_s($text,''); - nqp::push_s($text,'Legend:'); - for %format{@columns} -> $col { - nqp::push_s($text,"$col[COLUMN].fmt("%9s") $col[LEGEND]"); + if $legend { + nqp::push_s($text,''); + nqp::push_s($text,'Legend:'); + for %format{@columns} -> $col { + nqp::push_s($text,"$col[COLUMN].fmt("%9s") $col[LEGEND]"); + } } } From 4d21ad67da412ebbb3556590027b83dd98573278 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sun, 5 Nov 2017 14:20:54 +0100 Subject: [PATCH 686/692] Oops, the default for :csv should be off! --- lib/Telemetry.pm6 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/Telemetry.pm6 b/lib/Telemetry.pm6 index b1e3d89c402..4891a9a4b50 100644 --- a/lib/Telemetry.pm6 +++ b/lib/Telemetry.pm6 @@ -791,7 +791,7 @@ multi sub report( # set csv flag without $csv { - $csv = $_.Int with %*ENV // 1; + $csv = $_.Int with %*ENV // 0; } # get / calculate the format info we need From 0f2f0cd3ab9a5d6405935b0a8b814e109a869c82 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sun, 5 Nov 2017 14:22:42 +0100 Subject: [PATCH 687/692] Introduce Telemetry 'safe-ctrl-c' - when called, installs a signal handler for CTRL-c that just exits - makes sure that if we're snapping, we're going to see a report even if we're control-c'ing out of the program, e.g. in case of a hang or an infini-loop. --- lib/Telemetry.pm6 | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/lib/Telemetry.pm6 b/lib/Telemetry.pm6 index 4891a9a4b50..c2346978fef 100644 --- a/lib/Telemetry.pm6 +++ b/lib/Telemetry.pm6 @@ -882,6 +882,15 @@ HEADER nqp::join("\n",$text) } +# Allow for safe CTRL-c exit, always giving a report --------------------------- +my int $has-safe-ctrl-c; +sub safe-ctrl-c(--> Nil) is export { + unless $has-safe-ctrl-c { + signal(SIGINT).tap: &exit; + $has-safe-ctrl-c = 1; + } +} + # The special T functionality ----------------------------------------- sub T () is export { Telemetry.new } From 824a5dc29891c9ea1dd1247907f1fad15a1307f1 Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sun, 5 Nov 2017 14:26:22 +0100 Subject: [PATCH 688/692] Make -Msnapper set the safe-ctrl-c feature - so even perl6 -Msnapper -e 'loop {}' will give you a report - after you ctrl-c it of course --- lib/snapper.pm6 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lib/snapper.pm6 b/lib/snapper.pm6 index 942581cd476..28675e5a95e 100644 --- a/lib/snapper.pm6 +++ b/lib/snapper.pm6 @@ -1,7 +1,8 @@ # shorthand for loading Telemetry and starting a snapper -use Telemetry; +use Telemetry ; +safe-ctrl-c; snapper( %*ENV // 0.1 ); # vim: ft=perl6 expandtab sw=4 From 1c387153ea5f0c60934ce2a7e3b0f9669bd7935f Mon Sep 17 00:00:00 2001 From: Zoffix Znet Date: Sun, 5 Nov 2017 15:44:20 +0000 Subject: [PATCH 689/692] Revert ""Do. Or do not. There is no try."" This reverts commit 738908be4d79f1472821cd363ec82a1ef0bc3f32. Such behaviour has too much unwanted impact in grammar actions where $/ is the common name for the parameter. Having to change $/ to something else the second you introduce a .subst call (or other methods that set $/) is a bit too much. https://irclog.perlgeek.de/perl6-dev/2017-11-05#i_15404670 --- src/core/Str.pm | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/core/Str.pm b/src/core/Str.pm index bf2d164ba77..c35436bc9e1 100644 --- a/src/core/Str.pm +++ b/src/core/Str.pm @@ -1096,7 +1096,7 @@ my class Str does Stringy { # declared in BOOTSTRAP my $SET_DOLLAR_SLASH = nqp::istype($matcher, Regex); my $word_by_word = so $samespace || %options || %options; - $caller_dollar_slash = $/ if $SET_DOLLAR_SLASH; + try $caller_dollar_slash = $/ if $SET_DOLLAR_SLASH; my @matches = %options ?? self.match($matcher, |%options) !! self.match($matcher); # 30% faster @@ -1169,7 +1169,7 @@ my class Str does Stringy { # declared in BOOTSTRAP my $word_by_word = so $samespace || %options || %options; # nothing to do - caller_dollar_slash = $/ if $SET_DOLLAR_SLASH; + try caller_dollar_slash = $/ if $SET_DOLLAR_SLASH; my @matches = %options ?? self.match($matcher, :$g, |%options) !! self.match($matcher, :$g); # 30% faster @@ -1196,7 +1196,7 @@ my class Str does Stringy { # declared in BOOTSTRAP my int $prev; my str $str = nqp::unbox_s(self); my Mu $result := nqp::list_s(); - cds = $/ if SDS; + try cds = $/ if SDS; # need to do something special if SDS || space || case || mark || callable { @@ -1205,7 +1205,7 @@ my class Str does Stringy { # declared in BOOTSTRAP my \case-and-mark := case && mark; for flat matches -> $m { - cds = $m if SDS; + try cds = $m if SDS; nqp::push_s( $result,nqp::substr($str,$prev,nqp::unbox_i($m.from) - $prev) ); From 22939bc8199d730e7efceef0c226b267d320945d Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sun, 5 Nov 2017 18:20:30 +0100 Subject: [PATCH 690/692] Telemetry report now removes columns without any data - only for the human readable case, though: :csv output unchanged --- lib/Telemetry.pm6 | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/lib/Telemetry.pm6 b/lib/Telemetry.pm6 index c2346978fef..c65705eebe6 100644 --- a/lib/Telemetry.pm6 +++ b/lib/Telemetry.pm6 @@ -802,13 +802,14 @@ multi sub report( !! (%default_format := prepare-format(@default_format)); # some initializations - my @formats = %format{@columns}; my $text := nqp::list_s; + my @periods = periods(@s); # only want CSV ready output if $csv { + my @formats = %format{@columns}; nqp::push_s($text,%format{@columns}>>.[COLUMN].join(' ')); - for periods(@s) -> $period { + for @periods -> $period { nqp::push_s($text, @formats.map( -> @info { $period."@info[METHOD]"() @@ -822,7 +823,13 @@ multi sub report( my $first = @s[0]; my $last = @s[*-1]; my $total = $last - $first; + + # remove the columns that don't have any values + @columns = @columns.grep: -> $column { + @periods.first: { ."%format{$column}[METHOD]"() } + }; my $header = "\n%format{@columns}>>.[HEADER].join(' ')"; + my @formats = %format{@columns}; nqp::push_s($text,qq:to/HEADER/.chomp); Telemetry Report of Process #$*PID ({Instant.from-posix(nqp::time_i).DateTime}) @@ -860,7 +867,7 @@ HEADER nqp::push_s($text,$header) unless $header-repeat; - for periods(@s).kv -> $index, $period { + for @periods.kv -> $index, $period { nqp::push_s($text,$header) if $header-repeat && $index %% $header-repeat; push-period($period) From 77142fdb29502479fcdfc1be08e62d912b69bb0a Mon Sep 17 00:00:00 2001 From: Elizabeth Mattijsen Date: Sun, 5 Nov 2017 18:45:52 +0100 Subject: [PATCH 691/692] Fix some Telemetry / snapper race condition Sometimes, if you would use snapper and say your own report at the end, another (almost) empty report would be shown as well. --- lib/Telemetry.pm6 | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/lib/Telemetry.pm6 b/lib/Telemetry.pm6 index c65705eebe6..8d47919150b 100644 --- a/lib/Telemetry.pm6 +++ b/lib/Telemetry.pm6 @@ -596,7 +596,7 @@ sub snapper($sleep = 0.1, :$stop, :$reset --> Nil) is export { snap; while $snapper-running { sleep $snapper-wait; - snap + snap if $snapper-running; } }); } @@ -622,7 +622,6 @@ multi sub report(:@columns, :$legend, :$header-repeat, :$csv, :@format) { my $s := nqp::getattr(@snaps,List,'$!reified'); nqp::bindattr(@snaps,List,'$!reified',nqp::list); - nqp::push($s,Telemetry.new) if nqp::elems($s) == 1; report( nqp::p6bindattrinvres(nqp::create(List),List,'$!reified',$s), :@columns, @@ -912,6 +911,12 @@ sub EXPORT(*@args) { } # Make sure we tell the world if we're implicitely told to do so --------------- -END { if @snaps { snap; note report } } +END { + $snapper-running = 0; # stop any snapper + if @snaps { + snap; + note report; + } +} # vim: ft=perl6 expandtab sw=4 From c93dc9e6200a9483c34236b7edcb6b1ff9eed038 Mon Sep 17 00:00:00 2001 From: MasterDuke17 Date: Sun, 5 Nov 2017 23:28:27 -0500 Subject: [PATCH 692/692] Simplify INTERPOLATE and INTERPOLATE_ASSERTION Remove some unused variables, make others sigiless where possible, and simplify some conditionals. --- src/core/Match.pm | 18 +++++------------- 1 file changed, 5 insertions(+), 13 deletions(-) diff --git a/src/core/Match.pm b/src/core/Match.pm index 72803874019..dd84e60cabb 100644 --- a/src/core/Match.pm +++ b/src/core/Match.pm @@ -510,7 +510,6 @@ my class Match is Capture is Cool does NQPMatchRole { } multi method INTERPOLATE(Mu:D \var, int \im, int \monkey, $, $, \context) { - my $maxmatch; my \cur = self.'!cursor_start_cur'(); my str $tgt = cur.target; @@ -594,7 +593,6 @@ my class Match is Capture is Cool does NQPMatchRole { && nqp::isgt_i($len,$maxlen) && nqp::isle_i(nqp::add_i($pos,$len),nqp::chars($tgt)) { $maxlen = $len; - $maxmatch := $match; } nqp::isge_i($maxlen,0) @@ -705,7 +703,6 @@ my class Match is Capture is Cool does NQPMatchRole { } multi method INTERPOLATE_ASSERTION(Mu:D \var, int \im, int \monkey, $, $, \context) { - my $maxmatch; my \cur = self.'!cursor_start_cur'(); my int $maxlen = -1; @@ -714,18 +711,13 @@ my class Match is Capture is Cool does NQPMatchRole { # We are in a regex assertion, the strings we get will be # treated as regex rules. my $rx := MAKE_REGEX(var,im == 1 || im == 3,im == 2 || im == 3,monkey,context); - my $match := self.$rx; - my int $len = $match.pos - $match.from; + my Match \match := self.$rx; + my int $len = match.pos - match.from; - if $match + match.Bool && nqp::isgt_i($len,$maxlen) - && nqp::isle_i(nqp::add_i($pos,$len),nqp::chars(cur.target)) { - $maxlen = $len; - $maxmatch := $match; - } - - nqp::istype($maxmatch, Match) - ?? $maxmatch + && nqp::isle_i(nqp::add_i($pos,$len),nqp::chars(cur.target)) + ?? match !! nqp::isge_i($maxlen,0) ?? cur.'!cursor_pass'(nqp::add_i($pos,$maxlen), '') !! cur