diff --git a/CREDITS b/CREDITS index 0e8680b9274..3c7fd153055 100644 --- a/CREDITS +++ b/CREDITS @@ -222,6 +222,10 @@ E: dagurval@pvv.ntnu.no N: dagurval E: dagurval@pvv.ntnu.no +N: Dan Miller +E: danielcliffordmiller@gmail.com +U: danielcliffordmiller + N: Dan Sugalski U: dan D: Architect emeritus (0.0.1-0.1.1) diff --git a/VERSION b/VERSION index 70edfcb391e..b85f74e8c5c 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -2017.05 +2017.06 diff --git a/docs/ChangeLog b/docs/ChangeLog index 0b9758e2f72..02e33b6cfaf 100644 --- a/docs/ChangeLog +++ b/docs/ChangeLog @@ -1,3 +1,128 @@ +New in 2017.06: + + Fixes: + + Fixed incorrect auto-boxing to native candidates in multi dispatch [ccfa5e51] + + `^Inf .elems` now fails instead of returning Inf [20310d7d] + + Made IO::Handle.print/.put signature consistent [613bdcf8] + + Made sure that Setty:U is treated like any type object [ad8fa552] + + Fixed behaviour of set() `(<)` X.Set [e6506bfd] + + Made sure VM.osname always returns lowercase string [122aca1c] + + Fixed List.Capture with non-Str-key Pairs [5b25836f] + + Fixed inconsistency in .Int on zero-denominator Rats [6dbe85ed] + + Fixed crash in smartmatch of non-Numerics with Numeric [43b03fc6] + + Fixed occasional Windows file permission issues with installation of modules [8ec4dc5b] + + Fixed crash in `X` operator used with empty List [9494cbd3] + + Fixed spurious warnings/crash with certain `=para` Pod blocks [5e339345][807d30c2] + + Fixed output of `CArray[Pointer].^shortname` [1ed284e2] + + Fixed crash in Test.pm6's bail-out when used before tests [cb827606] + + Fixed object Hash -> Set coercion failing to consider values [160de7e6] + + Fixed Seq.perl for containerized Seqs [b22383fe] + + Fixed Proc::Async.new not slurping first positional [92c187d2] + + Fixed Proc::Async.kill failing to kill sometimes [99421d4c] + + Fixed hang in deepmap with Iterable type objects [252dbf3a] + + Fixed crash when Junctioning empty array after .elems'ing it [aa368421] + + Fixed crashes/LTA errors in Junction.new w/wrong args [61ecfd51] + + Fixed `infix:` calling .defined one too many times [77d3c546] + + Made `fail` re-arm handled Failures given as arguments [64e898f9] + + Fixed output of IO::Special.perl [7344a3d2] + + Made IO::Handle.open with path '-'.IO properly handle non-default `$*OUT`/`$*ERR` [3755c0e7] + + Fixed Promise.then to not lose dynamic variables [36bc4102] + + Fixed allomorph smartmatching with Str values [8a0b7460] + + Fixed IO::Path.extension with Range `:parts` when endpoints were excluded [8efffb1d] + + Made coercion of lazy Iterable to Setty fail [211063c7] + + Made Mixy/Baggy.new-from-pairs with a lazy Iterable fail [c9dfa840][e5719d6a] + + Fixed byte.Range returning an incorrect range [af85d538] + + Fixed edge-cases (e.g. Nan/Inf) in Mixy.roll [fb9e1a87] + + Made sure that Mixy types only take Real values [7fa85682] + + Fixed incorrect results in ignorecase+ignoremark regex matches [1ac7996a] + + Fixed issues with `$*CWD` inside &indir when using relative paths [9151ebaa][326faed6] + + Fixed crash with Seq:U.List [5c56e9e7] + + Fixed various issues with Map `(<=)` Map [e1563a76] + + Fixed various issues with Map `(<)` Map [b03d8044] + + Fixed 4 cases of crashes with labeled `next` [3b67b4ac] + + Made Proc.status/Numeric/Bool/exitcode/sink wait for Proc to be done [e4468c61] + + Fixed Pair.perl with type-object components [c6b03c45] + + Fixed bad shell quoting in Proc::Async on Windows [e9b30933] + + Fixed crash when RAKUDO_MODULE_DEBUG was set to a non-numeric value [96e6b338] + + Fixed Kernel.signals on OpenBSD [9435c14e] + + Various improvements to warnings and error reporting [1c16bf2e][85bef661][e22508d4] + [b6694bd0][ec51e73f][f2fca0c8][f9403b3b][86fe766a][c81b7a4b][7cf01296][fb7dd8a4] + [7783fcab][9bf3ea3a][02614f64][e538cbc5][86c3d7aa][c2497234][b0a1b6c3][97298aca] + [69b1b6c8][5e037736][e824266f] + + Additions: + + Implemented IO::CatHandle [5227828a] + + Implemented support for merged STDOUT/ERR output Proc and Proc::Async [ac31c5df][05d8b883] + + Implemented Complex.cis [a243063c] + + Implemented Failure.self [0a100825] + + Implemented Any.Seq [5c56e9e7] + + Improved consistently to have .Supply on a type object it as Supply [52d39576] + + Slightly changed IO::Handle.encoding; Nil now means 'bin' + [95b4e5d5][27f09e9d][9c0362cb][51c73ba0] + + Gave `(<=)` Baggy and Mixy semantics for Bags/Mixes [b1d83f9d] + + Makde `use lib` accept IO::Path objects [3ff29d42] + + Added IO::Socket.nl-out attribute [12d31e36] + + Added Setty.pickpairs [e3695b16] + + Added Str type constraints to IO::Spec::Win32 .join and .catpath [232cf190] + + Made it possible to call &prompt with no args [0646d3fa] + + Made IO::Socket::INET update localport if it binds on port 0 [bc98e671] + + Improved support for Unicode properties `Prepend` and `Regional Indicator` [56e71d59] + + Gave IO::Handle.read default value for size arg [b7150ae1][aa9516be] + + Added default output for Mu.WHY [23d6d42d][cc4d9091] + + Added support for binding to standard handles in Proc::Async [6b2967d7] + + [JVM] Implemented Proc::Async [5154b620] + + Removals: + + Removed TAP.pm6 from core. Available as `TAP::Harness` in the ecosystem [ae891f93] + + Removed all methods from IO::ArgFiles and made it a subclass of IO::CatHandle [f539a624] + + Removed IO::Socket::INET.ins [75693b0b] + + Removed NYI IO::Socket.poll method [cb404c43] + + Efficiency: + + Made Any (elem) Iterable:D between 1.3x and 110x faster [e65800a8] + + Made `(<=)` and `(>=)` about 50x faster [32eb285f] + + Made IO::Spec::Win32.catpath 47x faster [7d6fa739] + + Made `(<)` and `(>)` about 40x faster [431ed4e3] + + Made IO::Spec::Win32.join 26x faster [494659a1] + + Made IO::Spec::Win32.splitdir 25x faster [2816ef71] + + Made Map `(<=)` Map about 15x faster [0cb4df44] + + Made Map `(<)` Map about 15x faster [f6f54dcf] + + Made Str.subst(Str) without :g 14x faster [0331fb9d] + + Made Setty.roll about 11x faster [e6192ca8] + + Made IO::Spec::Unix.splitdir 7.7x faster [6ca702fa] + + Made invocation of Proc.spawn and &run 4.6x faster [93524fb9] + + Made SetHash.grab(N) about 3.5x faster [67292a1e] + + Made SetHash.grabpairs(N) about 3.5x faster [0e9ee0d1] + + Made invocation of Blob.decode() 2.7x faster [222b4083] + + Made Baggy/Mixy.(hash|Hash) about 2.5x as fast (on a 26 elem Bag/Mix) [06cd0bc3] + + Made Setty.roll(N) about 2x faster [18dd0741] + + Made Setty.pick about 2x faster [10e9c8ba] + + Made Set.new(@a) about 2x faster [b55a0f16] + + Made Baggy.new(@a) about 2x faster [11f27a30] + + Made SetHash.grab about 1.8x faster [d28540be] + + Made Str:D (elem) Map:D 1.3x faster [b43303f2] + + Made `$*KERNEL.signal` 64% faster, overall [79b8ab9d][01d948d2] + + Made Iterable.Bag about 60% faster [f2876281] + + Made Iterable.Mix(|Hash) about 40% faster [bba6de5f] + + Made Setty.pick(N) about 30% faster [071c88cb] + + Made StrDistance 25% faster [2e041b06][9185fa2c] + + Made (Bag|Mix).AT-KEY about 10% faster [b43db636] + + Made `infix:<∉>` about 10% faster [abfb52be] + + Made Str.starts-with 8% faster [7ecb59dc] + + Made .Set, .Bag, and .Mix coercers a few percent faster [8791b447][4139b96e][8c7e4e51] + + Fixed lost optimization of for ^N {}; now its 3x faster [46b11f54] + + Made &DYNAMIC about 1% faster [74242e55] + + Made ^Inf marginally faster [446dc190] + + Assorted internal improvements to CPU/memory use [2efd812c][07bff0e5][1369632f][2ac120ce] + [539415cf][5ebf307a][ed07b2c3][0104a439][a91a2e4d][bd292225][8ff980e7][7edf9da6][241d2925] + [7e8bac9b][3363c7b9][6f932687][e9b30933][51b63bf9][57553386][1171e67e] + + Internal: + + Refactored handle encoding. Non-binary read methods now throw when used + on handles in binary mode [41bb1372][b3cd299e] + + Refactored socket encoding [8ee383e3] + + Made syncronous IO to not use libuv [05f3e9a0] + + Made syncronous sockets to not use libuv [6f202fbe] + + Moved encoding and line ending bits to IO::Socket [d6fd2491] + + Moved get and lines to IO::Socket role [9cec9408] + + IO::Path.Int method removed; handled by Cool.Int now [d13d9c2e] + + Re-implemented Proc in terms of Proc::Async [ac31c5df] + New in 2017.05: + Fixes: + Made Promise subclass-friendly [a61746fe][a7c23aa2] diff --git a/docs/announce/2017.06.md b/docs/announce/2017.06.md new file mode 100644 index 00000000000..a053d59ecdc --- /dev/null +++ b/docs/announce/2017.06.md @@ -0,0 +1,195 @@ +# Announce: Rakudo Perl 6 compiler, Release #112 (2017.06) + +On behalf of the Rakudo development team, I’m very happy to announce the +June 2017 release of Rakudo Perl 6 #112. 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, but no new features. + +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.06: + + Fixes: + + Fixed incorrect auto-boxing to native candidates in multi dispatch [ccfa5e51] + + `^Inf .elems` now fails instead of returning Inf [20310d7d] + + Made IO::Handle.print/.put signature consistent [613bdcf8] + + Made sure that Setty:U is treated like any type object [ad8fa552] + + Fixed behaviour of set() `(<)` X.Set [e6506bfd] + + Made sure VM.osname always returns lowercase string [122aca1c] + + Fixed List.Capture with non-Str-key Pairs [5b25836f] + + Fixed inconsistency in .Int on zero-denominator Rats [6dbe85ed] + + Fixed crash in smartmatch of non-Numerics with Numeric [43b03fc6] + + Fixed occasional Windows file permission issues with installation of modules [8ec4dc5b] + + Fixed crash in `X` operator used with empty List [9494cbd3] + + Fixed spurious warnings/crash with certain `=para` Pod blocks [5e339345][807d30c2] + + Fixed output of `CArray[Pointer].^shortname` [1ed284e2] + + Fixed crash in Test.pm6's bail-out when used before tests [cb827606] + + Fixed object Hash -> Set coercion failing to consider values [160de7e6] + + Fixed Seq.perl for containerized Seqs [b22383fe] + + Fixed Proc::Async.new not slurping first positional [92c187d2] + + Fixed Proc::Async.kill failing to kill sometimes [99421d4c] + + Fixed hang in deepmap with Iterable type objects [252dbf3a] + + Fixed crash when Junctioning empty array after .elems'ing it [aa368421] + + Fixed crashes/LTA errors in Junction.new w/wrong args [61ecfd51] + + Fixed `infix:` calling .defined one too many times [77d3c546] + + Made `fail` re-arm handled Failures given as arguments [64e898f9] + + Fixed output of IO::Special.perl [7344a3d2] + + Made IO::Handle.open with path '-'.IO properly handle non-default `$*OUT`/`$*ERR` [3755c0e7] + + Fixed Promise.then to not lose dynamic variables [36bc4102] + + Fixed allomorph smartmatching with Str values [8a0b7460] + + Fixed IO::Path.extension with Range `:parts` when endpoints were excluded [8efffb1d] + + Made coercion of lazy Iterable to Setty fail [211063c7] + + Made Mixy/Baggy.new-from-pairs with a lazy Iterable fail [c9dfa840][e5719d6a] + + Fixed byte.Range returning an incorrect range [af85d538] + + Fixed edge-cases (e.g. Nan/Inf) in Mixy.roll [fb9e1a87] + + Made sure that Mixy types only take Real values [7fa85682] + + Fixed incorrect results in ignorecase+ignoremark regex matches [1ac7996a] + + Fixed issues with `$*CWD` inside &indir when using relative paths [9151ebaa][326faed6] + + Fixed crash with Seq:U.List [5c56e9e7] + + Fixed various issues with Map `(<=)` Map [e1563a76] + + Fixed various issues with Map `(<)` Map [b03d8044] + + Fixed 4 cases of crashes with labeled `next` [3b67b4ac] + + Made Proc.status/Numeric/Bool/exitcode/sink wait for Proc to be done [e4468c61] + + Fixed Pair.perl with type-object components [c6b03c45] + + Fixed bad shell quoting in Proc::Async on Windows [e9b30933] + + Fixed crash when RAKUDO_MODULE_DEBUG was set to a non-numeric value [96e6b338] + + Fixed Kernel.signals on OpenBSD [9435c14e] + + Various improvements to warnings and error reporting [1c16bf2e][85bef661][e22508d4] + [b6694bd0][ec51e73f][f2fca0c8][f9403b3b][86fe766a][c81b7a4b][7cf01296][fb7dd8a4] + [7783fcab][9bf3ea3a][02614f64][e538cbc5][86c3d7aa][c2497234][b0a1b6c3][97298aca] + [69b1b6c8][5e037736][e824266f] + + Additions: + + Implemented IO::CatHandle [5227828a] + + Implemented support for merged STDOUT/ERR output Proc and Proc::Async [ac31c5df][05d8b883] + + Implemented Complex.cis [a243063c] + + Implemented Failure.self [0a100825] + + Implemented Any.Seq [5c56e9e7] + + Improved consistently to have .Supply on a type object it as Supply [52d39576] + + Slightly changed IO::Handle.encoding; Nil now means 'bin' + [95b4e5d5][27f09e9d][9c0362cb][51c73ba0] + + Gave `(<=)` Baggy and Mixy semantics for Bags/Mixes [b1d83f9d] + + Makde `use lib` accept IO::Path objects [3ff29d42] + + Added IO::Socket.nl-out attribute [12d31e36] + + Added Setty.pickpairs [e3695b16] + + Added Str type constraints to IO::Spec::Win32 .join and .catpath [232cf190] + + Made it possible to call &prompt with no args [0646d3fa] + + Made IO::Socket::INET update localport if it binds on port 0 [bc98e671] + + Improved support for Unicode properties `Prepend` and `Regional Indicator` [56e71d59] + + Gave IO::Handle.read default value for size arg [b7150ae1][aa9516be] + + Added default output for Mu.WHY [23d6d42d][cc4d9091] + + Added support for binding to standard handles in Proc::Async [6b2967d7] + + [JVM] Implemented Proc::Async [5154b620] + + Removals: + + Removed TAP.pm6 from core. Available as `TAP::Harness` in the ecosystem [ae891f93] + + Removed all methods from IO::ArgFiles and made it a subclass of IO::CatHandle [f539a624] + + Removed IO::Socket::INET.ins [75693b0b] + + Removed NYI IO::Socket.poll method [cb404c43] + + Efficiency: + + Made Any (elem) Iterable:D between 1.3x and 110x faster [e65800a8] + + Made `(<=)` and `(>=)` about 50x faster [32eb285f] + + Made IO::Spec::Win32.catpath 47x faster [7d6fa739] + + Made `(<)` and `(>)` about 40x faster [431ed4e3] + + Made IO::Spec::Win32.join 26x faster [494659a1] + + Made IO::Spec::Win32.splitdir 25x faster [2816ef71] + + Made Map `(<=)` Map about 15x faster [0cb4df44] + + Made Map `(<)` Map about 15x faster [f6f54dcf] + + Made Str.subst(Str) without :g 14x faster [0331fb9d] + + Made Setty.roll about 11x faster [e6192ca8] + + Made IO::Spec::Unix.splitdir 7.7x faster [6ca702fa] + + Made invocation of Proc.spawn and &run 4.6x faster [93524fb9] + + Made SetHash.grab(N) about 3.5x faster [67292a1e] + + Made SetHash.grabpairs(N) about 3.5x faster [0e9ee0d1] + + Made invocation of Blob.decode() 2.7x faster [222b4083] + + Made Baggy/Mixy.(hash|Hash) about 2.5x as fast (on a 26 elem Bag/Mix) [06cd0bc3] + + Made Setty.roll(N) about 2x faster [18dd0741] + + Made Setty.pick about 2x faster [10e9c8ba] + + Made Set.new(@a) about 2x faster [b55a0f16] + + Made Baggy.new(@a) about 2x faster [11f27a30] + + Made SetHash.grab about 1.8x faster [d28540be] + + Made Str:D (elem) Map:D 1.3x faster [b43303f2] + + Made `$*KERNEL.signal` 64% faster, overall [79b8ab9d][01d948d2] + + Made Iterable.Bag about 60% faster [f2876281] + + Made Iterable.Mix(|Hash) about 40% faster [bba6de5f] + + Made Setty.pick(N) about 30% faster [071c88cb] + + Made StrDistance 25% faster [2e041b06][9185fa2c] + + Made (Bag|Mix).AT-KEY about 10% faster [b43db636] + + Made `infix:<∉>` about 10% faster [abfb52be] + + Made Str.starts-with 8% faster [7ecb59dc] + + Made .Set, .Bag, and .Mix coercers a few percent faster [8791b447][4139b96e][8c7e4e51] + + Fixed lost optimization of for ^N {}; now its 3x faster [46b11f54] + + Made &DYNAMIC about 1% faster [74242e55] + + Made ^Inf marginally faster [446dc190] + + Assorted internal improvements to CPU/memory use [2efd812c][07bff0e5][1369632f][2ac120ce] + [539415cf][5ebf307a][ed07b2c3][0104a439][a91a2e4d][bd292225][8ff980e7][7edf9da6][241d2925] + [7e8bac9b][3363c7b9][6f932687][e9b30933][51b63bf9][57553386][1171e67e] + + Internal: + + Refactored handle encoding. Non-binary read methods now throw when used + on handles in binary mode [41bb1372][b3cd299e] + + Refactored socket encoding [8ee383e3] + + Made syncronous IO to not use libuv [05f3e9a0] + + Made syncronous sockets to not use libuv [6f202fbe] + + Moved encoding and line ending bits to IO::Socket [d6fd2491] + + Moved get and lines to IO::Socket role [9cec9408] + + IO::Path.Int method removed; handled by Cool.Int now [d13d9c2e] + + Re-implemented Proc in terms of Proc::Async [ac31c5df] + + +The following people contributed to this release: + +Elizabeth Mattijsen, Jonathan Worthington, Pawel Murias, Jan-Olof Hendig, +Samantha McVey, Christian Bartolomäus, Daniel Green, Tom Browder, cono, +Will "Coke" Coleda, Stefan Seifert, Antonio Quinonez, Nick Logan, +Dan Miller, Steve Mynott, JJ Merelo, Lloyd Fournier, +Juan Julián Merelo Guervós, Gabor Szabo, Trey Harris, Eckhart Arnold, +Julien Simonet, Moritz Lenz, Timo Paulssen, flussence, raiph, Kris Shannon, +Aleks-Daniel Jakimenko-Aleksejev, Fyodor Sizov, 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 (#113), is tentatively scheduled for 2017-07-15. + +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 013c676334b..785c9564c0e 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-06-17 Rakudo #112 (Zoffix) - 2017-07-15 Rakudo #113 + 2017-07-15 Rakudo #113 (Zoffix) 2017-08-19 Rakudo #114 2017-09-16 Rakudo #115 2017-10-21 Rakudo #116 @@ -430,6 +429,7 @@ Previous releases were bundled as part of monthly Parrot releases. 2017-04-18 2017.04.2 (Zoffix) 2017-04-23 2017.04.3 (Zoffix) 2017-05-20 Rakudo #111 "2017.05" (Zoffix + NeuralAnomaly) + 2017-06-17 Rakudo #112 "2017.06" (Zoffix + NeuralAnomaly) =head1 COPYRIGHT diff --git a/src/Perl6/Actions.nqp b/src/Perl6/Actions.nqp index 53c4b50ea47..1af0c813012 100644 --- a/src/Perl6/Actions.nqp +++ b/src/Perl6/Actions.nqp @@ -179,7 +179,7 @@ sub wanted($ast,$by) { elsif $node.op eq 'callstatic' || $node.op eq 'hllize' { $node[0] := WANTED($node[0], $byby); } - elsif $node.op eq 'p6for' { + elsif $node.op eq 'p6for' || $node.op eq 'p6forstmt' { $node := $node[1]; if nqp::istype($node,QAST::Op) && $node.op eq 'p6capturelex' { $node.annotate('past_block', WANTED($node.ann('past_block'), $byby)); @@ -394,7 +394,7 @@ sub unwanted($ast, $by) { } $node.sunk(1); } - elsif $node.op eq 'p6for' { + elsif $node.op eq 'p6for' || $node.op eq 'p6forstmt' { $node := $node[1]; if nqp::istype($node,QAST::Op) && $node.op eq 'p6capturelex' { $node.annotate('past_block', UNWANTED($node.ann('past_block'), $byby)); @@ -508,6 +508,95 @@ register_op_desugar('p6for', -> $qast { QAST::Op.new( :op, :name($qast.sunk ?? 'sink' !! 'eager'), $call ) ); }); +register_op_desugar('p6forstmt', -> $qast { + my $for-target-name := QAST::Node.unique('for_target'); + my $for-target := QAST::Op.new( + :op('bind'), + QAST::Var.new( :name($for-target-name), :scope('local'), :decl('var') ), + $qast[0] + ); + + my $iterator-name := QAST::Node.unique('for_iterator'); + my $iterator := QAST::Op.new( + :op('bind'), + QAST::Var.new( :name($iterator-name), :scope('local'), :decl('var') ), + QAST::Op.new( + :op('callmethod'), :name('iterator'), + QAST::Op.new( + :op('if'), + QAST::Op.new( + :op('iscont'), + QAST::Var.new( :name($for-target-name), :scope('local') ) + ), + QAST::Op.new( + :op('callstatic'), :name('&infix:<,>'), + QAST::Var.new( :name($for-target-name), :scope('local') ) + ), + QAST::Var.new( :name($for-target-name), :scope('local') ) + ))); + + my $iteration-end-name := QAST::Node.unique('for_iterationend'); + my $iteration-end := QAST::Op.new( + :op('bind'), + QAST::Var.new( :name($iteration-end-name), :scope('local'), :decl('var') ), + QAST::WVal.new( :value($qast.ann('IterationEnd')) ) + ); + + my $block-name := QAST::Node.unique('for_block'); + my $block := QAST::Op.new( + :op('bind'), + QAST::Var.new( :name($block-name), :scope('local'), :decl('var') ), + $qast[1] + ); + + my $iter-val-name := QAST::Node.unique('for_iterval'); + my $loop := QAST::Op.new( + :op('until'), + QAST::Op.new( + :op('eqaddr'), + QAST::Op.new( + :op('decont'), + QAST::Op.new( + :op('bind'), + QAST::Var.new( :name($iter-val-name), :scope('local'), :decl('var') ), + QAST::Op.new( + :op('callmethod'), :name('pull-one'), + QAST::Var.new( :name($iterator-name), :scope('local') ) + ) + ) + ), + QAST::Var.new( :name($iteration-end-name), :scope('local') ) + ), + QAST::Op.new( + :op('call'), + QAST::Var.new( :name($block-name), :scope('local') ), + QAST::Var.new( :name($iter-val-name), :scope('local') ) + )); + if $qast[2] { + $loop.push($qast[2]); + } + + QAST::Stmts.new( + $for-target, + $iterator, + $iteration-end, + $block, + $loop, + QAST::WVal.new( :value($qast.ann('Nil')) ) + ) +}); + +sub can-use-p6forstmt($block) { + my $past_block := $block.ann('past_block'); + my $count := $past_block.ann('count'); + return 0 unless nqp::isconcrete($count) && $count == 1; + my $code := $block.ann('code_object'); + my $block_type := $*W.find_symbol(['Block'], :setting-only); + return 1 unless nqp::istype($code, $block_type); + my $p := nqp::getattr($code, $block_type, '$!phasers'); + nqp::isnull($p) || + !(nqp::existskey($p, 'FIRST') || nqp::existskey($p, 'LAST') || nqp::existskey($p, 'NEXT')) +} sub monkey_see_no_eval($/) { my $msne := $*LANG.pragma('MONKEY-SEE-NO-EVAL'); @@ -1374,21 +1463,23 @@ class Perl6::Actions is HLL::Actions does STDActions { unless $past.ann('past_block') { $past := make_topic_block_ref($/, $past, migrate_stmt_id => $*STATEMENT_ID); } - $past := QAST::Want.new( - QAST::Op.new( - :op, :node($/), - $cond, - block_closure($past), - ), - 'v', QAST::Op.new( + my $fornode := QAST::Op.new( :op, :node($/), $cond, block_closure($past), - ), + ); + $past := QAST::Want.new( + $fornode, + 'v', QAST::Op.new(:op, $fornode), ); $past[2].sunk(1); my $sinkee := $past[0]; - $past.annotate('statement_level', -> { UNWANTED($sinkee, 'force for mod') }); + $past.annotate('statement_level', -> { + UNWANTED($sinkee, 'force for mod'); + $fornode.op('p6forstmt') if can-use-p6forstmt($fornode[1]); + $fornode.annotate('IterationEnd', $*W.find_symbol(['IterationEnd'])); + $fornode.annotate('Nil', $*W.find_symbol(['Nil'])); + }); } else { $past := QAST::Op.new($cond, $past, :op(~$ml), :node($/) ); @@ -1764,17 +1855,14 @@ class Perl6::Actions is HLL::Actions does STDActions { method statement_control:sym($/) { my $xblock := $.ast; - my $past := QAST::Want.new( - QAST::Op.new( + my $fornode := QAST::Op.new( :op, :node($/), $xblock[0], block_closure($xblock[1]), - ), - 'v', QAST::Op.new( - :op, :node($/), - $xblock[0], - block_closure($xblock[1]), - ), + ); + my $past := QAST::Want.new( + $fornode, + 'v', QAST::Op.new(:op, $fornode), ); if $*LABEL { my $label := QAST::WVal.new( :value($*W.find_symbol([$*LABEL])), :named('label') ); @@ -1783,7 +1871,14 @@ class Perl6::Actions is HLL::Actions does STDActions { } $past[2].sunk(1); my $sinkee := $past[0]; - $past.annotate('statement_level', -> { UNWANTED($sinkee,'force for') }); + $past.annotate('statement_level', -> { + UNWANTED($sinkee,'force for'); + if can-use-p6forstmt($fornode[1]) { + $fornode.op('p6forstmt'); + $fornode.annotate('IterationEnd', $*W.find_symbol(['IterationEnd'])); + $fornode.annotate('Nil', $*W.find_symbol(['Nil'])); + } + }); make $past; } @@ -3920,7 +4015,16 @@ class Perl6::Actions is HLL::Actions does STDActions { if $past.ann('placeholder_sig') { $/.PRECURSOR.panic('Placeholder variables cannot be used in a method'); } - $past[1] := wrap_return_handler($past[1]); + if is_clearly_returnless($past) { + $past[1] := QAST::Op.new( + :op('p6decontrv'), + QAST::WVal.new( :value($*DECLARAND) ), + $past[1]); + $past[1] := wrap_return_type_check($past[1], $*DECLARAND); + } + else { + $past[1] := wrap_return_handler($past[1]); + } } $past.blocktype('declaration_static'); @@ -4205,6 +4309,8 @@ class Perl6::Actions is HLL::Actions does STDActions { nqp::istype($past, QAST::Op) && $past.op ne 'callmethod' # May be .return or similar && nqp::getcomp('QAST').operations.is_inlinable('perl6', $past.op) || + # A QAST::Stmt node + nqp::istype($past, QAST::Stmt) || # Just a variable lookup. nqp::istype($past, QAST::Var) || # Just a QAST::Want @@ -4224,27 +4330,24 @@ class Perl6::Actions is HLL::Actions does STDActions { 1; } - # Only analyse things with a single simple statement. - if +$block[1].list == 1 && nqp::istype($block[1][0], QAST::Stmt) && +$block[1][0].list == 1 { - # Ensure there's no nested blocks. - for @($block[0]) { - if nqp::istype($_, QAST::Block) { return 0; } - if nqp::istype($_, QAST::Stmts) { - for @($_) { - if nqp::istype($_, QAST::Block) { return 0; } - } + # Ensure second node is QAST::Stmts. + return 0 unless nqp::istype($block[1], QAST::Stmts); + + # Ensure there's no nested blocks. + for @($block[0]) { + if nqp::istype($_, QAST::Block) { return 0; } + if nqp::istype($_, QAST::Stmts) { + for @($_) { + if nqp::istype($_, QAST::Block) { return 0; } } } - - # Ensure that the PAST is whitelisted things. - returnless_past($block[1][0][0]) - } - elsif +$block[1].list == 1 && nqp::istype($block[1][0], QAST::WVal) { - 1 } - else { - 0 + + # Check the block content. + for @($block[1]) { + return 0 unless returnless_past($_); } + return 1; } sub is_yada($/) { @@ -8122,12 +8225,14 @@ class Perl6::Actions is HLL::Actions does STDActions { sub add_signature_binding_code($block, $sig_obj, @params) { # Set arity. my int $arity := 0; + my int $count := 0; for @params { - last if $_ || $_ || - $_ || $_ || $_; - $arity := $arity + 1; + last if $_ || $_ || $_ || $_; + $arity := $arity + 1 unless $_; + $count := $count + 1; } $block.arity($arity); + $block.annotate('count', $count); # Consider using the VM binder on backends where it will work out # (e.g. we can get the same errors). diff --git a/src/Perl6/Grammar.nqp b/src/Perl6/Grammar.nqp index 57e342c4141..53a8edabf20 100644 --- a/src/Perl6/Grammar.nqp +++ b/src/Perl6/Grammar.nqp @@ -437,6 +437,8 @@ grammar Perl6::Grammar is HLL::Grammar does STD { self.define_slang('P5Regex', Perl6::P5RegexGrammar, Perl6::P5RegexActions); # Old language braid, going away eventually + # XXX TODO: if these are going out, be sure to make similar change + # to src/perl6-debug.nqp and ensure it still works. my %*LANG; %*LANG := Perl6::RegexGrammar; %*LANG := Perl6::RegexActions; diff --git a/src/Perl6/ModuleLoader.nqp b/src/Perl6/ModuleLoader.nqp index 8673aeeb18f..c2d7e39ec2f 100644 --- a/src/Perl6/ModuleLoader.nqp +++ b/src/Perl6/ModuleLoader.nqp @@ -1,4 +1,8 @@ -my $DEBUG := +nqp::ifnull(nqp::atkey(nqp::getenvhash(), 'RAKUDO_MODULE_DEBUG'), 0); +# $DEBUG is set to 1 for Truey numeric values of ENV 'RAKUDO_MODULE_DEBUG' +# or for non-numeric strings. All other cases $DEBUG is set to 0 +my $rakudo-module-debug := nqp::atkey(nqp::getenvhash(), 'RAKUDO_MODULE_DEBUG'); +my $DEBUG := nqp::stmts((my $debug-radix := nqp::radix(10, $rakudo-module-debug, 0, 0)),($debug-radix[2] != -1)) +?? ?$debug-radix[0] !! ?nqp::chars($rakudo-module-debug); sub DEBUG(*@strs) { my $err := stderr(); $err.print(" " ~ nqp::getpid() ~ " RMD: "); diff --git a/src/Perl6/Optimizer.nqp b/src/Perl6/Optimizer.nqp index 6753f2a3b2e..62291850e77 100644 --- a/src/Perl6/Optimizer.nqp +++ b/src/Perl6/Optimizer.nqp @@ -1068,7 +1068,7 @@ class Perl6::Optimizer { # If it's a for 1..1000000 { } we can simplify it to a while loop. We # check this here, before the tree is transformed by call inline opts. - if $optype eq 'p6for' && $op.sunk && @($op) == 2 { + if ($optype eq 'p6for' || $optype eq 'p6forstmt') && $op.sunk && @($op) == 2 { my $theop := $op[0]; if nqp::istype($theop, QAST::Stmts) { $theop := $theop[0] } @@ -1715,7 +1715,7 @@ class Perl6::Optimizer { else { $!problems.add_exception(['X', 'Method', 'NotFound'], $op, :private(nqp::p6bool(1)), :method($name), - :typename($pkg.HOW.name($pkg))); + :typename($pkg.HOW.name($pkg)), :invocant($pkg)); } } } diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp index 655286059bf..c0cef6de37b 100644 --- a/src/Perl6/World.nqp +++ b/src/Perl6/World.nqp @@ -1089,8 +1089,11 @@ class Perl6::World is HLL::World { } if nqp::islist($arglist) { 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($arg)); + $registry.use-repository($registry.repository-for-spec( + nqp::istype($arg, $io-path) ?? $arg.absolute !! $arg + )); } } else { @@ -4099,6 +4102,17 @@ class Perl6::World is HLL::World { elsif $name eq '&bytes' { @suggestions.push: '.encode($encoding).bytes'; } + elsif $name eq '&break' { + @suggestions.push: 'last'; + } + elsif $name eq '&skip' { + @suggestions.push: 'next'; + } + elsif $name eq '&continue' { + @suggestions.push: 'NEXT'; + @suggestions.push: 'proceed'; + @suggestions.push: 'succeed'; + } return @suggestions; } diff --git a/src/core/Any-iterable-methods.pm b/src/core/Any-iterable-methods.pm index f3271494425..0fab624e8e5 100644 --- a/src/core/Any-iterable-methods.pm +++ b/src/core/Any-iterable-methods.pm @@ -314,6 +314,7 @@ Did you mean to add a stub (\{...\}) or did you mean to .classify?" $target.push(&!block($pulled)), 'LABELED', $!label, 'REDO', ($stopped = 0), + 'NEXT', nqp::null, # need NEXT for next LABEL support 'LAST', return ) ), @@ -338,6 +339,7 @@ Did you mean to add a stub (\{...\}) or did you mean to .classify?" &!block($pulled), 'LABELED', $!label, 'REDO', ($stopped = 0), + 'NEXT', nqp::null, # need NEXT for next LABEL support 'LAST', return ) ), @@ -447,6 +449,7 @@ Did you mean to add a stub (\{...\}) or did you mean to .classify?" 'LABELED', $!label, 'REDO', ($redo = 1), 'LAST', (return IterationEnd), + 'NEXT', nqp::null, # need NEXT for next LABEL support ) ), :nohandler @@ -611,7 +614,8 @@ Did you mean to add a stub (\{...\}) or did you mean to .classify?" ), 'LABELED', $!label, 'REDO', ($redo = 1), - 'LAST', (return IterationEnd) + 'LAST', (return IterationEnd), + 'NEXT', nqp::null, # need NEXT for next LABEL support ) ), :nohandler diff --git a/src/core/Any.pm b/src/core/Any.pm index fee2056c4a8..62e9b3c1cc1 100644 --- a/src/core/Any.pm +++ b/src/core/Any.pm @@ -65,6 +65,8 @@ my class Any { # declared in BOOTSTRAP multi method Slip() { self.list.Slip } proto method Array(|) is nodal { * } multi method Array() { self.list.Array } + proto method Seq(|) is nodal { * } + multi method Seq() { self.list.Seq } proto method hash(|) is nodal { * } multi method hash(Any:U:) { my % = () } @@ -451,7 +453,8 @@ my class Any { # declared in BOOTSTRAP multi method MixHash() { MixHash.new-from-pairs(self.list) } # XXX GLR does this really need to force a list? - method Supply() is nodal { self.list.Supply } + proto method Supply(|) is nodal { * } + multi method Supply() { self.list.Supply } method nl-out() { "\n" } method print-nl() { self.print(self.nl-out) } diff --git a/src/core/Attribute.pm b/src/core/Attribute.pm index 829daf2e20f..93a41b07b1a 100644 --- a/src/core/Attribute.pm +++ b/src/core/Attribute.pm @@ -150,7 +150,7 @@ my class Attribute { # declared in BOOTSTRAP method WHY() { if nqp::isnull($!why) { - Nil + nextsame } else { $!why.set_docee(self); $!why diff --git a/src/core/Baggy.pm b/src/core/Baggy.pm index 96510c024ee..fe44c85241f 100644 --- a/src/core/Baggy.pm +++ b/src/core/Baggy.pm @@ -119,15 +119,39 @@ my role Baggy does QuantHash { } #--- object creation methods - multi method new(Baggy:_: +@args) { - nqp::stmts( - Rakudo::QuantHash.ADD-ITERATOR-TO-BAG( - (my $elems := nqp::create(Rakudo::Internals::IterationSet)), - (my $iterator := @args.iterator) - ), - nqp::create(self).SET-SELF($elems) + + # helper sub to create Bag from iterator, check for laziness + sub create-from-iterator(\type, \iterator --> Baggy:D) { + nqp::if( + iterator.is-lazy, + Failure.new(X::Cannot::Lazy.new(:action,:what(type.^name))), + nqp::create(type).SET-SELF( + Rakudo::QuantHash.ADD-ITERATOR-TO-BAG( + nqp::create(Rakudo::Internals::IterationSet), iterator + ) + ) + ) + } + + multi method new(Baggy:_: --> Baggy:D) { nqp::create(self) } + multi method new(Baggy:_: \value --> Baggy:D) { + nqp::if( + nqp::istype(value,Iterable) && nqp::not_i(nqp::iscont(value)), + create-from-iterator(self, value.iterator), + nqp::stmts( + nqp::bindkey( + (my $elems := nqp::create(Rakudo::Internals::IterationSet)), + value.WHICH, + Pair.new(value,1) + ), + nqp::create(self).SET-SELF($elems) + ) ) } + multi method new(Baggy:_: **@args) { + create-from-iterator(self, @args.iterator) + } + method new-from-pairs(Baggy:_: *@pairs --> Baggy:D) { nqp::if( (my $iterator := @pairs.iterator).is-lazy, diff --git a/src/core/Block.pm b/src/core/Block.pm index c404a0a04fe..536798dab89 100644 --- a/src/core/Block.pm +++ b/src/core/Block.pm @@ -323,7 +323,7 @@ my class Block { # declared in BOOTSTRAP method WHY() { if nqp::isnull($!why) { - Nil + nextsame } else { $!why.set_docee(self); $!why diff --git a/src/core/Buf.pm b/src/core/Buf.pm index adaa4695fc1..8bb115425e9 100644 --- a/src/core/Buf.pm +++ b/src/core/Buf.pm @@ -114,7 +114,11 @@ 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 } - method decode(Blob:D: $encoding = 'utf-8') { + proto method decode(|) { * } + multi method decode(Blob:D:) { + nqp::p6box_s(nqp::decode(self, 'utf8')) + } + multi method decode(Blob:D: $encoding) { nqp::p6box_s( nqp::decode(self, Rakudo::Internals.NORMALIZE_ENCODING($encoding))) } @@ -407,7 +411,7 @@ constant blob32 = Blob[uint32]; constant blob64 = Blob[uint64]; my class utf8 does Blob[uint8] is repr('VMArray') { - method decode(utf8:D: $encoding = 'utf-8') { + multi method decode(utf8:D: $encoding) { my $enc = Rakudo::Internals.NORMALIZE_ENCODING($encoding); die "Can not decode a utf-8 buffer as if it were $encoding" unless $enc eq 'utf8'; @@ -419,7 +423,7 @@ my class utf8 does Blob[uint8] is repr('VMArray') { } my class utf16 does Blob[uint16] is repr('VMArray') { - method decode(utf16:D: $encoding = 'utf-16') { + multi method decode(utf16:D: $encoding = 'utf-16') { my $enc = Rakudo::Internals.NORMALIZE_ENCODING($encoding); die "Can not decode a utf-16 buffer as if it were $encoding" unless $enc eq 'utf16'; @@ -431,7 +435,7 @@ my class utf16 does Blob[uint16] is repr('VMArray') { } my class utf32 does Blob[uint32] is repr('VMArray') { - method decode(utf32:D: $encoding = 'utf-32') { + multi method decode(utf32:D: $encoding = 'utf-32') { my $enc = Rakudo::Internals.NORMALIZE_ENCODING($encoding); die "Can not decode a utf-32 buffer as if it were $encoding" unless $enc eq 'utf32'; diff --git a/src/core/Channel.pm b/src/core/Channel.pm index c99194c6ec5..75442e08e75 100644 --- a/src/core/Channel.pm +++ b/src/core/Channel.pm @@ -106,7 +106,7 @@ my class Channel does Awaitable { } } - method Supply(Channel:D:) { + multi method Supply(Channel:D:) { supply { # Tap the async notification for new values supply. whenever $!async-notify.unsanitized-supply.schedule-on($*SCHEDULER) { diff --git a/src/core/Collation.pm b/src/core/Collation.pm index acd8b2e0a50..cc7ed3de4fa 100644 --- a/src/core/Collation.pm +++ b/src/core/Collation.pm @@ -1,29 +1,46 @@ class Collation { - has int $.collation-level = 15; + has int $.collation-level = 85; has $!Country = 'International'; method gist { "collation-level => $!collation-level, Country => $!Country, " ~ "Language => None, primary => {self.primary}, secondary => {self.secondary}, " ~ "tertiary => {self.tertiary}, quaternary => {self.quaternary}" } - #proto method set (|) { * } - #multi method set (Int :$collation-level!) { - # $!collation-level = $collation-level; - #} - method set (Bool :$primary = self.primary, - Bool :$secondary = self.secondary, Bool :$tertiary = self.tertiary, - Bool :$quaternary = self.quaternary) + method set ( + Int :$primary = 1, + Int :$secondary = 1, + Int :$tertiary = 1, + Int :$quaternary = 1) { my int $i = 0; - $i += 1 if $primary; - $i += 2 if $secondary; - $i += 4 if $tertiary; - $i += 8 if $quaternary; + $i += 1 if $primary.sign == 1; + $i += 2 if $primary.sign == -1; + + $i += 4 if $secondary.sign == 1; + $i += 8 if $secondary.sign == -1; + + $i += 16 if $tertiary.sign == 1; + $i += 32 if $tertiary.sign == -1; + + $i += 64 if $quaternary.sign == 1; + $i += 128 if $quaternary.sign == -1; $!collation-level = $i; + self; } - method primary { so $!collation-level +& 1 } - method secondary { so $!collation-level +& 2 } - method tertiary { so $!collation-level +& 4 } - method quaternary { so $!collation-level +& 8 } + method check ($more, $less) { + # Hopefully the user didn't set it this way, but return the correct + # result just in case + return 0 if $!collation-level +& all($more,$less); + return 1 if $!collation-level +& $more; + return -1 if $!collation-level +& $less; + return 0; + } + method primary { self.check( 1, 2) } + method secondary { self.check( 4, 8) } + method tertiary { self.check(16, 32) } + method quaternary { self.check(64, 128) } +} + +Rakudo::Internals.REGISTER-DYNAMIC: '$*COLLATION', { + PROCESS::<$COLLATION> := Collation.new; } -PROCESS::<$COLLATION> = Collation.new; diff --git a/src/core/CompUnit/PrecompilationRepository.pm b/src/core/CompUnit/PrecompilationRepository.pm index 19e4a9d6bd7..7d0b0036b97 100644 --- a/src/core/CompUnit/PrecompilationRepository.pm +++ b/src/core/CompUnit/PrecompilationRepository.pm @@ -174,7 +174,7 @@ class CompUnit::PrecompilationRepository::Default does CompUnit::PrecompilationR multi method load( CompUnit::PrecompilationId $id, IO::Path :$source, - Str :$checksum, + Str :$checksum is copy, Instant :$since, CompUnit::PrecompilationStore :@precomp-stores = Array[CompUnit::PrecompilationStore].new($.store), ) { @@ -186,7 +186,7 @@ class CompUnit::PrecompilationRepository::Default does CompUnit::PrecompilationR my $unit = self!load-file(@precomp-stores, $id); if $unit { if (not $since or $unit.modified > $since) - and (not $source or ($checksum // nqp::sha1($source.slurp(:enc))) eq $unit.source-checksum) + and (not $source or ($checksum //= nqp::sha1($source.slurp(:enc))) eq $unit.source-checksum) and self!load-dependencies($unit, @precomp-stores) { my \loaded = self!load-handle-for-path($unit); @@ -194,9 +194,9 @@ class CompUnit::PrecompilationRepository::Default does CompUnit::PrecompilationR return (loaded, $unit.checksum); } else { - if $*RAKUDO_MODULE_DEBUG -> $RMD { - $RMD("Outdated precompiled $unit\nmtime: {$unit.modified}{$since ?? "\nsince: $since" !! ''}") - } + $RMD("Outdated precompiled {$unit}{$source ?? " for $source" !! ''}\n" + ~ " mtime: {$unit.modified}{$since ?? ", since: $since" !! ''}\n" + ~ " checksum: {$unit.source-checksum}, expected: $checksum") if $RMD; $unit.close; fail "Outdated precompiled $unit"; } @@ -254,29 +254,43 @@ class CompUnit::PrecompilationRepository::Default does CompUnit::PrecompilationR $perl6.subst-mutate('perl6-j', 'perl6-jdb-server'); note "starting jdb on port " ~ ++%env; } - my $proc = run( - $perl6, - $lle, - $profile, - $optimize, - "--target=" ~ Rakudo::Internals.PRECOMP-TARGET, - "--output=$bc", - "--source-name=$source-name", - $path, - :out, - :err($RMD ?? '-' !! True), - :%env - ); + my $out = ''; + my $err = ''; + my $status; + react { + my $proc = Proc::Async.new( + $perl6, + $lle, + $profile, + $optimize, + "--target=" ~ Rakudo::Internals.PRECOMP-TARGET, + "--output=$bc", + "--source-name=$source-name", + $path + ); + + whenever $proc.stdout { + $out ~= $_ + } + unless $RMD { + whenever $proc.stderr { + $err ~= $_ + } + } + whenever $proc.start(ENV => %env) { + $status = .exitcode + } + } - my @result = $proc.out.lines.unique; - if not $proc.out.close or $proc.status { # something wrong + my @result = $out.lines.unique; + if $status { # something wrong self.store.unlock; - $RMD("Precomping $path failed: $proc.status()") if $RMD; + $RMD("Precomping $path failed: $status") if $RMD; Rakudo::Internals.VERBATIM-EXCEPTION(1); - die $RMD ?? @result !! $proc.err.slurp-rest(:close); + die $RMD ?? @result !! $err; } - if not $RMD and $proc.err.slurp-rest(:close) -> $warnings { + if not $RMD and $err -> $warnings { $*ERR.print($warnings); } unless $bc.e { @@ -298,7 +312,7 @@ class CompUnit::PrecompilationRepository::Default does CompUnit::PrecompilationR $RMD($dependency.Str()) if $RMD; @dependencies.push: $dependency; } - $RMD("Writing dependencies and byte code to $io.tmp") if $RMD; + $RMD("Writing dependencies and byte code to $io.tmp for source checksum: $source-checksum") if $RMD; self.store.store-unit( $compiler-id, $id, diff --git a/src/core/CompUnit/PrecompilationStore/File.pm b/src/core/CompUnit/PrecompilationStore/File.pm index b3cc6223d36..fbc85d98dfb 100644 --- a/src/core/CompUnit/PrecompilationStore/File.pm +++ b/src/core/CompUnit/PrecompilationStore/File.pm @@ -22,7 +22,7 @@ class CompUnit::PrecompilationStore::File does CompUnit::PrecompilationStore { ) { if $!bytecode { $!initialized = True; - $!checksum = nqp::sha1($!bytecode.decode("latin-1")); + $!checksum = nqp::sha1($!bytecode.decode('iso-8859-1')); } } @@ -126,8 +126,8 @@ class CompUnit::PrecompilationStore::File does CompUnit::PrecompilationStore { { $!update-lock.protect: { %!dir-cache{$compiler-id ~ $precomp-id} //= - (%!compiler-cache{$compiler-id} //= self.prefix.add($compiler-id.IO)) - .add($precomp-id.substr(0, 2).IO) + (%!compiler-cache{$compiler-id} //= self.prefix.add($compiler-id)) + .add($precomp-id.substr(0, 2)) } } @@ -135,7 +135,7 @@ class CompUnit::PrecompilationStore::File does CompUnit::PrecompilationStore { CompUnit::PrecompilationId $precomp-id, Str :$extension = '') { - self!dir($compiler-id, $precomp-id).add(($precomp-id ~ $extension).IO) + self!dir($compiler-id, $precomp-id).add($precomp-id ~ $extension) } method !lock(--> Nil) { @@ -203,11 +203,11 @@ class CompUnit::PrecompilationStore::File does CompUnit::PrecompilationStore { Str :$extension = '' --> IO::Path:D) { - my $compiler-dir = self.prefix.add($compiler-id.IO); + my $compiler-dir = self.prefix.add($compiler-id); $compiler-dir.mkdir unless $compiler-dir.e; my $dest = self!dir($compiler-id, $precomp-id); $dest.mkdir unless $dest.e; - $dest.add(($precomp-id ~ $extension).IO) + $dest.add($precomp-id ~ $extension) } method store-file(CompUnit::PrecompilationId $compiler-id, @@ -245,7 +245,7 @@ class CompUnit::PrecompilationStore::File does CompUnit::PrecompilationStore { method delete-by-compiler(CompUnit::PrecompilationId $compiler-id) { - my $compiler-dir = self.prefix.add($compiler-id.IO); + my $compiler-dir = self.prefix.add($compiler-id); for $compiler-dir.dir -> $subdir { $subdir.dir>>.unlink; $subdir.rmdir; diff --git a/src/core/CompUnit/Repository/FileSystem.pm b/src/core/CompUnit/Repository/FileSystem.pm index 7ca77095e52..dd542b1fae8 100644 --- a/src/core/CompUnit/Repository/FileSystem.pm +++ b/src/core/CompUnit/Repository/FileSystem.pm @@ -192,7 +192,15 @@ class CompUnit::Repository::FileSystem does CompUnit::Repository::Locally does C # We now save the 'resources/' part of a resource's path in files, i.e: # "files" : [ "resources/libraries/xxx" => "resources/libraries/xxx.so" ] # but we also want to root any path request to the CUR's resources directory - $.prefix.parent.add('resources').add($key.subst(/^resources\//, "")); + + # When $.prefix points at a directory containing a meta file (eg. -I.) + return $.prefix.add( %!meta<<$key>> ) + if %!meta && %!meta<<$key>>; + return $.prefix.add( $key ) + if %!meta && %!meta.first({ $_ eq $key.subst(/^resources\//, "") }); + + # When $.prefix is presumably the 'lib' folder (eg. -Ilib) + return $.prefix.parent.add($key); } method precomp-store(--> CompUnit::PrecompilationStore:D) { diff --git a/src/core/CompUnit/Repository/Installation.pm b/src/core/CompUnit/Repository/Installation.pm index 997d8ed8ef0..c911c71e4cd 100644 --- a/src/core/CompUnit/Repository/Installation.pm +++ b/src/core/CompUnit/Repository/Installation.pm @@ -52,39 +52,7 @@ __END__ '; my $perl_wrapper = '#!/usr/bin/env #perl# sub MAIN(:$name is copy, :$auth, :$ver, *@, *%) { - shift @*ARGS if $name; - shift @*ARGS if $auth; - shift @*ARGS if $ver; - $name //= \'#dist-name#\'; - my @installations = $*REPO.repo-chain.grep(CompUnit::Repository::Installable); - my @binaries = flat @installations.map: { .files(\'bin/#name#\', :$name, :$auth, :$ver) }; - unless +@binaries { - @binaries = flat @installations.map: { .files(\'bin/#name#\', :$name) }; - if +@binaries { - note q:to/SORRY/; - ===SORRY!=== - No candidate found for \'#name#\' that match your criteria. - Did you perhaps mean one of these? - SORRY - my %caps = :name([\'Distribution\', 12]), :auth([\'Author(ity)\', 11]), :ver([\'Version\', 7]); - for @binaries -> $dist { - for %caps.kv -> $caption, @opts { - @opts[1] = max @opts[1], ($dist{$caption} // \'\').Str.chars - } - } - note \' \' ~ %caps.values.map({ sprintf(\'%-*s\', .[1], .[0]) }).join(\' | \'); - for @binaries -> $dist { - note \' \' ~ %caps.kv.map( -> $k, $v { sprintf(\'%-*s\', $v.[1], $dist{$k} // \'\') } ).join(\' | \') - } - } - else { - note "===SORRY!===\nNo candidate found for \'#name#\'.\n"; - } - exit 1; - } - - %*ENV = $*PROGRAM-NAME; - exit run($*EXECUTABLE, @binaries.sort(*).tail.hash., @*ARGS).exitcode + CompUnit::RepositoryRegistry.run-script("#name#", :dist-name<#dist-name#>, :$name, :$auth, :$ver); }'; method !sources-dir() { @@ -260,16 +228,18 @@ sub MAIN(:$name is copy, :$auth, :$ver, *@, *%) { my $id = self!file-id(~$name, $dist-id); my $destination = $sources-dir.add($id); my $handle = $dist.content($file); - self!add-short-name($name, $dist, $id, nqp::sha1($handle.open(:enc).slurp(:close))); + my $content = $handle.open(:bin).slurp(:close); + + self!add-short-name($name, $dist, $id, + nqp::sha1(nqp::join("\n", nqp::split("\r\n", + $content.decode('iso-8859-1'))))); %provides{ $name } = ~$file => { :file($id), :time(try $file.IO.modified.Num), :$!cver }; note("Installing {$name} for {$dist.meta}") if $verbose and $name ne $dist.meta; - my $content = $handle.open.slurp-rest(:bin,:close); $destination.spurt($content); - $handle.close; } # bin/ scripts @@ -289,7 +259,7 @@ sub MAIN(:$name is copy, :$auth, :$ver, *@, *%) { $.prefix.add("$withoutext$be").IO.chmod(0o755); } } - self!add-short-name($name-path, $dist); + self!add-short-name($name-path, $dist, $id); %links{$name-path} = $id; my $handle = $dist.content($file); my $content = $handle.open.slurp-rest(:bin,:close); @@ -401,6 +371,26 @@ sub MAIN(:$name is copy, :$auth, :$ver, *@, *%) { unlink( $dist-dir.add($dist.id) ) } + method script($file, :$name!, :$auth, :$ver) { + my $prefix = self.prefix; + my $lookup = $prefix.add('short').add(nqp::sha1($file)); + return unless $lookup.e; + + # Scripts using this interface could only have been installed long after the introduction of + # repo version 1, so we don't have to care about very old repos in this method. + my @dists = $lookup.dir.map({ + my ($ver, $auth, $api, $resource-id) = $_.slurp.split("\n"); + $resource-id ||= self!read-dist($_.basename){$file}; + (id => $_.basename, ver => Version.new( $ver || 0 ), :$auth, :$api, :$resource-id).hash + }).grep({ + $_. ~~ $auth + and $_. ~~ $ver + }); + for @dists.sort(*.).reverse { + return self!resources-dir.add($_); + } + } + method files($file, :$name!, :$auth, :$ver) { my @candi; my $prefix = self.prefix; diff --git a/src/core/CompUnit/RepositoryRegistry.pm b/src/core/CompUnit/RepositoryRegistry.pm index f100e6d042d..994b67a16df 100644 --- a/src/core/CompUnit/RepositoryRegistry.pm +++ b/src/core/CompUnit/RepositoryRegistry.pm @@ -211,6 +211,40 @@ class CompUnit::RepositoryRegistry { Nil } + method run-script($script, :$dist-name, :$name is copy, :$auth, :$ver) { + shift @*ARGS if $name; + shift @*ARGS if $auth; + shift @*ARGS if $ver; + $name //= $dist-name; + my @installations = $*REPO.repo-chain.grep(CompUnit::Repository::Installation); + my @binaries = @installations.map({ .script("bin/$script", :$name, :$auth, :$ver) }).grep(*.defined); + unless +@binaries { + @binaries = flat @installations.map: { .script("bin/$script", :$name) }; + if +@binaries { + note "===SORRY!===\n" + ~ "No candidate found for '$script' that match your criteria.\n" + ~ "Did you perhaps mean one of these?"; + my %caps = :name(['Distribution', 12]), :auth(['Author(ity)', 11]), :ver(['Version', 7]); + for @binaries -> $dist { + for %caps.kv -> $caption, @opts { + @opts[1] = max @opts[1], ($dist{$caption} // '').Str.chars + } + } + note ' ' ~ %caps.values.map({ sprintf('%-*s', .[1], .[0]) }).join(' | '); + for @binaries -> $dist { + note ' ' ~ %caps.kv.map( -> $k, $v { sprintf('%-*s', $v.[1], $dist{$k} // '') } ).join(' | ') + } + } + else { + note "===SORRY!===\nNo candidate found for '$script'.\n"; + } + exit 1; + } + + my $bin = @binaries[0]; + require "$bin"; + } + method head() { # mostly usefull for access from NQP $*REPO } diff --git a/src/core/Distro.pm b/src/core/Distro.pm index d05eed92c53..52829db0cbf 100644 --- a/src/core/Distro.pm +++ b/src/core/Distro.pm @@ -63,7 +63,7 @@ sub INITIALIZE-A-DISTRO-NOW() { $auth := 'Apple Computer, Inc.'; # presumably } elsif Rakudo::Internals.FILETEST-E('/etc/os-release') { - $_ := '/etc/os-release'.IO.slurp.subst(:g, /'"'/,''); + $_ := '/etc/os-release'.IO.slurp.subst(:g, '"',''); $auth := ~$0 if m/^^ HOME_URL \= (\N*) /; $name := ~$0 if m/^^ ID \= (\N*) /; $version := ~$0 if m/^^ VERSION \= (\N*) /; diff --git a/src/core/Encoding.pm b/src/core/Encoding.pm new file mode 100644 index 00000000000..05c7ee47ff7 --- /dev/null +++ b/src/core/Encoding.pm @@ -0,0 +1,6 @@ +role Encoding { + method name(--> Str) { ... } + method alternative-names() { () } + method encoder(*%options --> Encoding::Encoder) { ... } + method decoder(*%options --> Encoding::Decoder) { ... } +} diff --git a/src/core/Encoding/Builtin.pm b/src/core/Encoding/Builtin.pm new file mode 100644 index 00000000000..137201ee8fd --- /dev/null +++ b/src/core/Encoding/Builtin.pm @@ -0,0 +1,91 @@ +class Encoding::Builtin does Encoding { + has Str $.name; + has $!alternative-names; + + method new() { + X::Cannot::New.new(class => self.WHAT).throw + } + + method SET-SELF(\name, \alternatives) { + nqp::stmts( + ($!name := name), + ($!alternative-names := alternatives), + self + ) + } + + method alternative-names() { $!alternative-names } + + method decoder(*%options --> Encoding::Decoder) { + Encoding::Decoder::Builtin.new($!name, |%options) + } + + my int $is-win = Rakudo::Internals.IS-WIN; + method encoder(:$replacement, :$translate-nl --> Encoding::Encoder) { + my $encoder = $replacement.DEFINITE && $replacement !=== False + ?? Encoding::Encoder::Builtin::Replacement.new($!name, + self!buf-type(), self!rep-char($replacement)) + !! Encoding::Encoder::Builtin.new($!name, self!buf-type()); + $translate-nl && $is-win + ?? Encoding::Encoder::TranslateNewlineWrapper.new($encoder) + !! $encoder + } + + my $enc_type := nqp::hash('utf8',utf8,'utf16',utf16,'utf32',utf32); + method !buf-type() { + nqp::ifnull(nqp::atkey($enc_type, $!name), blob8) + } + + method !rep-char($replacement) { + nqp::istype($replacement, Bool) + ?? ($!name.starts-with('utf') ?? "\x[FFFD]" !! "?") + !! $replacement.Str + } +} + +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") + ) +); diff --git a/src/core/Encoding/Decoder.pm b/src/core/Encoding/Decoder.pm new file mode 100644 index 00000000000..9de3dbc7e3f --- /dev/null +++ b/src/core/Encoding/Decoder.pm @@ -0,0 +1,11 @@ +role Encoding::Decoder { + method add-bytes(Blob:D $bytes --> Nil) { ... } + method consume-available-chars(--> Str:D) { ... } + method consume-all-chars(--> Str:D) { ... } + method consume-exactly-chars(int $chars --> Str) { ... } + method set-line-separators(@seps --> Nil) { ... } + method consume-line-chars(Bool:D :$chomp = False, Bool:D :$eof = False --> Str) { ... } + method is-empty(--> Bool) { ... } + method bytes-available(--> Int:D) { ... } + method consume-exactly-bytes(int $bytes --> Blob) { ... } +} diff --git a/src/core/Rakudo/Internals/VMBackedDecoder.pm b/src/core/Encoding/Decoder/Builtin.pm similarity index 92% rename from src/core/Rakudo/Internals/VMBackedDecoder.pm rename to src/core/Encoding/Decoder/Builtin.pm index f327654e706..8caa8ece0a0 100644 --- a/src/core/Rakudo/Internals/VMBackedDecoder.pm +++ b/src/core/Encoding/Decoder/Builtin.pm @@ -1,6 +1,4 @@ -my class Supply { ... } - -my class Rakudo::Internals::VMBackedDecoder is repr('Decoder') { +my class Encoding::Decoder::Builtin is repr('Decoder') does Encoding::Decoder { method new(str $encoding, :$translate-nl) { nqp::decoderconfigure(nqp::create(self), $encoding, $translate-nl ?? nqp::hash('translate_newlines', 1) !! nqp::null()) @@ -47,11 +45,12 @@ my class Rakudo::Internals::VMBackedDecoder is repr('Decoder') { } } +my class Supply { ... } +my class Encoding::Registry { ... } augment class Rakudo::Internals { method BYTE_SUPPLY_DECODER(Supply:D $bin-supply, Str:D $enc, :$translate-nl) { - my $norm-enc = self.NORMALIZE_ENCODING($enc); supply { - my $decoder = Rakudo::Internals::VMBackedDecoder.new($norm-enc, :$translate-nl); + my $decoder = Encoding::Registry.find($enc).decoder(:$translate-nl); whenever $bin-supply { $decoder.add-bytes($_); my $available = $decoder.consume-available-chars(); diff --git a/src/core/Encoding/Encoder.pm b/src/core/Encoding/Encoder.pm new file mode 100644 index 00000000000..70f1e4aca84 --- /dev/null +++ b/src/core/Encoding/Encoder.pm @@ -0,0 +1,3 @@ +role Encoding::Encoder { + method encode-chars(Str:D --> Blob:D) { ... } +} diff --git a/src/core/Encoding/Encoder/Builtin.pm b/src/core/Encoding/Encoder/Builtin.pm new file mode 100644 index 00000000000..abb98733634 --- /dev/null +++ b/src/core/Encoding/Encoder/Builtin.pm @@ -0,0 +1,44 @@ +my class Encoding::Encoder::Builtin does Encoding::Encoder { + has str $!encoding; + has Blob $!type; + + method new(Str $encoding, Blob:U $type) { + nqp::create(self)!setup($encoding, $type) + } + + method !setup($encoding, $type) { + $!encoding = $encoding; + $!type := nqp::can($type.HOW, 'pun') ?? $type.^pun !! $type.WHAT; + self + } + + method encode-chars(str $str --> Blob:D) { + nqp::encode($str, $!encoding, nqp::create($!type)) + } +} + +my class Encoding::Encoder::Builtin::Replacement does Encoding::Encoder { + has str $!encoding; + has Blob $!type; + has str $!replacement; + + method new(Str $encoding, Blob:U $type, Str $replacement) { + nqp::create(self)!setup($encoding, $type, $replacement) + } + + method !setup($encoding, $type, $replacement) { + $!encoding = $encoding; + $!type := nqp::can($type.HOW, 'pun') ?? $type.^pun !! $type.WHAT; + $!replacement = $replacement; + self + } + + method encode-chars(str $str --> Blob:D) { +#?if moar + nqp::encoderep($str, $!encoding, $!replacement, nqp::create($!type)) +#?endif +#?if !moar + X::NYI.new(feature => 'encoding with replacement').throw +#?endif + } +} diff --git a/src/core/Encoding/Encoder/TranslateNewlineWrapper.pm b/src/core/Encoding/Encoder/TranslateNewlineWrapper.pm new file mode 100644 index 00000000000..15b9e6b52d4 --- /dev/null +++ b/src/core/Encoding/Encoder/TranslateNewlineWrapper.pm @@ -0,0 +1,16 @@ +my class Encoding::Encoder::TranslateNewlineWrapper does Encoding::Encoder { + has Encoding::Encoder $!delegate; + + method new(Encoding::Encoder $delegate) { + nqp::create(self)!setup($delegate) + } + + method !setup(Encoding::Encoder $delegate) { + $!delegate := $delegate; + self + } + + method encode-chars(Str:D $str --> Blob:D) { + $!delegate.encode-chars(Rakudo::Internals.TRANSPOSE($str, "\n", "\r\n")) + } +} diff --git a/src/core/Encoding/Registry.pm b/src/core/Encoding/Registry.pm new file mode 100644 index 00000000000..b84b714ace4 --- /dev/null +++ b/src/core/Encoding/Registry.pm @@ -0,0 +1,26 @@ +my class X::Encoding::Unknown { ... } +my class X::Encoding::AlreadyRegistered { ... } + +my class Encoding::Registry { + my $lock := Lock.new; + my %lookup; + + 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 *; + } + } + + method find(Str() $name) { + $lock.protect: { + my $fname = $name.fc; + %lookup{$fname}:exists + ?? %lookup{$fname} + !! X::Encoding::Unknown.new(:$name).throw + } + } +} diff --git a/src/core/Exception.pm b/src/core/Exception.pm index b85b3265223..02d4d90f3bf 100644 --- a/src/core/Exception.pm +++ b/src/core/Exception.pm @@ -154,7 +154,7 @@ my class X::Method::NotFound is Exception { has Bool $.private = False; method message() { my $message = $.private - ?? "No such private method '$.method' for invocant of type '$.typename'" + ?? "No such private method '!$.method' for invocant of type '$.typename'" !! "No such method '$.method' for invocant of type '$.typename'"; my %suggestions; @@ -2013,6 +2013,22 @@ my class X::Str::Sprintf::Directives::BadType is Exception { } } +my role X::Encoding is Exception { } + +my class X::Encoding::Unknown does X::Encoding { + has $.name; + method message() { + "Unknown string encoding '$.name'" + } +} + +my class X::Encoding::AlreadyRegistered does X::Encoding { + has $.name; + method message() { + "An encoding with name '$.name' has already been registered" + } +} + my class X::Range::InvalidArg is Exception { has $.got is default(Nil); method message() { diff --git a/src/core/Hash.pm b/src/core/Hash.pm index d117994ef65..1a832afe513 100644 --- a/src/core/Hash.pm +++ b/src/core/Hash.pm @@ -741,10 +741,10 @@ my class Hash { # declared in BOOTSTRAP method Map() { self.pairs.Map } sub SETIFY(\objecthash, \type) { - nqp::stmts( - (my $elems := nqp::create(Rakudo::Internals::IterationSet)), - Rakudo::QuantHash.ADD-OBJECTHASH-TO-SET($elems,objecthash), - nqp::create(type).SET-SELF($elems) + nqp::create(type).SET-SELF( + Rakudo::QuantHash.ADD-OBJECTHASH-TO-SET( + nqp::create(Rakudo::Internals::IterationSet), objecthash + ) ) } multi method Set(::?CLASS:D:) { SETIFY(self,Set) } diff --git a/src/core/IO/CatHandle.pm b/src/core/IO/CatHandle.pm index 94e3fc53acd..6d49dfbcd90 100644 --- a/src/core/IO/CatHandle.pm +++ b/src/core/IO/CatHandle.pm @@ -158,7 +158,7 @@ my class IO::CatHandle is IO::Handle { } multi method lines(::?CLASS:D:) { self!LINES } - method Supply (::?CLASS:D: :$size = $*DEFAULT-READ-ELEMS --> Supply:D) { + multi method Supply (::?CLASS:D: :$size = $*DEFAULT-READ-ELEMS --> Supply:D) { nqp::if( nqp::isconcrete($!encoding), (supply nqp::stmts( @@ -202,7 +202,7 @@ my class IO::CatHandle is IO::Handle { $res), Nil) } - method read (::?CLASS:D: Int(Cool:D) $bytes) { + method read (::?CLASS:D: Int(Cool:D) $bytes = $*DEFAULT-READ-ELEMS) { nqp::if( nqp::defined($!active-handle), nqp::stmts( @@ -280,7 +280,7 @@ my class IO::CatHandle is IO::Handle { nqp::if( nqp::isfalse($enc.defined) || nqp::iseq_s($enc.Str, 'bin'), Nil, - Rakudo::Internals.NORMALIZE_ENCODING: $enc.Str)) + Encoding::Registry.find($enc.Str).name)) } method eof (::?CLASS:D: --> Bool:D) { diff --git a/src/core/IO/Handle.pm b/src/core/IO/Handle.pm index e3cefd94c05..e5784c57a2f 100644 --- a/src/core/IO/Handle.pm +++ b/src/core/IO/Handle.pm @@ -9,7 +9,8 @@ my class IO::Handle { has $.nl-in = ["\x0A", "\r\n"]; has Str:D $.nl-out is rw = "\n"; has Str $.encoding; - has Rakudo::Internals::VMBackedDecoder $!decoder; + has Encoding::Decoder $!decoder; + has Encoding::Encoder $!encoder; submethod TWEAK (:$encoding, :$bin) { nqp::if( @@ -31,6 +32,7 @@ my class IO::Handle { :$chomp = $!chomp, :$nl-in is copy = $!nl-in, Str:D :$nl-out is copy = $!nl-out, + :$buffer = False ) { nqp::if( $bin, @@ -41,6 +43,10 @@ my class IO::Handle { nqp::isconcrete($enc), $enc = $!encoding)); + my int $buffer-size = nqp::istype($buffer, Bool) + ?? ($buffer ?? 8192 !! 0) + !! $buffer.Int; + $mode = nqp::if( $mode, nqp::if(nqp::istype($mode, Str), $mode, $mode.Str), @@ -124,10 +130,13 @@ my class IO::Handle { $!chomp = $chomp; $!nl-out = $nl-out; if nqp::isconcrete($enc) { - $!encoding = Rakudo::Internals.NORMALIZE_ENCODING($enc); - $!decoder := Rakudo::Internals::VMBackedDecoder.new($!encoding, :translate-nl); + my $encoding = Encoding::Registry.find($enc); + $!decoder := $encoding.decoder(:translate-nl); $!decoder.set-line-separators(($!nl-in = $nl-in).list); + $!encoder := $encoding.encoder(:translate-nl); + $!encoding = $encoding.name; } + nqp::setbuffersizefh($!PIO, $buffer-size); return self; } @@ -165,10 +174,13 @@ my class IO::Handle { $!chomp = $chomp; $!nl-out = $nl-out; if nqp::isconcrete($enc) { - $!encoding = Rakudo::Internals.NORMALIZE_ENCODING($enc); - $!decoder := Rakudo::Internals::VMBackedDecoder.new($!encoding, :translate-nl); + my $encoding = Encoding::Registry.find($enc); + $!decoder := $encoding.decoder(:translate-nl); $!decoder.set-line-separators(($!nl-in = $nl-in).list); + $!encoder := $encoding.encoder(:translate-nl); + $!encoding = $encoding.name; } + nqp::setbuffersizefh($!PIO, $buffer-size); self; } @@ -197,8 +209,16 @@ my class IO::Handle { method eof(IO::Handle:D:) { nqp::p6bool($!decoder - ?? $!decoder.is-empty && nqp::eoffh($!PIO) - !! nqp::eoffh($!PIO)); + ?? $!decoder.is-empty && self.eof-internal + !! self.eof-internal) + } + + method eof-internal() { + nqp::eoffh($!PIO) + } + + method read-internal(Int $bytes) { + nqp::readfh($!PIO,buf8.new,nqp::unbox_i($bytes)) } method get(IO::Handle:D:) { @@ -209,7 +229,7 @@ my class IO::Handle { method !get-line-slow-path() { my $line := Nil; loop { - my $buf := nqp::readfh($!PIO, buf8.new, 0x100000); + my $buf := self.read-internal(0x100000); if $buf.elems { $!decoder.add-bytes($buf); $line := $!decoder.consume-line-chars(:$!chomp); @@ -217,7 +237,7 @@ my class IO::Handle { } else { $line := $!decoder.consume-line-chars(:$!chomp, :eof) - unless nqp::eoffh($!PIO) && $!decoder.is-empty; + unless self.eof-internal && $!decoder.is-empty; last; } } @@ -230,7 +250,7 @@ my class IO::Handle { } method !getc-slow-path() { - $!decoder.add-bytes(nqp::readfh($!PIO, buf8.new, 0x100000)); + $!decoder.add-bytes(self.read-internal(0x100000)); $!decoder.consume-exactly-chars(1) // $!decoder.consume-all-chars() || Nil } @@ -370,7 +390,7 @@ my class IO::Handle { method pull-one() { # Slow path falls back to .get on the handle, which will # replenish the buffer once we exhaust it. - $!decoder.consume-line-chars(:$!chomp) // $!handle.get // IterationEnd + $!decoder.consume-line-chars(:$!chomp) // ($!handle.get // IterationEnd) } method push-all($target --> IterationEnd) { nqp::while( @@ -426,19 +446,19 @@ my class IO::Handle { } multi method lines(IO::Handle:D:) { Seq.new(self!LINES-ITERATOR) } - method read(IO::Handle:D: Int(Cool:D) $bytes) { + method read(IO::Handle:D: Int(Cool:D) $bytes = $*DEFAULT-READ-ELEMS) { # If we have one, read bytes via. the decoder to support mixed-mode I/O. $!decoder ?? ($!decoder.consume-exactly-bytes($bytes) // self!read-slow-path($bytes)) - !! nqp::readfh($!PIO,buf8.new,nqp::unbox_i($bytes)) + !! self.read-internal($bytes) } method !read-slow-path($bytes) { - if nqp::eoffh($!PIO) && $!decoder.is-empty { + if self.eof-internal && $!decoder.is-empty { buf8.new } else { - $!decoder.add-bytes(nqp::readfh($!PIO, buf8.new, $bytes max 0x10000)); + $!decoder.add-bytes(self.read-internal($bytes max 0x100000)); $!decoder.consume-exactly-bytes($bytes) // $!decoder.consume-exactly-bytes($!decoder.bytes-available) // buf8.new @@ -452,9 +472,9 @@ my class IO::Handle { method !readchars-slow-path($chars) { my $result := ''; - unless nqp::eoffh($!PIO) && $!decoder.is-empty { + unless self.eof-internal && $!decoder.is-empty { loop { - my $buf := nqp::readfh($!PIO, buf8.new, 0x100000); + my $buf := self.read-internal(0x100000); if $buf.elems { $!decoder.add-bytes($buf); $result := $!decoder.consume-exactly-chars($chars); @@ -469,7 +489,7 @@ my class IO::Handle { $result } - method Supply(IO::Handle:D: :$size = $*DEFAULT-READ-ELEMS --> Supply:D) { + multi method Supply(IO::Handle:D: :$size = $*DEFAULT-READ-ELEMS --> Supply:D) { if $!decoder { # handle is in character mode supply { my int $chars = $size; @@ -509,7 +529,7 @@ my class IO::Handle { # Freshen decoder, so we won't have stuff left over from earlier reads # that were in the wrong place. - $!decoder := Rakudo::Internals::VMBackedDecoder.new($!encoding, :translate-nl); + $!decoder := Encoding::Registry.find($!encoding).decoder(:translate-nl); $!decoder.set-line-separators($!nl-in.list); } nqp::seekfh($!PIO, $offset - $rewind, +$whence); @@ -520,6 +540,10 @@ my class IO::Handle { } method write(IO::Handle:D: Blob:D $buf --> True) { + self.write-internal($buf) + } + + method write-internal(IO::Handle:D: Blob:D $buf --> True) { nqp::writefh($!PIO, nqp::decont($buf)); } @@ -553,7 +577,7 @@ my class IO::Handle { proto method print(|) { * } multi method print(IO::Handle:D: Str:D \x --> True) { $!decoder or die X::IO::BinaryMode.new(:trying); - nqp::writefh($!PIO, x.encode($!encoding, :translate-nl)); + self.write-internal($!encoder.encode-chars(x)); } multi method print(IO::Handle:D: **@list is raw --> True) { # is raw gives List, which is cheaper self.print(@list.join); @@ -562,17 +586,22 @@ my class IO::Handle { proto method put(|) { * } multi method put(IO::Handle:D: Str:D \x --> True) { $!decoder or die X::IO::BinaryMode.new(:trying); - nqp::writefh($!PIO, - nqp::concat(nqp::unbox_s(x), nqp::unbox_s($!nl-out)).encode($!encoding, :translate-nl)) + self.write-internal($!encoder.encode-chars( + nqp::concat(nqp::unbox_s(x), nqp::unbox_s($!nl-out)))) } multi method put(IO::Handle:D: **@list is raw --> True) { # is raw gives List, which is cheaper self.put(@list.join); } + multi method say(IO::Handle:D: Str $x --> True) { + $!decoder or die X::IO::BinaryMode.new(:trying); + self.write-internal($!encoder.encode-chars( + nqp::concat(nqp::unbox_s($x), nqp::unbox_s($!nl-out)))); + } multi method say(IO::Handle:D: \x --> True) { $!decoder or die X::IO::BinaryMode.new(:trying); - nqp::writefh($!PIO, - nqp::concat(nqp::unbox_s(x.gist), nqp::unbox_s($!nl-out)).encode($!encoding, :translate-nl)) + self.write-internal($!encoder.encode-chars( + nqp::concat(nqp::unbox_s(x.gist), nqp::unbox_s($!nl-out)))) } multi method say(IO::Handle:D: |) { $!decoder or die X::IO::BinaryMode.new(:trying); @@ -585,7 +614,7 @@ my class IO::Handle { method print-nl(IO::Handle:D: --> True) { $!decoder or die X::IO::BinaryMode.new(:trying); - nqp::writefh($!PIO, $!nl-out.encode($!encoding, :translate-nl)); + self.write-internal($!encoder.encode-chars($!nl-out)); } proto method slurp-rest(|) { * } @@ -620,7 +649,7 @@ my class IO::Handle { nqp::stmts( ($res := buf8.new), nqp::while( - nqp::elems(my $buf := nqp::readfh($!PIO, buf8.new, 0x100000)), + nqp::elems(my $buf := self.read-internal(0x100000)), $res.append($buf) ) ) @@ -632,7 +661,7 @@ my class IO::Handle { } method !slurp-all-chars() { - while nqp::elems(my $buf := nqp::readfh($!PIO, buf8.new, 0x100000)) { + while nqp::elems(my $buf := self.read-internal(0x100000)) { $!decoder.add-bytes($buf); } $!decoder.consume-all-chars() @@ -641,7 +670,7 @@ my class IO::Handle { proto method spurt(|) { * } multi method spurt(IO::Handle:D: Blob $data, :$close) { LEAVE self.close if $close; - self.write($data); + self.write-internal($data); } multi method spurt(IO::Handle:D: Cool $data, :$close) { LEAVE self.close if $close; @@ -672,7 +701,6 @@ my class IO::Handle { $_ = Nil; } else { - $_ = Rakudo::Internals.NORMALIZE_ENCODING(.Str); return $!encoding if $!encoding && $!encoding eq $_; } } @@ -683,15 +711,18 @@ my class IO::Handle { my $available = $!decoder.bytes-available; with $new-encoding { my $prev-decoder := $!decoder; - $!decoder := Rakudo::Internals::VMBackedDecoder.new($new-encoding, :translate-nl); + my $encoding = Encoding::Registry.find($new-encoding); + $!decoder := $encoding.decoder(:translate-nl); $!decoder.set-line-separators($!nl-in.list); $!decoder.add-bytes($prev-decoder.consume-exactly-bytes($available)) if $available; - $!encoding = $new-encoding; + $!encoder := $encoding.encoder(:translate-nl); + $!encoding = $encoding.name; } else { nqp::seekfh($!PIO, -$available, SeekFromCurrent) if $available; - $!decoder := Rakudo::Internals::VMBackedDecoder; + $!decoder := Encoding::Decoder; + $!encoder := Encoding::Encoder; $!encoding = Nil; Nil } @@ -699,9 +730,11 @@ my class IO::Handle { else { # No previous decoder; make a new one if needed, otherwise no change. with $new-encoding { - $!decoder := Rakudo::Internals::VMBackedDecoder.new($new-encoding, :translate-nl); + my $encoding = Encoding::Registry.find($new-encoding); + $!decoder := $encoding.decoder(:translate-nl); $!decoder.set-line-separators($!nl-in.list); - $!encoding = $new-encoding; + $!encoder := $encoding.encoder(:translate-nl); + $!encoding = $encoding.name; } else { Nil diff --git a/src/core/IO/Path.pm b/src/core/IO/Path.pm index 0a46af4aec9..3ebc07a0ca0 100644 --- a/src/core/IO/Path.pm +++ b/src/core/IO/Path.pm @@ -609,7 +609,8 @@ my class IO::Path is Cool does IO { $handle, nqp::stmts( (my $blob := $handle.slurp(:close)), - nqp::if($bin, $blob, $blob.decode($enc || 'utf-8').subst("\r\n", "\n", :g)) + nqp::if($bin, $blob, nqp::join("\n", + nqp::split("\r\n", $blob.decode: $enc || 'utf-8'))) )) } diff --git a/src/core/IO/Pipe.pm b/src/core/IO/Pipe.pm index 3ef826213bb..4bf91f23626 100644 --- a/src/core/IO/Pipe.pm +++ b/src/core/IO/Pipe.pm @@ -1,27 +1,67 @@ my class IO::Pipe is IO::Handle { has $.proc; + has $!on-read; + has $!on-write; + has $!on-close; + has $!bin-supply; + has $!eof = False; + has $!closed = False; - method TWEAK(:$enc, :$bin, Mu :$PIO --> Nil) { + method TWEAK(:$!on-close!, :$enc, :$bin, :$!on-read, :$!on-write, :$!bin-supply --> Nil) { if $bin { die X::IO::BinaryAndEncoding.new if nqp::isconcrete($enc); } else { - my $encoding = Rakudo::Internals.NORMALIZE_ENCODING($enc || 'utf-8'); - nqp::bindattr(self, IO::Handle, '$!encoding', $encoding); - my $decoder := Rakudo::Internals::VMBackedDecoder.new($encoding, :translate-nl); + my $encoding = Encoding::Registry.find($enc || 'utf-8'); + nqp::bindattr(self, IO::Handle, '$!encoding', $encoding.name); + my $decoder := $encoding.decoder(:translate-nl); $decoder.set-line-separators($.nl-in.list); nqp::bindattr(self, IO::Handle, '$!decoder', $decoder); + nqp::bindattr(self, IO::Handle, '$!encoder', $encoding.encoder(:translate-nl)) } - nqp::bindattr(self, IO::Handle, '$!PIO', nqp::decont($PIO)); } + method read-internal($) { + if $!on-read { + my \result = $!on-read(); + $!eof = True if result.elems == 0; + result + } + else { + die "This pipe was opened for writing, not reading" + } + } + + method eof-internal() { + $!eof + } + + method write-internal($data) { + $!on-write + ?? $!on-write($data) + !! die "This pipe was opened for reading, not writing" + } + + method flush(IO::Handle:D: --> True) { #`(No buffering) } + method close(IO::Pipe:D:) { - my $PIO := nqp::getattr(nqp::decont(self), IO::Handle, '$!PIO'); - $!proc.status( nqp::closefh_i($PIO) ) if nqp::defined($PIO); - nqp::bindattr(nqp::decont(self), IO::Handle, '$!PIO', Mu); + $!on-close(); + $!closed = True; $!proc; } + method opened(IO::Pipe:D:) { + not $!closed + } + + method t(IO::Pipe:D:) { + False + } + + method native-descriptor(IO::Pipe:D:) { + fail "An IO::Pipe does not have a native-descriptor" + } + method IO { IO::Path } method path { IO::Path } } diff --git a/src/core/IO/Socket.pm b/src/core/IO/Socket.pm index 720b6982e3c..61b117e0f46 100644 --- a/src/core/IO/Socket.pm +++ b/src/core/IO/Socket.pm @@ -3,12 +3,15 @@ my role IO::Socket { has Str $.encoding = 'utf8'; has $.nl-in is rw = ["\n", "\r\n"]; has Str:D $.nl-out is rw = "\n"; - has Rakudo::Internals::VMBackedDecoder $!decoder; + has Encoding::Decoder $!decoder; + has Encoding::Encoder $!encoder; - method !ensure-decoder(--> Nil) { + method !ensure-coders(--> Nil) { unless $!decoder.DEFINITE { - $!decoder := Rakudo::Internals::VMBackedDecoder.new($!encoding); + my $encoding = Encoding::Registry.find($!encoding); + $!decoder := $encoding.decoder(); $!decoder.set-line-separators($!nl-in); + $!encoder := $encoding.encoder(); } } @@ -20,7 +23,7 @@ my role IO::Socket { nqp::readfh($!PIO, nqp::decont(buf8.new), $limit) } else { - self!ensure-decoder(); + self!ensure-coders(); my $result = $!decoder.consume-exactly-chars($limit); without $result { $!decoder.add-bytes(nqp::readfh($!PIO, nqp::decont(buf8.new), 65535)); @@ -61,7 +64,7 @@ my role IO::Socket { } method get() { - self!ensure-decoder(); + self!ensure-coders(); my Str $line = $!decoder.consume-line-chars(:chomp); if $line.DEFINITE { $line @@ -88,7 +91,8 @@ my role IO::Socket { } method print(Str(Cool) $string --> True) { - self.write($string.encode($!encoding)); + self!ensure-coders(); + self.write($!encoder.encode-chars($string)); } method put(Str(Cool) $string --> True) { diff --git a/src/core/IO/Socket/Async.pm b/src/core/IO/Socket/Async.pm index fbd318bcb12..86cd6deeb19 100644 --- a/src/core/IO/Socket/Async.pm +++ b/src/core/IO/Socket/Async.pm @@ -4,6 +4,7 @@ my class IO::Socket::Async { has $!VMIO; has int $!udp; has $.enc; + has $!encoder; method new() { die "Cannot create an asynchronous socket directly; please use\n" ~ @@ -12,7 +13,7 @@ my class IO::Socket::Async { } method print(IO::Socket::Async:D: Str() $str, :$scheduler = $*SCHEDULER) { - self.write($str.encode($!enc)) + self.write($!encoder.encode-chars($str)) } method write(IO::Socket::Async:D: Blob $b, :$scheduler = $*SCHEDULER) { @@ -41,7 +42,7 @@ my class IO::Socket::Async { -> Mu \seq, Mu \data, Mu \err { $ss.process(seq, data, err) } } - method Supply(IO::Socket::Async:D: :$bin, :$buf = buf8.new, :$enc, :$scheduler = $*SCHEDULER) { + multi method Supply(IO::Socket::Async:D: :$bin, :$buf = buf8.new, :$enc, :$scheduler = $*SCHEDULER) { if $bin { my $cancellation; Supply.on-demand: @@ -76,6 +77,7 @@ my class IO::Socket::Async { :$enc = 'utf-8', :$scheduler = $*SCHEDULER) { my $p = Promise.new; my $v = $p.vow; + my $encoding = Encoding::Registry.find($enc); nqp::asyncconnect( $scheduler.queue, -> Mu \socket, Mu \err { @@ -85,7 +87,9 @@ my class IO::Socket::Async { else { my $client_socket := nqp::create(self); nqp::bindattr($client_socket, IO::Socket::Async, '$!VMIO', socket); - nqp::bindattr($client_socket, IO::Socket::Async, '$!enc', $enc); + nqp::bindattr($client_socket, IO::Socket::Async, '$!enc', $encoding.name); + nqp::bindattr($client_socket, IO::Socket::Async, '$!encoder', + $encoding.encoder()); $v.keep($client_socket); } }, @@ -96,6 +100,7 @@ my class IO::Socket::Async { 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, @@ -106,7 +111,10 @@ my class IO::Socket::Async { else { my $client_socket := nqp::create(self); nqp::bindattr($client_socket, IO::Socket::Async, '$!VMIO', socket); - nqp::bindattr($client_socket, IO::Socket::Async, '$!enc', $enc); + nqp::bindattr($client_socket, IO::Socket::Async, '$!enc', + $encoding.name); + nqp::bindattr($client_socket, IO::Socket::Async, '$!encoder', + $encoding.encoder()); $s.emit($client_socket); } }, @@ -125,6 +133,7 @@ my class IO::Socket::Async { #?if moar method udp(IO::Socket::Async:U: :$broadcast, :$enc = 'utf-8', :$scheduler = $*SCHEDULER) { my $p = Promise.new; + my $encoding = Encoding::Registry.find($enc); nqp::asyncudp( $scheduler.queue, -> Mu \socket, Mu \err { @@ -135,7 +144,9 @@ my class IO::Socket::Async { my $client_socket := nqp::create(self); nqp::bindattr($client_socket, IO::Socket::Async, '$!VMIO', socket); nqp::bindattr_i($client_socket, IO::Socket::Async, '$!udp', 1); - nqp::bindattr($client_socket, IO::Socket::Async, '$!enc', $enc); + nqp::bindattr($client_socket, IO::Socket::Async, '$!enc', $encoding.name); + nqp::bindattr($client_socket, IO::Socket::Async, '$!encoder', + $encoding.encoder()); $p.keep($client_socket); } }, @@ -147,6 +158,7 @@ my class IO::Socket::Async { method bind-udp(IO::Socket::Async:U: Str() $host, Int() $port, :$broadcast, :$enc = 'utf-8', :$scheduler = $*SCHEDULER) { my $p = Promise.new; + my $encoding = Encoding::Registry.find($enc); nqp::asyncudp( $scheduler.queue, -> Mu \socket, Mu \err { @@ -157,7 +169,9 @@ my class IO::Socket::Async { my $client_socket := nqp::create(self); nqp::bindattr($client_socket, IO::Socket::Async, '$!VMIO', socket); nqp::bindattr_i($client_socket, IO::Socket::Async, '$!udp', 1); - nqp::bindattr($client_socket, IO::Socket::Async, '$!enc', $enc); + nqp::bindattr($client_socket, IO::Socket::Async, '$!enc', $encoding.name); + nqp::bindattr($client_socket, IO::Socket::Async, '$!encoder', + $encoding.encoder()); $p.keep($client_socket); } }, @@ -167,7 +181,7 @@ my class IO::Socket::Async { } method print-to(IO::Socket::Async:D: Str() $host, Int() $port, Str() $str, :$scheduler = $*SCHEDULER) { - self.write-to($host, $port, $str.encode($!enc)) + self.write-to($host, $port, $!encoder.encode-chars($str)) } method write-to(IO::Socket::Async:D: Str() $host, Int() $port, Blob $b, :$scheduler = $*SCHEDULER) { diff --git a/src/core/Kernel.pm b/src/core/Kernel.pm index 4d74b69c29b..1eccd05c1b6 100644 --- a/src/core/Kernel.pm +++ b/src/core/Kernel.pm @@ -115,7 +115,13 @@ class Kernel does Systemic { # These are the ones libuv emulates on Windows. @names = flat "", ; } else { - @names = flat "", qx/kill -l/.words; + if self.name eq 'openbsd' { + # otherwise it uses a shell buildin + @names = flat "", qx!/bin/kill -l!.words; + } + else { + @names = flat "", qx/kill -l/.words; + } @names.splice(1,1) if @names[1] eq "0"; # Ubuntu fudge @names.=map({.uc}) if $*KERNEL.name eq 'dragonfly'; } diff --git a/src/core/List.pm b/src/core/List.pm index 0646d9fdbf1..2c19bdf785d 100644 --- a/src/core/List.pm +++ b/src/core/List.pm @@ -691,7 +691,6 @@ my class List does Iterable does Positional { # declared in BOOTSTRAP multi method list(List:D:) { self } - proto method Seq(|) is nodal { * } multi method Seq(List:D:) { Seq.new(self.iterator) } method sink(--> Nil) { } @@ -912,7 +911,7 @@ my class List does Iterable does Positional { # declared in BOOTSTRAP } method FLATTENABLE_HASH() { nqp::hash() } - method Supply(List:D:) { Supply.from-list(self) } + multi method Supply(List:D:) { Supply.from-list(self) } method CALL-ME(List:U: |c) { self.new(|c); diff --git a/src/core/Lock.pm b/src/core/Lock.pm index ef153ec3302..d2e136d882b 100644 --- a/src/core/Lock.pm +++ b/src/core/Lock.pm @@ -14,6 +14,8 @@ my class Lock { method signal_all() { nqp::condsignalall(self) } } + method new() { nqp::create(self) } + method lock(Lock:D:) { nqp::lock(self) } method unlock(Lock:D:) { nqp::unlock(self) } diff --git a/src/core/Map.pm b/src/core/Map.pm index ecf9556ba4c..9bacb874471 100644 --- a/src/core/Map.pm +++ b/src/core/Map.pm @@ -403,10 +403,10 @@ my class Map does Iterable does Associative { # declared in BOOTSTRAP multi method pick(Map:D:) { self.roll } sub SETIFY(\map, \type) { - nqp::stmts( - (my $elems := nqp::create(Rakudo::Internals::IterationSet)), - Rakudo::QuantHash.ADD-MAP-TO-SET($elems,map), - nqp::create(type).SET-SELF($elems) + nqp::create(type).SET-SELF( + Rakudo::QuantHash.ADD-MAP-TO-SET( + nqp::create(Rakudo::Internals::IterationSet), map + ) ) } multi method Set(Map:D:) { SETIFY(self,Set) } diff --git a/src/core/Mu.pm b/src/core/Mu.pm index 39cdb2ea9a9..6f53d66de87 100644 --- a/src/core/Mu.pm +++ b/src/core/Mu.pm @@ -3,9 +3,6 @@ my class X::Method::NotFound { ... } my class X::Method::InvalidQualifier { ... } my class X::Attribute::Required { ... } -# We use a sentinel value to mark the end of an iteration. -my constant IterationEnd = nqp::create(Mu); - my class Mu { # declared in BOOTSTRAP method self { self } @@ -78,6 +75,13 @@ my class Mu { # declared in BOOTSTRAP multi method WHY(Mu:) { my Mu $why; + my role Suggestion[$name] { + method gist { + "No documentation available for type '$name'. +Perhaps it can be found at https://docs.perl6.org/type/$name" + } + } + if nqp::can(self.HOW, 'WHY') { $why := self.HOW.WHY; } @@ -85,7 +89,7 @@ my class Mu { # declared in BOOTSTRAP if $why.defined && !$.defined #`(ie. we're a type object) { $why.set_docee(self); } - $why // Any + $why // Nil but Suggestion[self.^name] } method set_why($why) { @@ -135,9 +139,8 @@ my class Mu { # declared in BOOTSTRAP # Get the build plan. Note that we do this "low level" to # avoid the NQP type getting mapped to a Rakudo one, which # would get expensive. - my $build_plan := - nqp::findmethod(self.HOW,'BUILDALLPLAN')(self.HOW, self); - my int $count = nqp::elems($build_plan); + my $bp := nqp::findmethod(self.HOW,'BUILDALLPLAN')(self.HOW, self); + my int $count = nqp::elems($bp); my int $i = -1; my $task; my $build; @@ -149,175 +152,170 @@ my class Mu { # declared in BOOTSTRAP nqp::while( nqp::islt_i($i = nqp::add_i($i,1),$count), - nqp::if( # 0 # Custom BUILD call. - nqp::iseq_i(($code = nqp::atpos( - ($task := nqp::atpos($build_plan,$i)),0 - )),0), - nqp::if( - nqp::istype( - ($build := nqp::atpos($task,1)(self,|%attrinit)),Failure), - return $build - ), + nqp::if( + ($code = nqp::atpos(($task := nqp::atpos($bp,$i)),0)), - nqp::if( # 1 - nqp::iseq_i($code,1), + nqp::if( # >0 + nqp::isle_i($code,3), # 1,2,3 nqp::if( nqp::existskey($init,nqp::atpos($task,2)), (nqp::getattr(self,nqp::atpos($task,1),nqp::atpos($task,3)) - = %attrinit.AT-KEY(nqp::p6box_s(nqp::atpos($task,2)))) + = %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( # 2 - 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)) - = %attrinit.AT-KEY(nqp::p6box_s(nqp::atpos($task,2)))), - nqp::bindattr(self,nqp::atpos($task,1),nqp::atpos($task,3), - nqp::list) + 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( # 3 - nqp::iseq_i($code,3), - nqp::if( + nqp::if( + nqp::isle_i($code,7), + nqp::if( # 5,6,7 nqp::existskey($init,nqp::atpos($task,2)), - (nqp::getattr(self,nqp::atpos($task,1),nqp::atpos($task,3)) - = %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( # can initialize + nqp::iseq_i($code,5), + nqp::bindattr_i(self, # 5 + 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::atpos($task,1), + nqp::atpos($task,3), + nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,2))) + ), + nqp::bindattr_s(self, # 7 + nqp::atpos($task,1), + nqp::atpos($task,3), + nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,2))) + ) + ) + ) ), - nqp::if( # 4 - nqp::iseq_i($code,4), - nqp::unless( - nqp::attrinited(self, + nqp::if( + nqp::iseq_i($code,8), + nqp::if( # 8 + nqp::iseq_i($int = nqp::getattr_i(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)) + ), 0), + nqp::bindattr_i(self, + nqp::atpos($task,1), + nqp::atpos($task,2), + (nqp::atpos($task,3)(self,$int)) ) ), - nqp::if( # 5 - nqp::iseq_i($code,5), - nqp::if( - nqp::existskey($init,nqp::atpos($task,2)), - nqp::bindattr_i(self, + nqp::if( + nqp::iseq_i($code,9), + nqp::if( # 9 + nqp::iseq_n($num = nqp::getattr_n(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) + ), 0e0), + nqp::bindattr_n(self, + nqp::atpos($task,1), + nqp::atpos($task,2), + (nqp::atpos($task,3)(self,$num)) ) ), - nqp::if( # 6 - nqp::iseq_i($code,6), - nqp::if( - nqp::existskey($init,nqp::atpos($task,2)), - nqp::bindattr_n(self, + nqp::if( + nqp::iseq_i($code,10), + nqp::if( # 10 + nqp::isnull_s($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( # 7 - nqp::iseq_i($code,7), - nqp::if( - 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::if( + nqp::iseq_i($code,11), + nqp::unless( # 11 + 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( # 8 - nqp::iseq_i($code,8), - nqp::if( - nqp::iseq_i($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( # 9 - nqp::iseq_i($code,9), - nqp::if( - nqp::iseq_n($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( # 10 - nqp::iseq_i($code,10), - nqp::if( - 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,12), + nqp::bindattr(self, # 12 + nqp::atpos($task,1), + nqp::atpos($task,2), + (nqp::atpos($task,3)()) + ), - nqp::if( # 11 - nqp::iseq_i($code,11), - nqp::unless( - 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,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") + ))))))))), - nqp::if( # 12 - nqp::iseq_i($code,12), - nqp::bindattr(self, - nqp::atpos($task,1), - nqp::atpos($task,2), - (nqp::atpos($task,3)()) - ), - - nqp::if( # 13 - nqp::isne_i($code,13), # no-op - die("Invalid BUILDALL plan") - ) - )))))))))))))); + nqp::if( # 0 Custom BUILD call. + nqp::istype( + ($build := nqp::if( + nqp::elems($init), + nqp::atpos($task,1)(self,|%attrinit), + nqp::atpos($task,1)(self) + )), + Failure + ), + return $build + ) + ) + ); self } method BUILD_LEAST_DERIVED(%attrinit) { my $init := nqp::getattr(%attrinit,Map,'$!storage'); # Get the build plan for just this class. - my $build_plan := nqp::findmethod(self.HOW,'BUILDPLAN')(self.HOW,self); - my int $count = nqp::elems($build_plan); + my $bp := nqp::findmethod(self.HOW,'BUILDPLAN')(self.HOW,self); + my int $count = nqp::elems($bp); my int $i = -1; my $task; my $build; @@ -331,11 +329,17 @@ my class Mu { # declared in BOOTSTRAP nqp::if( # 0 # Custom BUILD call. nqp::iseq_i(($code = nqp::atpos( - ($task := nqp::atpos($build_plan,$i)),0 + ($task := nqp::atpos($bp,$i)),0 )),0), nqp::if( nqp::istype( - ($build := nqp::atpos($task,1)(self,|%attrinit)),Failure), + ($build := nqp::if( + nqp::elems($init), + nqp::atpos($task,1)(self,|%attrinit), + nqp::atpos($task,1)(self) + )), + Failure + ), return $build ), @@ -478,9 +482,28 @@ my class Mu { # declared in BOOTSTRAP # Force vivification, for the sake of meta-object # mix-ins at compile time ending up with correctly # shared containers. - nqp::getattr(self, - nqp::atpos($task,1), - nqp::atpos($task,2) + nqp::stmts( + nqp::getattr(self, + nqp::atpos($task,1), + nqp::atpos($task,2) + ), + nqp::while( # 13's flock together + nqp::islt_i( + ($i = nqp::add_i($i,1)), + $count + ) && nqp::iseq_i( + nqp::atpos( + ($task := nqp::atpos($bp,$i)), + 0 + ), + 13 + ), + nqp::getattr(self, + nqp::atpos($task,1), + nqp::atpos($task,2) + ) + ), + ($i = nqp::sub_i($i,1)) ), die("Invalid BUILD_LEAST_DERIVED plan") ) diff --git a/src/core/Pair.pm b/src/core/Pair.pm index 9586c6d1432..849ac442e3d 100644 --- a/src/core/Pair.pm +++ b/src/core/Pair.pm @@ -64,13 +64,14 @@ my class Pair does Associative { multi method perl(Pair:D: :$arglist) { self.perlseen('Pair', -> :$arglist { - nqp::istype($!key, Str) + nqp::istype($!key, Str) && nqp::isconcrete($!key) ?? !$arglist && $!key ~~ /^ [\w*] +% <[\-']> $/ - ?? nqp::istype($!value,Bool) + ?? nqp::istype($!value,Bool) && nqp::isconcrete($!value) ?? ':' ~ '!' x !$!value ~ $!key !! ':' ~ $!key ~ '(' ~ $!value.perl ~ ')' !! $!key.perl ~ ' => ' ~ $!value.perl !! nqp::istype($!key, Numeric) + && nqp::isconcrete($!key) && !(nqp::istype($!key,Num) && nqp::isnanorinf($!key)) ?? $!key.perl ~ ' => ' ~ $!value.perl !! '(' ~ $!key.perl ~ ') => ' ~ $!value.perl diff --git a/src/core/Proc.pm b/src/core/Proc.pm index f659d4cb56b..1cfcb0172a8 100644 --- a/src/core/Proc.pm +++ b/src/core/Proc.pm @@ -1,3 +1,6 @@ +# Proc is a wrapper around Proc::Async, providing a synchronous API atop of +# the asynchronous API. +my class Proc::Async { ... } my class Proc { has IO::Pipe $.in; has IO::Pipe $.out; @@ -6,79 +9,98 @@ my class Proc { has $.signal; has @.command; - has $!in_fh; - has $!out_fh; - has $!err_fh; - has int $!flags; + has Proc::Async $!proc; + has Bool $!w; + has @!pre-spawn; + has @!post-spawn; + has $!active-handles = 0; + has $!finished; submethod BUILD(:$in = '-', :$out = '-', :$err = '-', :$exitcode, Bool :$bin, Bool :$chomp = True, Bool :$merge, :$command, Str :$enc, Str:D :$nl = "\n", :$signal --> Nil) { - if $merge { - die "Executing programs with :merge is known to be broken\n" - ~ "Please see https://rt.perl.org//Public/Bug/Display.html?id=128594 for the bug report.\n"; - } @!command = |$command if $command; if nqp::istype($in, IO::Handle) && $in.DEFINITE { - $!in_fh := nqp::getattr(nqp::decont($in), IO::Handle, '$!PIO'); - $!flags += nqp::const::PIPE_INHERIT_IN; + @!pre-spawn.push({ $!proc.bind-stdin($in) }); } elsif $in === True { - $!in_fh := nqp::syncpipe(); - $!flags += nqp::const::PIPE_CAPTURE_IN; - $!in = IO::Pipe.new(:proc(self), :path(''), :$chomp, :$enc, :$bin, - nl-out => $nl, :PIO($!in_fh)); + $!in = IO::Pipe.new(:proc(self), :$chomp, :$enc, :$bin, nl-out => $nl, + :on-write({ await $!proc.write($_) }), + :on-close({ $!proc.close-stdin; self!await-if-last-handle })); + $!active-handles++; + $!w := True; } elsif nqp::istype($in, Str) && $in eq '-' { - $!in_fh := nqp::null(); - $!flags += nqp::const::PIPE_INHERIT_IN; - } - else { - $!in_fh := nqp::null(); - $!flags += nqp::const::PIPE_IGNORE_IN; - } - - if $out === True || $merge { - $!out_fh := nqp::syncpipe(); - $!flags += nqp::const::PIPE_CAPTURE_OUT; - $!out = IO::Pipe.new(:proc(self), :path(''), :$chomp, :$enc, :$bin, - nl-in => $nl, :PIO($!out_fh)); - } - elsif nqp::istype($out, IO::Handle) && $out.DEFINITE { - $!out_fh := nqp::getattr(nqp::decont($out), IO::Handle, '$!PIO'); - $!flags += nqp::const::PIPE_INHERIT_OUT; - } - elsif nqp::istype($out, Str) && $out eq '-' { - $!out_fh := nqp::null(); - $!flags += nqp::const::PIPE_INHERIT_OUT; + # Inherit; nothing to do } else { - $!out_fh := nqp::null(); - $!flags += nqp::const::PIPE_IGNORE_OUT; + $!w := True; + @!post-spawn.push({ $!proc.close-stdin }); } if $merge { - $!err := $!out; - $!err_fh := $!out_fh; - $!flags += nqp::const::PIPE_INHERIT_ERR; - } - elsif nqp::istype($err, IO::Handle) && $err.DEFINITE { - $!err_fh := nqp::getattr(nqp::decont($err), IO::Handle, '$!PIO'); - $!flags += nqp::const::PIPE_INHERIT_ERR; - } - elsif nqp::istype($err, Str) && $err eq '-' { - $!err_fh := nqp::null(); - $!flags += nqp::const::PIPE_INHERIT_ERR; - } - elsif $err === True { - $!err_fh := nqp::syncpipe(); - $!flags += nqp::const::PIPE_CAPTURE_ERR; - $!err = IO::Pipe.new(:proc(self), :path(''), :$chomp, :$enc, :$bin, - nl-in => $nl, :PIO($!err_fh)); + my $chan = Channel.new; + $!out = IO::Pipe.new(:proc(self), :$chomp, :$enc, :$bin, nl-in => $nl, + :on-read({ (try $chan.receive) // buf8.new }), + :on-close({ self!await-if-last-handle }), + :bin-supply({ $chan.Supply })); + $!active-handles++; + @!pre-spawn.push({ + $!proc.stdout(:bin).merge($!proc.stderr(:bin)).act: { $chan.send($_) }, + done => { $chan.close }, + quit => { $chan.fail($_) } + }); } else { - $!err_fh := nqp::null(); - $!flags += nqp::const::PIPE_IGNORE_ERR; + if $out === True { + my $chan = Channel.new; + $!out = IO::Pipe.new(:proc(self), :$chomp, :$enc, :$bin, nl-in => $nl, + :on-read({ (try $chan.receive) // buf8.new }), + :on-close({ self!await-if-last-handle }), + :bin-supply({ $chan.Supply })); + $!active-handles++; + @!pre-spawn.push({ + $!proc.stdout(:bin).tap: { $chan.send($_) }, + done => { $chan.close }, + quit => { $chan.fail($_) } + }); + } + elsif nqp::istype($out, IO::Handle) && $out.DEFINITE { + @!pre-spawn.push({ $!proc.bind-stdout($out) }); + } + elsif nqp::istype($out, Str) && $out eq '-' { + # Inherit; nothing to do + } + else { + @!pre-spawn.push({ + $!proc.stdout(:bin).tap: -> $ { }, quit => -> $ { } + }); + } + + if $err === True { + my $chan = Channel.new; + $!err = IO::Pipe.new(:proc(self), :$chomp, :$enc, :$bin, nl-in => $nl, + :on-read({ (try $chan.receive) // buf8.new }), + :on-close({ self!await-if-last-handle }), + :bin-supply({ $chan.Supply })); + $!active-handles++; + @!pre-spawn.push({ + $!proc.stderr(:bin).tap: { $chan.send($_) }, + done => { $chan.close }, + quit => { $chan.fail($_) } + }); + } + elsif nqp::istype($err, IO::Handle) && $err.DEFINITE { + @!pre-spawn.push({ $!proc.bind-stderr($err) }); + } + elsif nqp::istype($err, Str) && $err eq '-' { + # Inherit; nothing to do + } + else { + @!pre-spawn.push({ + $!proc.stderr(:bin).tap: -> $ { }, quit => -> $ { } + }); + } } if nqp::istype($exitcode, Int) && $exitcode.DEFINITE { @@ -89,30 +111,41 @@ my class Proc { } } - method spawn(*@args where .so, :$cwd = $*CWD, :$env) { + method !await-if-last-handle(--> Nil) { + self!wait-for-finish unless --$!active-handles; + } + + method !wait-for-finish { + CATCH { default { self.status(0x100) } } + self.status(await($!finished).status) if $!exitcode == -1; + } + + method spawn(*@args where .so, :$cwd = $*CWD, :$env --> Bool:D) { @!command = @args; - my %env := $env ?? $env.hash !! %*ENV; - self.status(nqp::p6box_i(nqp::spawn( - CLONE-LIST-DECONTAINERIZED(@args), - nqp::unbox_s($cwd.Str), - CLONE-HASH-DECONTAINERIZED(%env), - $!in_fh, $!out_fh, $!err_fh, - $!flags - ))); - self.Bool + self!spawn-internal(@args, $cwd, $env) } - method shell($cmd, :$cwd = $*CWD, :$env) { + method shell($cmd, :$cwd = $*CWD, :$env --> Bool:D) { @!command = $cmd; - my %env := $env ?? $env.hash !! %*ENV; - self.status(nqp::p6box_i(nqp::shell( - nqp::unbox_s($cmd), - nqp::unbox_s($cwd.Str), - CLONE-HASH-DECONTAINERIZED(%env), - $!in_fh, $!out_fh, $!err_fh, - $!flags - ))); - self.Bool + my @args := Rakudo::Internals.IS-WIN + ?? (%*ENV, '/c', $cmd) + !! ('/bin/sh', '-c', $cmd); + self!spawn-internal(@args, $cwd, $env) + } + + method !spawn-internal(@args, $cwd, $env --> Bool:D) { + my %ENV := $env ?? $env.hash !! %*ENV; + $!proc := Proc::Async.new(|@args, :$!w); + .() for @!pre-spawn; + $!finished = $!proc.start(:$cwd, :%ENV, scheduler => $PROCESS::SCHEDULER); + my $is-spawned := do { + CATCH { default { self.status(0x100) } } + await $!proc.ready; + True + } // False; + .() for @!post-spawn; + self!wait-for-finish unless $!out || $!err || $!in; + $is-spawned } proto method status(|) { * } @@ -120,12 +153,26 @@ my class Proc { $!exitcode = $new_status +> 8; $!signal = $new_status +& 0xFF; } - multi method status(Proc:D:) { ($!exitcode +< 8) +| $!signal } - multi method Numeric(Proc:D:) { $!exitcode } - multi method Bool(Proc:D:) { $!exitcode == 0 } + multi method status(Proc:D:) { + self!wait-for-finish; + ($!exitcode +< 8) +| $!signal + } + multi method Numeric(Proc:D:) { + self!wait-for-finish; + $!exitcode + } + multi method Bool(Proc:D:) { + self!wait-for-finish; + $!exitcode == 0 + } + method exitcode { + self!wait-for-finish; + $!exitcode + } method sink(--> Nil) { - X::Proc::Unsuccessful.new(:proc(self)).throw unless self; + self!wait-for-finish; + X::Proc::Unsuccessful.new(:proc(self)).throw if $!exitcode > 0; } } @@ -146,23 +193,9 @@ sub shell($cmd, :$in = '-', :$out = '-', :$err = '-', } sub QX($cmd, :$cwd = $*CWD, :$env) { - my %env := $env ?? $env.hash !! %*ENV; - my Mu $pio := nqp::syncpipe(); - my $status := nqp::shell( - nqp::unbox_s($cmd), - nqp::unbox_s($cwd.Str), - CLONE-HASH-DECONTAINERIZED(%env), - nqp::null(), $pio, nqp::null(), - nqp::const::PIPE_INHERIT_IN + nqp::const::PIPE_CAPTURE_OUT + nqp::const::PIPE_INHERIT_ERR - ); - my $result; - try { - $result = IO::Pipe.new(:PIO($pio)).slurp; - $status := nqp::closefh_i($pio); - } - $result.DEFINITE - ?? $result - !! Failure.new("Unable to read from '$cmd'") + my $proc = Proc.new(:out); + $proc.shell($cmd, :$cwd, :$env); + $proc.out.slurp(:close) // Failure.new("Unable to read from '$cmd'") } # vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Proc/Async.pm b/src/core/Proc/Async.pm index 321d768bded..9420b6316a2 100644 --- a/src/core/Proc/Async.pm +++ b/src/core/Proc/Async.pm @@ -11,6 +11,21 @@ my class X::Proc::Async::TapBeforeSpawn does X::Proc::Async { } } +my class X::Proc::Async::SupplyOrStd does X::Proc::Async { + method message() { + "Using .Supply on a Proc::Async implies merging stdout and stderr; .stdout " ~ + "and .stderr cannot therefore be used in combination with it" + } +} + +my class X::Proc::Async::BindOrUse does X::Proc::Async { + has $.handle; + has $.use; + method message() { + "Cannot both bind $.handle to a handle and also $.use" + } +} + my class X::Proc::Async::CharsOrBytes does X::Proc::Async { has $.handle; method message() { @@ -54,15 +69,25 @@ my class Proc::Async { has CharsOrBytes $!stdout_type; has $!stderr_supply; has CharsOrBytes $!stderr_type; + has $!merge_supply; + has CharsOrBytes $!merge_type; + has Int $!stdin-fd; + has Int $!stdout-fd; + has Int $!stderr-fd; has $!process_handle; has $!exit_promise; has @!promises; + has $!encoder; proto method new(|) { * } multi method new(*@ ($path, *@args), *%_) { self.bless(:$path, :@args, |%_) } + submethod TWEAK(--> Nil) { + $!encoder := Encoding::Registry.find($!enc).encoder(:$!translate-nl); + } + method !supply(\what,\the-supply,\type,\value) { X::Proc::Async::TapBeforeSpawn.new(handle => what, proc => self).throw if $!started; @@ -75,11 +100,17 @@ my class Proc::Async { 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')) + if $!stdout-fd; $bin ?? self!supply('stdout', $!stdout_supply, $!stdout_type, Bytes).Supply !! self.stdout(|%_) } multi method stdout(Proc::Async:D: :$enc, :$translate-nl) { + die X::Proc::Async::SupplyOrStd.new if $!merge_supply; + die X::Proc::Async::BindOrUse.new(:handle, :use('get the stdout Supply')) + if $!stdout-fd; self!wrap-decoder: self!supply('stdout', $!stdout_supply, $!stdout_type, Chars).Supply, $enc, :$translate-nl @@ -87,16 +118,78 @@ my class Proc::Async { 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')) + if $!stderr-fd; $bin ?? self!supply('stderr', $!stderr_supply, $!stderr_type, Bytes).Supply !! self.stderr(|%_) } multi method stderr(Proc::Async:D: :$enc, :$translate-nl) { + die X::Proc::Async::SupplyOrStd.new if $!merge_supply; + die X::Proc::Async::BindOrUse.new(:handle, :use('get the stderr Supply')) + if $!stderr-fd; self!wrap-decoder: self!supply('stderr', $!stderr_supply, $!stderr_type, Chars).Supply, $enc, :$translate-nl } + 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')) + if $!stdout-fd; + die X::Proc::Async::BindOrUse.new(:handle, :use('get the output Supply')) + if $!stderr-fd; + $bin + ?? self!supply('merge', $!merge_supply, $!merge_type, Bytes).Supply + !! self.Supply(|%_) + } + multi method Supply(Proc::Async:D: :$enc, :$translate-nl) { + die X::Proc::Async::SupplyOrStd.new if $!stdout_supply || $!stderr_supply; + die X::Proc::Async::BindOrUse.new(:handle, :use('get the output Supply')) + if $!stdout-fd; + die X::Proc::Async::BindOrUse.new(:handle, :use('get the output Supply')) + if $!stderr-fd; + self!wrap-decoder: + self!supply('merge', $!merge_supply, $!merge_type, Chars).Supply, + $enc, :$translate-nl + } + + proto method bind-stdin($) {*} + multi method bind-stdin(IO::Handle:D $handle --> Nil) { + die X::Proc::Async::BindOrUse.new(:handle, :use('use :w')) if $!w; + $!stdin-fd := $handle.native-descriptor; + } + multi method bind-stdin(IO::Pipe:D $handle --> Nil) { + die X::Proc::Async::BindOrUse.new(:handle, :use('use :w')) if $!w; + my $sup := nqp::getattr(nqp::decont($handle), IO::Pipe, '$!bin-supply'); + die "Can only bind an output IO::Pipe to stdin of a process" + unless $sup.DEFINITE; + $!w = True; + $!ready_promise.then({ + $sup().tap: { await self.write($_) }, + done => { self.close-stdin }, + quit => { self.close-stdin }; + }); + } + + method bind-stdout(IO::Handle:D $handle --> Nil) { + die X::Proc::Async::BindOrUse.new(:handle, :use('get the stdout Supply')) + if $!stdout_supply; + die X::Proc::Async::BindOrUse.new(:handle, :use('get the output Supply')) + if $!merge_supply; + $!stdout-fd := $handle.native-descriptor; + } + + method bind-stderr(IO::Handle:D $handle --> Nil) { + die X::Proc::Async::BindOrUse.new(:handle, :use('get the stderr Supply')) + if $!stderr_supply; + die X::Proc::Async::BindOrUse.new(:handle, :use('get the output Supply')) + if $!merge_supply; + $!stderr-fd := $handle.native-descriptor; + } + method ready(--> Promise) { $!ready_promise; } @@ -151,9 +244,15 @@ my class Proc::Async { @!promises.push( self!capture($callbacks,'stderr',$!stderr_supply) ) if $!stderr_supply; + @!promises.push( + self!capture($callbacks,'merge',$!merge_supply) + ) if $!merge_supply; nqp::bindkey($callbacks, 'buf_type', buf8.new); nqp::bindkey($callbacks, 'write', True) if $.w; + nqp::bindkey($callbacks, 'stdin_fd', $!stdin-fd) if $!stdin-fd.DEFINITE; + 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, CLONE-LIST-DECONTAINERIZED($!path,@!args), @@ -161,7 +260,6 @@ my class Proc::Async { CLONE-HASH-DECONTAINERIZED(%ENV), $callbacks, ); - Promise.allof( $!exit_promise, @!promises ).then({ $!exit_promise.status == Broken ?? $!exit_promise.cause.throw @@ -173,7 +271,7 @@ my class Proc::Async { X::Proc::Async::OpenForWriting.new(:method, proc => self).throw if !$!w; X::Proc::Async::MustBeStarted.new(:method, proc => self).throw if !$!started; - self.write($str.encode($!enc, :$!translate-nl)) + self.write($!encoder.encode-chars($str)) } method put(Proc::Async:D: \x, |c) { diff --git a/src/core/Promise.pm b/src/core/Promise.pm index 5aceb23d309..5ae4bd13562 100644 --- a/src/core/Promise.pm +++ b/src/core/Promise.pm @@ -256,7 +256,7 @@ my class Promise does Awaitable { $p } - method Supply(Promise:D:) { + multi method Supply(Promise:D:) { Supply.on-demand: -> $s { self.then({ if self.status == Kept { diff --git a/src/core/Rakudo/Internals.pm b/src/core/Rakudo/Internals.pm index bd47246dd87..d95822e760c 100644 --- a/src/core/Rakudo/Internals.pm +++ b/src/core/Rakudo/Internals.pm @@ -298,10 +298,10 @@ my class Rakudo::Internals { ) } - method TRANSPOSE(str $string, str $original, str $final) { + method TRANSPOSE(Str:D $string, Str:D $original, Str:D $final) { nqp::join($final,nqp::split($original,$string)) } - method TRANSPOSE-ONE(str $string, str $original, str $final) { + method TRANSPOSE-ONE(Str:D $string, Str:D $original, Str:D $final) { nqp::if( nqp::iseq_i((my int $index = nqp::index($string, $original)), -1), $string, @@ -309,7 +309,7 @@ my class Rakudo::Internals { nqp::substr($string,0,$index), nqp::concat( $final, - nqp::substr($string,nqp::add_i($index,nqp::chars($final))) + nqp::substr($string,nqp::add_i($index,nqp::chars($original))) ) ) ) diff --git a/src/core/Rakudo/Iterator.pm b/src/core/Rakudo/Iterator.pm index 6af8a50072a..a4ff9831db7 100644 --- a/src/core/Rakudo/Iterator.pm +++ b/src/core/Rakudo/Iterator.pm @@ -1901,9 +1901,17 @@ class Rakudo::Iterator { X::Cannot::Lazy.new(:$action).throw, nqp::stmts( (my $result := IterationEnd), - nqp::until( - nqp::eqaddr((my $pulled := iterator.pull-one),IterationEnd), - ($result := $pulled) + nqp::if( + nqp::can(iterator, 'count-only'), + nqp::if( + (my $count := iterator.count-only) + && iterator.skip-at-least($count - 1), + $result := iterator.pull-one + ), + nqp::until( + nqp::eqaddr((my $pulled := iterator.pull-one),IterationEnd), + ($result := $pulled) + ), ), $result ) diff --git a/src/core/Rakudo/QuantHash.pm b/src/core/Rakudo/QuantHash.pm index 78099068ebc..f55fcd2045b 100644 --- a/src/core/Rakudo/QuantHash.pm +++ b/src/core/Rakudo/QuantHash.pm @@ -135,7 +135,7 @@ my class Rakudo::QuantHash { } #--- Set/SetHash related methods - method SET-IS-SUBSET($a,$b) { + method SET-IS-SUBSET($a,$b --> Bool:D) { nqp::stmts( nqp::unless( nqp::eqaddr(nqp::decont($a),nqp::decont($b)), @@ -161,14 +161,25 @@ my class Rakudo::QuantHash { ) } - # add to given IterationSet the values of given iterator with Pair check - method ADD-PAIRS-TO-SET(\elems,Mu \iterator) { + # add to given IterationSet the values of given iterator + method ADD-ITERATOR-TO-SET(\elems,Mu \iterator) { nqp::stmts( nqp::until( nqp::eqaddr( - (my $pulled := iterator.pull-one), + (my $pulled := nqp::decont(iterator.pull-one)), IterationEnd ), + nqp::bindkey(elems,$pulled.WHICH,$pulled) + ), + elems + ) + } + + # add to given IterationSet the values of given iterator with Pair check + method ADD-PAIRS-TO-SET(\elems,Mu \iterator) { + nqp::stmts( + nqp::until( + nqp::eqaddr((my $pulled := iterator.pull-one),IterationEnd), nqp::if( nqp::istype($pulled,Pair), nqp::if( @@ -187,41 +198,47 @@ my class Rakudo::QuantHash { } # add to given IterationSet the keys of given Map - method ADD-MAP-TO-SET(\elems,\map --> Nil) { - nqp::if( - (my $raw := nqp::getattr(nqp::decont(map),Map,'$!storage')) - && (my $iter := nqp::iterator($raw)), - nqp::while( - $iter, - nqp::if( - nqp::iterval(nqp::shift($iter)), - nqp::bindkey( - elems,nqp::iterkey_s($iter).WHICH,nqp::iterkey_s($iter)) + method ADD-MAP-TO-SET(\elems, \map) { + nqp::stmts( + nqp::if( + (my $raw := nqp::getattr(nqp::decont(map),Map,'$!storage')) + && (my $iter := nqp::iterator($raw)), + nqp::while( + $iter, + nqp::if( + nqp::iterval(nqp::shift($iter)), + nqp::bindkey( + elems,nqp::iterkey_s($iter).WHICH,nqp::iterkey_s($iter)) + ) ) - ) + ), + elems ) } # add to given IterationSet the objects of given object Hash - method ADD-OBJECTHASH-TO-SET(\elems,\objecthash --> Nil) { - nqp::if( - (my $raw := nqp::getattr(nqp::decont(objecthash),Map,'$!storage')) - && (my $iter := nqp::iterator($raw)), - nqp::while( - $iter, - nqp::if( - nqp::getattr( - nqp::decont(nqp::iterval(nqp::shift($iter))), - Pair, - '$!value' - ), - nqp::bindkey( - elems, - nqp::iterkey_s($iter), - nqp::getattr(nqp::iterval($iter),Pair,'$!key') + method ADD-OBJECTHASH-TO-SET(\elems, \objecthash) { + nqp::stmts( + nqp::if( + (my $raw := nqp::getattr(nqp::decont(objecthash),Map,'$!storage')) + && (my $iter := nqp::iterator($raw)), + nqp::while( + $iter, + nqp::if( + nqp::getattr( + nqp::decont(nqp::iterval(nqp::shift($iter))), + Pair, + '$!value' + ), + nqp::bindkey( + elems, + nqp::iterkey_s($iter), + nqp::getattr(nqp::iterval($iter),Pair,'$!key') + ) ) ) - ) + ), + elems ) } @@ -328,51 +345,55 @@ my class Rakudo::QuantHash { ) } - method ADD-BAG-TO-BAG(\elems,Mu \bag --> Nil) { - nqp::if( - bag && nqp::elems(bag), - nqp::stmts( - (my $iter := nqp::iterator(bag)), - nqp::while( - $iter, - nqp::if( - nqp::existskey(elems,nqp::iterkey_s(nqp::shift($iter))), - nqp::stmts( - (my $pair := nqp::atkey(elems,nqp::iterkey_s($iter))), - nqp::bindattr($pair,Pair,'$!value', - nqp::add_i( - nqp::getattr($pair,Pair,'$!value'), - nqp::getattr(nqp::iterval($iter),Pair,'$!value') + method ADD-BAG-TO-BAG(\elems,Mu \bag) { + nqp::stmts( + nqp::if( + bag && nqp::elems(bag), + nqp::stmts( + (my $iter := nqp::iterator(bag)), + nqp::while( + $iter, + nqp::if( + nqp::existskey(elems,nqp::iterkey_s(nqp::shift($iter))), + nqp::stmts( + (my $pair := nqp::atkey(elems,nqp::iterkey_s($iter))), + nqp::bindattr($pair,Pair,'$!value', + nqp::getattr($pair,Pair,'$!value') + + nqp::getattr(nqp::iterval($iter),Pair,'$!value') ) + ), + nqp::bindkey(elems,nqp::iterkey_s($iter), + nqp::clone(nqp::iterval($iter)) ) - ), - nqp::bindkey(elems,nqp::iterkey_s($iter), - nqp::clone(nqp::iterval($iter)) ) ) ) - ) + ), + elems ) } - method ADD-ITERATOR-TO-BAG(\elems,Mu \iterator --> Nil) { - nqp::until( - nqp::eqaddr((my $pulled := iterator.pull-one),IterationEnd), - nqp::if( - nqp::existskey(elems,(my $WHICH := $pulled.WHICH)), - nqp::stmts( - (my $pair := nqp::atkey(elems,$WHICH)), - nqp::bindattr($pair,Pair,'$!value', - nqp::add_i(nqp::getattr($pair,Pair,'$!value'),1) - ) - ), - nqp::bindkey(elems,$WHICH,Pair.new($pulled,1)) - ) + method ADD-ITERATOR-TO-BAG(\elems,Mu \iterator) { + nqp::stmts( + nqp::until( + nqp::eqaddr((my $pulled := iterator.pull-one),IterationEnd), + nqp::if( + nqp::existskey(elems,(my $WHICH := $pulled.WHICH)), + nqp::stmts( + (my $pair := nqp::atkey(elems,$WHICH)), + nqp::bindattr($pair,Pair,'$!value', + nqp::add_i(nqp::getattr($pair,Pair,'$!value'),1) + ) + ), + nqp::bindkey(elems,$WHICH,Pair.new($pulled,1)) + ) + ), + elems ) } # add to given IterationSet the values of given iterator with Pair check - method ADD-PAIRS-TO-BAG(\elems,Mu \iterator) is raw { + method ADD-PAIRS-TO-BAG(\elems,Mu \iterator) { nqp::stmts( nqp::until( nqp::eqaddr( @@ -439,31 +460,34 @@ my class Rakudo::QuantHash { ) } - method ADD-SET-TO-BAG(\elems,Mu \set --> Nil) { - nqp::if( - set && nqp::elems(set), - nqp::stmts( - (my $iter := nqp::iterator(set)), - nqp::while( - $iter, - nqp::if( - nqp::existskey(elems,nqp::iterkey_s(nqp::shift($iter))), - nqp::stmts( - (my $pair := nqp::atkey(elems,nqp::iterkey_s($iter))), - nqp::bindattr($pair,Pair,'$!value', - nqp::add_i(nqp::getattr($pair,Pair,'$!value'),1) + method ADD-SET-TO-BAG(\elems,Mu \set) { + nqp::stmts( + nqp::if( + set && nqp::elems(set), + nqp::stmts( + (my $iter := nqp::iterator(set)), + nqp::while( + $iter, + nqp::if( + nqp::existskey(elems,nqp::iterkey_s(nqp::shift($iter))), + nqp::stmts( + (my $pair := nqp::atkey(elems,nqp::iterkey_s($iter))), + nqp::bindattr($pair,Pair,'$!value', + nqp::add_i(nqp::getattr($pair,Pair,'$!value'),1) + ) + ), + nqp::bindkey(elems,nqp::iterkey_s($iter), + Pair.new(nqp::iterval($iter),1) ) - ), - nqp::bindkey(elems,nqp::iterkey_s($iter), - Pair.new(nqp::iterval($iter),1) ) ) ) - ) + ), + elems ) } - method MULTIPLY-BAG-TO-BAG(\elems,Mu \bag --> Nil) { + method MULTIPLY-BAG-TO-BAG(\elems,Mu \bag) { nqp::stmts( (my $iter := nqp::iterator(elems)), nqp::if( @@ -492,11 +516,12 @@ my class Rakudo::QuantHash { $iter, nqp::deletekey(elems,nqp::iterkey_s(nqp::shift($iter))) ) - ) + ), + elems ) } - method MULTIPLY-SET-TO-BAG(\elems,Mu \set --> Nil) { + method MULTIPLY-SET-TO-BAG(\elems,Mu \set) { nqp::stmts( (my $iter := nqp::iterator(elems)), nqp::if( @@ -512,7 +537,8 @@ my class Rakudo::QuantHash { $iter, nqp::deletekey(elems,nqp::iterkey_s(nqp::shift($iter))) ) - ) + ), + elems ) } @@ -614,9 +640,9 @@ my class Rakudo::QuantHash { ), nqp::if( nqp::istype($pulled,Pair), - nqp::unless( # got a Pair + nqp::if( # got a Pair (my $value := - nqp::decont(nqp::getattr($pulled,Pair,'$!value'))) == 0, + nqp::decont(nqp::getattr($pulled,Pair,'$!value'))), nqp::if( # non-zero value nqp::istype($value,Num) && nqp::isnanorinf($value), X::OutOfRange.new( # NaN or -Inf or Inf, we're done @@ -635,14 +661,14 @@ my class Rakudo::QuantHash { elems, (my $which := nqp::getattr($pulled,Pair,'$!key').WHICH) ), - nqp::stmts( # seen before, add value - (my $pair := nqp::atkey(elems,$which)), - nqp::bindattr( - $pair, + nqp::if( # seen before, add value + ($value := nqp::getattr( + (my $pair := nqp::atkey(elems,$which)), Pair, - '$!value', - nqp::getattr($pair,Pair,'$!value') + $value - ) + '$!value' + ) + $value), + nqp::bindattr($pair,Pair,'$!value',$value), # non-zero + nqp::deletekey(elems,$which) # zero ), nqp::bindkey( # new, create new Pair elems, diff --git a/src/core/Range.pm b/src/core/Range.pm index 99f66ca41bb..1a03c826ec3 100644 --- a/src/core/Range.pm +++ b/src/core/Range.pm @@ -124,9 +124,9 @@ my class Range is Cool does Iterable does Positional { class :: does Iterator { has $!i; - method !SET-SELF(\i) { $!i = i; self } + method !SET-SELF(\i) { $!i = i - 1; self } method new(\i) { nqp::create(self)!SET-SELF(i) } - method pull-one() { $!i++ } + method pull-one() { ++$!i } method is-lazy() { True } }.new($!min + $!excludes-min) } diff --git a/src/core/Seq.pm b/src/core/Seq.pm index e5c88ab70de..d7c27fb87aa 100644 --- a/src/core/Seq.pm +++ b/src/core/Seq.pm @@ -24,8 +24,8 @@ my role PositionalBindFailover { ?? $!list !! ($!list := List.from-iterator(self.iterator)) } - method list() { - List.from-iterator(self.iterator) + multi method list(::?CLASS:D:) { + List.from-iterator(self.iterator) } method iterator() { ... } @@ -74,26 +74,16 @@ my class Seq is Cool does Iterable does PositionalBindFailover { ) } - method eager { - List.from-iterator(self.iterator).eager; - } + 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() { self.List.Capture } - method List() { - List.from-iterator(self.iterator) - } - - method Slip() { - Slip.from-iterator(self.iterator) - } - - method Array() { - Array.from-iterator(self.iterator) - } - method elems() { nqp::if( self.is-lazy, diff --git a/src/core/Setty.pm b/src/core/Setty.pm index 9fb98a3a22b..a39419cfadc 100644 --- a/src/core/Setty.pm +++ b/src/core/Setty.pm @@ -1,29 +1,45 @@ my role Setty does QuantHash { has $!elems; # key.WHICH => key + # helper sub to create Set from iterator, check for laziness + sub create-from-iterator(\type, \iterator --> Setty:D) { + nqp::if( + iterator.is-lazy, + Failure.new(X::Cannot::Lazy.new(:action,:what(type.^name))), + nqp::create(type).SET-SELF( + Rakudo::QuantHash.ADD-ITERATOR-TO-SET( + nqp::create(Rakudo::Internals::IterationSet), iterator + ) + ) + ) + } + multi method new(Setty: --> Setty:D) { nqp::create(self) } - multi method new(Setty: +@args --> Setty:D) { + multi method new(Setty: \value --> Setty:D) { nqp::if( - (my $iterator := @args.iterator).is-lazy, - Failure.new(X::Cannot::Lazy.new(:action,:what(self.^name))), + nqp::istype(value,Iterable) && nqp::not_i(nqp::iscont(value)), + create-from-iterator(self, value.iterator), nqp::stmts( - (my $elems := nqp::create(Rakudo::Internals::IterationSet)), - (my $iter := @args.iterator), - nqp::until( - nqp::eqaddr((my $pulled := $iter.pull-one),IterationEnd), - nqp::bindkey($elems,$pulled.WHICH,$pulled) + nqp::bindkey( + (my $elems := nqp::create(Rakudo::Internals::IterationSet)), + value.WHICH, + nqp::decont(value) ), nqp::create(self).SET-SELF($elems) ) ) } + multi method new(Setty: **@args --> Setty:D) { + create-from-iterator(self, @args.iterator) + } + method new-from-pairs(*@pairs --> Setty:D) { nqp::if( (my $iterator := @pairs.iterator).is-lazy, Failure.new(X::Cannot::Lazy.new(:action,:what(self.^name))), nqp::create(self).SET-SELF( Rakudo::QuantHash.ADD-PAIRS-TO-SET( - nqp::create(Rakudo::Internals::IterationSet),$iterator + nqp::create(Rakudo::Internals::IterationSet), $iterator ) ) ) diff --git a/src/core/Str.pm b/src/core/Str.pm index d37ab2c5acd..493447df7bb 100644 --- a/src/core/Str.pm +++ b/src/core/Str.pm @@ -1139,25 +1139,41 @@ my class Str does Stringy { # declared in BOOTSTRAP $/ := nqp::getlexcaller('$/'); {*} } - multi method subst(Str:D: $matcher, $replacement, :global(:$g), - :ii(:$samecase), :ss(:$samespace), :mm(:$samemark), - *%options) { - - # take the fast lane if we can - return Rakudo::Internals.TRANSPOSE(self,$matcher,$replacement) - if nqp::istype($matcher,Str) && nqp::istype($replacement,Str) - && $g - && !$samecase && !$samespace && !$samemark && !%options; - + multi method subst(Str:D: Str:D $original, Str:D $final, *%options) { + nqp::if( + (my $opts := nqp::getattr(%options,Map,'$!storage')) + && nqp::isgt_i(nqp::elems($opts),1), + self!SUBST(nqp::getlexcaller('$/'),$original,$final,|%options), + nqp::if( + nqp::elems($opts), + nqp::if( # one named + nqp::atkey($opts,'g') || nqp::atkey($opts,'global'), + Rakudo::Internals.TRANSPOSE(self, $original, $final), + nqp::if( # no trueish g/global + nqp::existskey($opts,'g') || nqp::existskey($opts,'global'), + Rakudo::Internals.TRANSPOSE-ONE(self, $original, $final), + self!SUBST(nqp::getlexcaller('$/'),$original,$final,|%options) + ) + ), + Rakudo::Internals.TRANSPOSE-ONE(self, $original, $final) # no nameds + ) + ) + } + multi method subst(Str:D: $matcher, $replacement, *%options) { + self!SUBST(nqp::getlexcaller('$/'), $matcher, $replacement, |%options) + } + method !SUBST(Str:D: \caller_dollar_slash, $matcher, $replacement, + :global(:$g), :ii(:$samecase), :ss(:$samespace), :mm(:$samemark), + *%options + ) { X::Str::Subst::Adverb.new(:name($_), :got(%options{$_})).throw if %options{$_} for ; - my $caller_dollar_slash := nqp::getlexcaller('$/'); - my $SET_DOLLAR_SLASH = nqp::istype($matcher, Regex); + my $SET_DOLLAR_SLASH = nqp::istype($matcher, Regex); my $word_by_word = so $samespace || %options || %options; # nothing to do - try $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 @@ -1169,7 +1185,7 @@ my class Str does Stringy { # declared in BOOTSTRAP !! self!APPLY-MATCHES( @matches, $replacement, - $caller_dollar_slash, + caller_dollar_slash, $SET_DOLLAR_SLASH, $word_by_word, $samespace, @@ -2202,33 +2218,11 @@ my class Str does Stringy { # declared in BOOTSTRAP }.new(self)); } - my $enc_type := nqp::hash('utf8',utf8,'utf16',utf16,'utf32',utf32); - my int $is-win = Rakudo::Internals.IS-WIN; - -#?if moar proto method encode(|) {*} - multi method encode(Str:D $encoding = 'utf8', Bool:D :$replacement) { - self.encode($encoding, :replacement($replacement - ?? ($encoding ~~ m:i/^utf/ ?? "\x[FFFD]" !! "?" ) - !! Nil - ), |%_) - } - multi method encode(Str:D $encoding = 'utf8', Str :$replacement, Bool() :$translate-nl = False) { -#?endif -#?if !moar - method encode(Str:D $encoding = 'utf8', Bool() :$translate-nl = False) { -#?endif - my str $enc = Rakudo::Internals.NORMALIZE_ENCODING($encoding); - my $type := nqp::ifnull(nqp::atkey($enc_type,$enc),blob8); - my str $target = self; - if $is-win && $translate-nl { - $target .= subst("\n", "\r\n", :g); - } -#?if moar - return nqp::encoderep(nqp::unbox_s($target), $enc, nqp::unbox_s($replacement), nqp::decont($type.new)) - if $replacement.defined; -#?endif - nqp::encode(nqp::unbox_s($target), $enc, nqp::decont($type.new)) + multi method encode(Str:D $encoding = 'utf8', :$replacement, Bool() :$translate-nl = False) { + Encoding::Registry.find($encoding) + .encoder(:$replacement, :$translate-nl) + .encode-chars(self) } #?if !jvm @@ -2976,7 +2970,7 @@ multi sub infix:(Str:D \a, Str:D \b --> Order:D) { ).throw; ORDER( nqp::unicmp_s( - nqp::unbox_s(a), nqp::unbox_s(b), 15,0,0)) + nqp::unbox_s(a), nqp::unbox_s(b), 85,0,0)) } multi sub infix:(Pair:D \a, Pair:D \b) { (a.key unicmp b.key) || (a.value unicmp b.value) diff --git a/src/core/StrDistance.pm b/src/core/StrDistance.pm index 55ce0691177..0586e12f3c2 100644 --- a/src/core/StrDistance.pm +++ b/src/core/StrDistance.pm @@ -29,16 +29,22 @@ my class StrDistance is Cool { @d[$_][ 0] = $_ for ^@s.end; @d[ 0][$_] = $_ for ^@t.end; - for flat 1..@s.end X 1..@t.end -> $i, $j { - @d[$i][$j] = @s[$i] eq @t[$j] - ?? @d[$i-1][$j-1] # No operation required when eq - !! ( @d[$i-1][$j ], # Deletion - @d[$i ][$j-1], # Insertion - @d[$i-1][$j-1], # Substitution - ).min + 1; + my int $s_elems = @s.elems; + my int $t_elems = @t.elems; + loop (my int $i = 1; $i < $s_elems; $i = $i + 1) { + loop (my int $j = 1; $j < $t_elems; $j = $j + 1) { + @d[$i][$j] = @s[$i] eq @t[$j] + ?? @d[$i-1][$j-1] # No operation required when eq + !! ( @d[$i-1][$j ], # Deletion + @d[$i ][$j-1], # Insertion + @d[$i-1][$j-1], # Substitution + ).min + 1; + } } @d.tail.tail; } } } + +# vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Supply.pm b/src/core/Supply.pm index 8344e01743c..af83f6774b8 100644 --- a/src/core/Supply.pm +++ b/src/core/Supply.pm @@ -573,7 +573,7 @@ my class Supply does Awaitable { ## Coercions ## - method Supply(Supply:) { self } + multi method Supply(Supply:D:) { self } method Channel(Supply:D:) { my $c = Channel.new(); @@ -585,7 +585,7 @@ my class Supply does Awaitable { } my class ConcQueue is repr('ConcBlockingQueue') { } - method list(Supply:D:) { + multi method list(Supply:D:) { gather { my Mu \queue = nqp::create(ConcQueue); my $exception; diff --git a/src/core/ThreadPoolScheduler.pm b/src/core/ThreadPoolScheduler.pm index 9e720ca7899..e1ca4d0ae42 100644 --- a/src/core/ThreadPoolScheduler.pm +++ b/src/core/ThreadPoolScheduler.pm @@ -318,8 +318,6 @@ my class ThreadPoolScheduler does Scheduler { } # This thread pool scheduler will be the default one. -Rakudo::Internals.REGISTER-DYNAMIC: '$*SCHEDULER', { - PROCESS::<$SCHEDULER> = ThreadPoolScheduler.new(); -} +PROCESS::<$SCHEDULER> = ThreadPoolScheduler.new(); # vim: ft=perl6 expandtab sw=4 diff --git a/src/core/Uni.pm b/src/core/Uni.pm index 34078eb9d95..3aee3706c3a 100644 --- a/src/core/Uni.pm +++ b/src/core/Uni.pm @@ -102,7 +102,7 @@ my class NFD is Uni { my class NFC is Uni { method new(|) { - die "Cannot create an NFD directly"; # XXX typed, better message + die "Cannot create an NFC directly"; # XXX typed, better message } method NFC() { self } @@ -110,7 +110,7 @@ my class NFC is Uni { my class NFKD is Uni { method new(|) { - die "Cannot create an NFD directly"; # XXX typed, better message + die "Cannot create an NFKD directly"; # XXX typed, better message } method NFKD() { self } @@ -120,6 +120,6 @@ my class NFKC is Uni { method NFKC() { self } method new(|) { - die "Cannot create an NFD directly"; # XXX typed, better message + die "Cannot create an NFKC directly"; # XXX typed, better message } } diff --git a/src/core/core_prologue.pm b/src/core/core_prologue.pm index dd03f6dc683..ca50af6e114 100644 --- a/src/core/core_prologue.pm +++ b/src/core/core_prologue.pm @@ -25,6 +25,9 @@ my class IterationBuffer is repr('VMArray') { ... } my constant Empty = nqp::p6bindattrinvres(nqp::create(Slip), List, '$!reified', nqp::create(IterationBuffer)); +# We use a sentinel value to mark the end of an iteration. +my constant IterationEnd = nqp::create(Mu); + # To allow passing of nqp::hash without being HLLized, we create a HLL class # with the same low level REPR as nqp::hash. my class Rakudo::Internals::IterationSet is repr('VMHash') { } diff --git a/src/core/io_operators.pm b/src/core/io_operators.pm index fea4e2c6cd0..b34f74ec4c5 100644 --- a/src/core/io_operators.pm +++ b/src/core/io_operators.pm @@ -150,34 +150,21 @@ multi sub indir(IO() $path, &what, :$test!) { multi sub indir(IO() $path, &what, :$d = True, :$r, :$w, :$x) { { # NOTE: we need this extra block so that the IO() coercer doesn't # use our (empty at the time) $*CWD when making the IO::Path object - - nqp::if( - nqp::stmts( - nqp::unless( - nqp::unless(nqp::isfalse($d), $path.d), - fail X::IO::Chdir.new: :$path, :os-error( - nqp::if($path.e, 'is not a directory', 'does not exist') - ) - ), - nqp::unless( - nqp::unless(nqp::isfalse($r), $path.r), - fail X::IO::Chdir.new: :$path, - :os-error("did not pass :r test") - ), - nqp::unless( - nqp::unless(nqp::isfalse($w), $path.w), - fail X::IO::Chdir.new: :$path, - :os-error("did not pass :w test") - ), - nqp::unless( - nqp::unless(nqp::isfalse($x), $path.x), - fail X::IO::Chdir.new: :$path, - :os-error("did not pass :x test") - ), - my $*CWD = $path, - ), - what - ) + nqp::stmts( + $d && nqp::isfalse($path.d) && X::IO::Chdir.new( + :$path, :os-error( + $path.e ?? 'is not a directory' !! 'does not exist')).fail, + $r && nqp::isfalse($path.r) && X::IO::Chdir.new( + :$path, :os-error("did not pass :r test")).fail, + $w && nqp::isfalse($path.w) && X::IO::Chdir.new( + :$path, :os-error("did not pass :w test")).fail, + $x && nqp::isfalse($path.x) && X::IO::Chdir.new( + :$path, :os-error("did not pass :x test")).fail, + # $*CWD gets stringified with .Str in IO::Path.new, so we need to + # ensure it's set to an absolute path + my $*CWD = $path.WHAT.new: $path.absolute, + :SPEC($path.SPEC), :CWD($path.SPEC.rootdir)) + && what } } diff --git a/src/core/set_operators.pm b/src/core/set_operators.pm index deea6b189f3..01ce284298d 100644 --- a/src/core/set_operators.pm +++ b/src/core/set_operators.pm @@ -46,7 +46,7 @@ only sub infix:<∈>($a, $b --> Bool:D) is pure { } # U+2209 NOT AN ELEMENT OF only sub infix:<∉>($a, $b --> Bool:D) is pure { - $a !(elem) $b; + not $a (elem) $b; } only sub infix:<(cont)>($a, $b --> Bool:D) is pure { $b (elem) $a } @@ -777,29 +777,46 @@ multi sub infix:<<(<=)>>(Baggy:D $a, Baggy:D $b --> Bool:D) { ) } multi sub infix:<<(<=)>>(Map:D $a, Map:D $b --> Bool:D) { - # don't need to check for object hashes, just checking keys is ok - nqp::stmts( - nqp::unless( - nqp::eqaddr(nqp::decont($a),nqp::decont($b)), - nqp::if( - (my $araw := nqp::getattr(nqp::decont($a),Map,'$!storage')) - && nqp::elems($araw), - nqp::if( # number of elems in B *always* >= A - (my $braw := nqp::getattr(nqp::decont($b),Map,'$!storage')) - && nqp::isle_i(nqp::elems($araw),nqp::elems($braw)) - && (my $iter := nqp::iterator($araw)), - nqp::while( # number of elems in B >= A - $iter, - nqp::unless( - nqp::existskey($braw,nqp::iterkey_s(nqp::shift($iter))), - return False # elem in A doesn't exist in B - ) + nqp::if( + nqp::eqaddr(nqp::decont($a),nqp::decont($b)), + True, # B is alias of A + nqp::if( # A and B are different + (my $araw := nqp::getattr(nqp::decont($a),Map,'$!storage')) + && nqp::elems($araw), + nqp::if( # something in A + nqp::eqaddr($a.keyof,Str(Any)) && nqp::eqaddr($b.keyof,Str(Any)), + nqp::if( # both are normal Maps + (my $iter := nqp::iterator($araw)) + && (my $braw := nqp::getattr(nqp::decont($b),Map,'$!storage')) + && nqp::elems($braw), + nqp::stmts( # something to check for in B + nqp::while( + $iter, + nqp::if( + nqp::iterval(nqp::shift($iter)), + nqp::unless( # valid in A + nqp::atkey($braw,nqp::iterkey_s($iter)), + return False # valid elem in A isn't valid elem in B + ) + ) + ), + True # all valids in A occur as valids in B ), - return False # number of elems in B smaller than A - ) - ) - ), - True + nqp::stmts( # nothing to check for in B + nqp::while( + $iter, + nqp::if( + nqp::iterval(nqp::shift($iter)), + return False # valid in elem in A (and none in B) + ) + ), + True # no valid elems in A + ) + ), + $a.Set (<=) $b.Set # either is objectHash, so coerce + ), + True # nothing in A + ) ) } multi sub infix:<<(<=)>>(Any $a, Any $b --> Bool:D) { @@ -842,7 +859,7 @@ multi sub infix:<<(<)>>(Setty:D $a, Setty:D $b --> Bool:D) { ), False # number of elems in B smaller or equal to A ), - True, # no elems in A, and elems in B + True # no elems in A, and elems in B ), False # can never have fewer elems in A than in B ) @@ -954,30 +971,49 @@ multi sub infix:<<(<)>>(Baggy:D $a, Baggy:D $b --> Bool:D) { ) } multi sub infix:<<(<)>>(Map:D $a, Map:D $b --> Bool:D) { - # don't need to check for object hashes, just checking keys is ok nqp::if( nqp::eqaddr(nqp::decont($a),nqp::decont($b)), - False, # X is never a true subset of itself - nqp::if( - (my $braw := nqp::getattr(nqp::decont($b),Map,'$!storage')) - && nqp::elems($braw), - nqp::if( - (my $araw := nqp::getattr(nqp::decont($a),Map,'$!storage')) - && nqp::islt_i(nqp::elems($araw),nqp::elems($braw)) - && (my $iter := nqp::iterator($araw)), - nqp::stmts( # A has fewer elems than B + False, # X is never a true subset of itself + nqp::if( # A and B are different + (my $araw := nqp::getattr(nqp::decont($a),Map,'$!storage')) + && nqp::elems($araw), + nqp::if( # something in A + nqp::eqaddr($a.keyof,Str(Any)) && nqp::eqaddr($b.keyof,Str(Any)), + nqp::if( # both are normal Maps + (my $braw := nqp::getattr(nqp::decont($b),Map,'$!storage')) + && nqp::elems($braw) + && (my $iter := nqp::iterator($araw)), + nqp::stmts( # something to check for in B + nqp::while( + $iter, + nqp::if( + nqp::iterval(nqp::shift($iter)) + || nqp::isfalse(nqp::atkey($braw,nqp::iterkey_s($iter))), + return False # valid elem in A or invalid elem in B + ) + ), + True # no valids in A, valids in B + ), + False # something in A, nothing in B + ), + $a.Set (<) $b.Set # either is objectHash, so coerce + ), + nqp::if( # nothing in A + ($braw := nqp::getattr(nqp::decont($b),Map,'$!storage')) + && nqp::elems($braw) + && ($iter := nqp::iterator($braw)), + nqp::stmts( # something in B nqp::while( $iter, - nqp::unless( - nqp::existskey($braw,nqp::iterkey_s(nqp::shift($iter))), - return False # elem in A doesn't exist in B + nqp::if( + nqp::iterval(nqp::shift($iter)), + return True # found valid elem in B ) ), - True # all elems in A exist in B + False # no valid elem in B ), - False # number of elems in B smaller or equal to A - ), - False # can never have fewer elems in A than in B + False # nothing in B (nor A) + ) ) ) } @@ -1031,9 +1067,8 @@ multi sub infix:<(.)>(Any $a) { $a.Bag } multi sub infix:<(.)>(Setty:D $a, Setty:D $b) { nqp::if( (my $elems := $a.Bag.raw_hash) && nqp::elems($elems), - nqp::stmts( + nqp::create(Bag).SET-SELF( Rakudo::QuantHash.MULTIPLY-SET-TO-BAG($elems,$b.raw_hash), - nqp::create(Bag).SET-SELF($elems) ), bag() ) @@ -1057,9 +1092,8 @@ multi sub infix:<(.)>(Baggy:D $a, Baggy:D $b) { nqp::if( (my $elems := Rakudo::QuantHash.BAGGY-CLONE-RAW($a.raw_hash)) && nqp::elems($elems), - nqp::stmts( + nqp::create(Bag).SET-SELF( Rakudo::QuantHash.MULTIPLY-BAG-TO-BAG($elems,$b.raw_hash), - nqp::create(Bag).SET-SELF($elems) ), bag() ) @@ -1107,13 +1141,14 @@ multi sub infix:<(+)>(MixHash:D $a) { $a.Mix } multi sub infix:<(+)>(Any $a) { $a.Bag } multi sub infix:<(+)>(Setty:D $a, Setty:D $b) { - nqp::stmts( + nqp::create(Bag).SET-SELF( Rakudo::QuantHash.ADD-SET-TO-BAG( - (my $elems := nqp::create(Rakudo::Internals::IterationSet)), - $a.raw_hash - ), - Rakudo::QuantHash.ADD-SET-TO-BAG($elems,$b.raw_hash), - nqp::create(Bag).SET-SELF($elems) + Rakudo::QuantHash.ADD-SET-TO-BAG( + nqp::create(Rakudo::Internals::IterationSet), + $a.raw_hash + ), + $b.raw_hash + ) ) } @@ -1131,13 +1166,14 @@ 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:<(+)>(Baggy:D $a, Mixy:D $b) { infix:<(+)>($a.Mix, $b) } multi sub infix:<(+)>(Baggy:D $a, Baggy:D $b) { - nqp::stmts( + nqp::create(Bag).SET-SELF( Rakudo::QuantHash.ADD-BAG-TO-BAG( - (my $elems := nqp::create(Rakudo::Internals::IterationSet)), - $a.raw_hash - ), - Rakudo::QuantHash.ADD-BAG-TO-BAG($elems,$b.raw_hash), - nqp::create(Bag).SET-SELF($elems) + Rakudo::QuantHash.ADD-BAG-TO-BAG( + nqp::create(Rakudo::Internals::IterationSet), + $a.raw_hash + ), + $b.raw_hash + ) ) } multi sub infix:<(+)>(Any:D $a, Any:D $b) { $a.Bag (+) $b.Bag } diff --git a/src/core/stubs.pm b/src/core/stubs.pm index 5e58739a649..5eb0db9d7ca 100644 --- a/src/core/stubs.pm +++ b/src/core/stubs.pm @@ -29,25 +29,27 @@ my class Lock is repr('ReentrantMutex') { ... } sub DYNAMIC(\name) is raw { nqp::ifnull( - nqp::getlexdyn(nqp::unbox_s(name)), + nqp::getlexdyn(name), nqp::stmts( nqp::unless( nqp::isnull(my $prom := nqp::getlexdyn('$*PROMISE')), (my Mu $x := nqp::getlexreldyn( - nqp::getattr($prom,Promise,'$!dynamic_context'),nqp::unbox_s(name)) + nqp::getattr($prom,Promise,'$!dynamic_context'),name) ) ), - nqp::if( - nqp::isnull($x), + nqp::ifnull( + $x, nqp::stmts( - (my str $pkgname = nqp::replace(nqp::unbox_s(name),1,1,'')), - ($x := nqp::ifnull(nqp::atkey(GLOBAL.WHO,$pkgname), - nqp::ifnull(nqp::atkey(PROCESS.WHO,$pkgname), - Rakudo::Internals.INITIALIZE-DYNAMIC(nqp::unbox_s(name)))) + (my str $pkgname = nqp::replace(name,1,1,'')), + nqp::ifnull( + nqp::atkey(GLOBAL.WHO,$pkgname), + nqp::ifnull( + nqp::atkey(PROCESS.WHO,$pkgname), + Rakudo::Internals.INITIALIZE-DYNAMIC(name) + ) ) ) - ), - $x + ) ) ) } diff --git a/src/perl6-debug.nqp b/src/perl6-debug.nqp index 90e3cfbc329..11df6fb85ed 100644 --- a/src/perl6-debug.nqp +++ b/src/perl6-debug.nqp @@ -5,24 +5,24 @@ use Perl6::Compiler; class Perl6::DebugHooks { has %!hooks; has $!suspended; - + method set_hook($name, $callback) { $*W.add_object($callback); %!hooks{$name} := $callback; } - + method has_hook($name) { !$!suspended && nqp::existskey(%!hooks, $name) } - + method get_hook($name) { %!hooks{$name} } - + method suspend() { $!suspended := 1 } - + method unsuspend() { $!suspended := 0 } @@ -54,7 +54,7 @@ class Perl6::HookRegexActions is Perl6::RegexActions { } Perl6::RegexActions.nibbler($/); } - + method quantified_atom($/) { Perl6::RegexActions.quantified_atom($/); my $qa := $/.ast; @@ -109,7 +109,7 @@ class QRegex::P5Regex::HookActions is Perl6::P5RegexActions { } QRegex::P5Regex::Actions.nibbler($/); } - + method quantified_atom($/) { QRegex::P5Regex::Actions.quantified_atom($/); my $qa := $/.ast; @@ -172,7 +172,7 @@ class Perl6::HookActions is Perl6::Actions { } $accept } - + method statement($/) { Perl6::Actions.statement($/); if $*ST_DEPTH <= 1 && $ && interesting_expr($) { @@ -195,7 +195,7 @@ class Perl6::HookActions is Perl6::Actions { } } } - + method statement_control:sym($/) { if $*DEBUG_HOOKS.has_hook('statement_cond') { my $from := $[0].from; @@ -218,7 +218,7 @@ class Perl6::HookActions is Perl6::Actions { } Perl6::Actions.statement_control:sym($/); } - + sub simple_xblock_hook($/) { if $*DEBUG_HOOKS.has_hook('statement_cond') { my $stmt := $/.ast; @@ -236,17 +236,17 @@ class Perl6::HookActions is Perl6::Actions { ); } } - + method statement_control:sym($/) { Perl6::Actions.statement_control:sym($/); simple_xblock_hook($/); } - + method statement_control:sym($/) { Perl6::Actions.statement_control:sym($/); simple_xblock_hook($/); } - + method statement_control:sym($/) { Perl6::Actions.statement_control:sym($/); if $*DEBUG_HOOKS.has_hook('statement_cond') { @@ -267,7 +267,7 @@ class Perl6::HookActions is Perl6::Actions { ); } } - + method statement_control:sym($/) { if $*DEBUG_HOOKS.has_hook('statement_cond') { for -> $expr { @@ -289,7 +289,7 @@ class Perl6::HookActions is Perl6::Actions { } Perl6::Actions.statement_control:sym($/); } - + sub widen_expr_from($e) { my $from := $e.from; for @($e) { @@ -299,7 +299,7 @@ class Perl6::HookActions is Perl6::Actions { } $from } - + sub widen_expr_to($e) { my $to := $e.to; for @($e) { @@ -309,22 +309,22 @@ class Perl6::HookActions is Perl6::Actions { } $to } - + method statement_control:sym($/) { Perl6::Actions.statement_control:sym($/); simple_xblock_hook($/); } - + method statement_control:sym($/) { Perl6::Actions.statement_control:sym($/); simple_xblock_hook($/); } - + method statement_control:sym($/) { Perl6::Actions.statement_control:sym($/); simple_xblock_hook($/); } - + method statement_control:sym($/) { Perl6::Actions.statement_control:sym($/); if $*DEBUG_HOOKS.has_hook('statement_simple') { @@ -341,14 +341,14 @@ class Perl6::HookActions is Perl6::Actions { )); } } - + sub routine_hook($/, $body, $type, $name) { if $*DEBUG_HOOKS.has_hook('routine_region') { my $file := nqp::getlexcaller('$?FILES') // $*ANON_CODE_NAME; $*DEBUG_HOOKS.get_hook('routine_region')($file, $/.from, $/.to, $type, $name); } } - + method routine_declarator:sym($/) { Perl6::Actions.routine_declarator:sym($/); routine_hook($/, $, 'sub', @@ -373,7 +373,7 @@ class Perl6::HookActions is Perl6::Actions { class Perl6::HookGrammar is Perl6::Grammar { my %seen_files; - + method statementlist($*statement_level = 0) { my $file := nqp::getlexcaller('$?FILES') // $*ANON_CODE_NAME; unless nqp::existskey(%*SEEN_FILES, $file) { @@ -389,11 +389,11 @@ class Perl6::HookGrammar is Perl6::Grammar { Perl6::Grammar.HOW.find_method(Perl6::Grammar, 'statementlist')(self, $*statement_level) } } - + method comp_unit() { my $*ST_DEPTH := 0; my %*SEEN_FILES; - + # Fiddle the %*LANG for the appropriate actions. %*LANG := Perl6::HookRegexGrammar; %*LANG := Perl6::HookRegexActions; @@ -401,18 +401,15 @@ class Perl6::HookGrammar is Perl6::Grammar { %*LANG := QRegex::P5Regex::HookActions; %*LANG
:= Perl6::HookGrammar; %*LANG := Perl6::HookActions; - self.define_slang('MAIN',Perl6::HookGrammar, Perl6::HookActions); - self.define_slang('Regex',Perl6::HookRegexGrammar, Perl6::HookRegexActions); - self.define_slang('P5Regex',Perl6::HookP5RegexGrammar, Perl6::HookP5RegexActions); - + Perl6::Grammar.HOW.find_method(Perl6::Grammar, 'comp_unit')(self) } - + method blockoid() { my $*ST_DEPTH := 0; Perl6::Grammar.HOW.find_method(Perl6::Grammar, 'blockoid')(self) } - + method semilist() { my $cur_st_depth := $*ST_DEPTH; { @@ -420,7 +417,7 @@ class Perl6::HookGrammar is Perl6::Grammar { Perl6::Grammar.HOW.find_method(Perl6::Grammar, 'semilist')(self) } } - + method comment:sym<#>() { my $c := Perl6::Grammar.HOW.find_method(Perl6::Grammar, 'comment:sym<#>')(self); if $c { @@ -452,7 +449,7 @@ sub MAIN(*@ARGS) { if nqp::islist(@ARGS[0]) { @ARGS := @ARGS[0]; } - + # Initialize dynops. nqp::p6init(); @@ -466,17 +463,18 @@ sub MAIN(*@ARGS) { hll-config($comp.config); my $COMPILER_CONFIG := $comp.config; nqp::bindhllsym('perl6', '$COMPILER_CONFIG', $comp.config); - + # Add extra command line options. my @clo := $comp.commandline_options(); @clo.push('setting=s'); @clo.push('c'); @clo.push('I=s'); @clo.push('M=s'); + @clo.push('nqp-lib=s'); # Set up module loading trace my @*MODULES := []; - + # Set up END block list, which we'll run at exit. nqp::bindhllsym('perl6', '@END_PHASERS', []); @@ -506,7 +504,7 @@ sub MAIN(*@ARGS) { # Enter the compiler. $comp.command_line(@ARGS, :encoding('utf8'), :transcode('ascii iso-8859-1')); - + # Run any END blocks before exiting. for nqp::gethllsym('perl6', '@END_PHASERS') { my $result := $_(); diff --git a/src/vm/moar/Perl6/Ops.nqp b/src/vm/moar/Perl6/Ops.nqp index b255ea6657d..d3f292acae1 100644 --- a/src/vm/moar/Perl6/Ops.nqp +++ b/src/vm/moar/Perl6/Ops.nqp @@ -272,22 +272,11 @@ $ops.add_hll_op('perl6', 'p6bindattrinvres', -> $qastcomp, $op { $ops.add_hll_moarop_mapping('perl6', 'p6finddispatcher', 'p6finddispatcher'); $ops.add_hll_moarop_mapping('perl6', 'p6argsfordispatcher', 'p6argsfordispatcher'); $ops.add_hll_moarop_mapping('perl6', 'p6decodelocaltime', 'p6decodelocaltime'); -#$ops.map_classlib_hll_op('perl6', 'tclc', $TYPE_P6OPS, 'tclc', [$RT_STR], $RT_STR, :tc); $ops.add_hll_moarop_mapping('perl6', 'p6staticouter', 'p6staticouter'); my $p6bool := -> $qastcomp, $op { - # Having a Var with a lexicalref scope isn't uncommon, so we make extra - # sure we do a fast lexical access instead of creating a LexicalRef obj - # and going through that. + # We never want a container here, so mark as decont context. my @ops; - my $exprres; - my $want := $MVM_reg_obj; - if nqp::istype($op[0], QAST::Var) && $op[0].scope eq 'lexicalref' { - my $spec := nqp::objprimspec($op[0].returns); - if $spec == 1 { $want := $MVM_reg_int64 } - elsif $spec == 2 { $want := $MVM_reg_num64 } - elsif $spec == 3 { $want := $MVM_reg_str } - } - $exprres := $qastcomp.as_mast($op[0], :want($want)); + my $exprres := $qastcomp.as_mast($op[0], :want-decont); push_ilist(@ops, $exprres); # Go by result kind. @@ -672,7 +661,7 @@ $ops.add_hll_op('perl6', 'p6decontrv', -> $qastcomp, $op { } else { my @ops; - my $value_res := $qastcomp.as_mast($op[1], :want($MVM_reg_obj)); + my $value_res := $qastcomp.as_mast($op[1], :want($MVM_reg_obj), :want-decont); push_ilist(@ops, $value_res); nqp::push(@ops, MAST::ExtOp.new( :op('p6decontrv'), :cu($qastcomp.mast_compunit), $value_res.result_reg, $value_res.result_reg )); diff --git a/src/vm/moar/ops/perl6_ops.c b/src/vm/moar/ops/perl6_ops.c index bd3a00188a6..2d737001430 100644 --- a/src/vm/moar/ops/perl6_ops.c +++ b/src/vm/moar/ops/perl6_ops.c @@ -366,8 +366,12 @@ static void p6decontrv(MVMThreadContext *tc, MVMuint8 *cur_op) { static void p6decontrv_spesh(MVMThreadContext *tc, MVMSpeshGraph *g, MVMSpeshBB *bb, MVMSpeshIns *ins) { /* If it's already deconted, can just become a set. */ MVMSpeshFacts *obj_facts = MVM_spesh_get_and_use_facts(tc, g, ins->operands[1]); - if (obj_facts->flags & (MVM_SPESH_FACT_DECONTED | MVM_SPESH_FACT_TYPEOBJ)) + if (obj_facts->flags & (MVM_SPESH_FACT_DECONTED | MVM_SPESH_FACT_TYPEOBJ)) { + MVMSpeshFacts *res_facts = MVM_spesh_get_facts(tc, g, ins->operands[0]); ins->info = MVM_op_get_op(MVM_OP_set); + res_facts->flags = obj_facts->flags; + res_facts->type = obj_facts->type; + } } static MVMuint8 s_p6capturelex[] = { diff --git a/t/05-messages/01-errors.t b/t/05-messages/01-errors.t index aa5e778c224..9348926fc75 100644 --- a/t/05-messages/01-errors.t +++ b/t/05-messages/01-errors.t @@ -196,6 +196,26 @@ throws-like { Blob.splice }, X::Multi::NoMatch, :message{ .contains: 'only the proto' & none 'none of these signatures' }, 'error points out only only proto is defined (Blob.splice)'; +# RT #127395, #123078 +{ + throws-like q| class RT123078_1 { method foo { self.bar }; method !bar { }; method baz { } }; RT123078_1.new.foo |, + X::Method::NotFound, + message => all(/<<"No such method 'bar'" \W/, /<<'RT123078_1'>>/, /\W '!bar'>>/, /<<'baz'>>/), + 'a private method of the same name as the public missing method is suggested'; + throws-like q| class RT123078_2 { method foo { self!bar }; method bar { }; method baz { } }; RT123078_2.new.foo |, + X::Method::NotFound, + message => all(/<<"No such private method '!bar'" \W/, /<<'RT123078_2'>>/, /<<'bar'>>/, /<<'baz'>>/), + 'a public method of the same name as the missing private method is suggested'; + throws-like q| .uniq |, + X::Method::NotFound, + message => all(/<<"No such method 'uniq'" \W/, /<<'unique'>>/), + 'potentially common misspelling gives the right suggestion'; + throws-like q| ‘foo’.starts-wizh(‘f’) |, + X::Method::NotFound, + message => all(/<<"No such method 'starts-wizh'" \W/, /<<'starts-with'>>/), + 'longer method names are suggested also'; +} + done-testing; # vim: ft=perl6 expandtab sw=4 diff --git a/t/spectest.data b/t/spectest.data index 14145e53e26..eca677601fd 100644 --- a/t/spectest.data +++ b/t/spectest.data @@ -218,6 +218,7 @@ S03-operators/comparison-simple.t S03-operators/comparison.t S03-operators/context-forcers.t S03-operators/context.t +S03-operators/difference.t S03-operators/elem.t S03-operators/equality.t S03-operators/eqv.t @@ -313,7 +314,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 @@ -811,6 +811,7 @@ 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 @@ -962,6 +963,8 @@ 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 diff --git a/tools/build/NQP_REVISION b/tools/build/NQP_REVISION index b2d86650110..ea51e5d1525 100644 --- a/tools/build/NQP_REVISION +++ b/tools/build/NQP_REVISION @@ -1 +1 @@ -2017.05-152-gc8916bc5a +2017.06-3-g0b45398 diff --git a/tools/build/jvm_core_sources b/tools/build/jvm_core_sources index bd0d7c68ce7..4edc7ea4367 100644 --- a/tools/build/jvm_core_sources +++ b/tools/build/jvm_core_sources @@ -44,8 +44,15 @@ src/core/Order.pm src/core/UInt64.pm src/core/Num.pm src/core/Buf.pm +src/core/Encoding/Decoder.pm +src/core/Encoding/Decoder/Builtin.pm +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/Str.pm -src/core/Rakudo/Internals/VMBackedDecoder.pm src/core/Capture.pm src/core/IterationBuffer.pm src/core/HyperConfiguration.pm @@ -149,10 +156,11 @@ src/core/IO/Socket.pm src/core/IO/Socket/INET.pm src/core/IO/Socket/Async.pm src/core/Proc.pm +src/core/signals.pm +src/core/Proc/Async.pm src/core/Systemic.pm src/core/VM.pm src/core/Distro.pm -src/core/signals.pm src/core/Kernel.pm src/core/Compiler.pm src/core/Perl.pm diff --git a/tools/build/moar_core_sources b/tools/build/moar_core_sources index 4a0fd6ad061..c27dcdf26bb 100644 --- a/tools/build/moar_core_sources +++ b/tools/build/moar_core_sources @@ -46,8 +46,15 @@ src/core/Num.pm src/core/Buf.pm src/core/Uni.pm src/core/Collation.pm +src/core/Encoding/Decoder.pm +src/core/Encoding/Decoder/Builtin.pm +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/Str.pm -src/core/Rakudo/Internals/VMBackedDecoder.pm src/core/Capture.pm src/core/IterationBuffer.pm src/core/HyperConfiguration.pm diff --git a/tools/contributors.pl6 b/tools/contributors.pl6 index b45f46c926d..5b5c35152f4 100644 --- a/tools/contributors.pl6 +++ b/tools/contributors.pl6 @@ -32,7 +32,8 @@ sub MAIN ( say "Contributors to Rakudo since the release on $last_release:"; my @contributors = @repos.map({ |get-committers($_,$last_release) - }).unique(:as(*.key))».value.Bag.sort(*.value).reverse».key; + }).unique(:as(*.key))».value.Bag.sort(-*.value)».key; + @contributors .= rotate if @contributors.head eq 'Zoffix Znet'; for @contributors -> $name is rw { state $length = 0;