Commit 356d756d authored by Alessandro Ghedini's avatar Alessandro Ghedini

Imported Upstream version 2013.12

parent 712396c6
......@@ -83,6 +83,7 @@ MAIN: {
$default_backend ||= $b;
}
}
$backends{parrot} = 1 if exists $options{'gen-parrot'};
unless (%backends) {
die "No suitable nqp executables found! Please specify some --backends, or a --prefix that contains nqp-{p,j} executables\n";
}
......
This diff is collapsed.
New in 2013.12
+ The Whatever Star now works inside chain operators like comparisons
+ Private attributes from roles are now visible in the classes they apply to
+ Use invokedynamic in some places on the JVM.
+ Memory improvements in ListIter
+ Faster method List.combinations
+ Simple lookahead assertions in regexes are optimized
+ Regexes do less superfluous scanning
New in 2013.11
+ Many concurrency primitives harmonized with new S17, but still pretty fluid
......
......@@ -60,19 +60,20 @@ Built-ins/Data Structures
3 *** Cat and stream matching
Language Features
1 *** basic Perl 5 interop (use, eval, etc.)
1 *** basic Perl 5 interop (use, eval, etc.) (diakopter)
2 * $=DATA and friends (tadzik)
2 ** module versioning
2 ** module versioning (lizmat,FROGGS)
2 ** missing bits of enums
2 *** new syntax/semantics for coercion (jnthn)
2 ** MAIN and USAGE (japhb)
2 ** Failure changes (japhb)
2 *** coercion types
2 * tr///
2 ** 'no strict;'
3 *** domain specific languages -- slang and grammar tweaks
3 **** more advanced Perl 5 interop (lexical embedding, etc.)
3 ? Parse and execute simple Perl 5 code
2 ** 'no strict;' (moritz,FROGGS)
3 *** domain specific languages -- slang and grammar tweaks (FROGGS)
3 **** more advanced Perl 5 interop (lexical embedding, etc.) (FROGGS)
3 ? Parse and execute simple Perl 5 code (FROGGS)
2 ** label handling using goto, next, last ...
Optimizer (jnthn)
2 ** ro/rw variable tracking, related transforms
......
# Announce: Rakudo Perl 6 compiler, Development Release #71 ("Advent")
On behalf of the Rakudo development team, I'm happy to announce the
December 2013 release of Rakudo Perl #71 "Advent". Rakudo is an
implementation of Perl 6 on the Parrot Virtual Machine and the Java Virtual
Machine. The tarball for this release is available from
<http://rakudo.org/downloads/rakudo/>.
Please note: This announcement is not for the Rakudo Star
distribution[^1] --- it's announcing a new release of the compiler
only. For the latest Rakudo Star release, see
<http://rakudo.org/downloads/star/>.
The Rakudo Perl compiler follows a monthly release cycle, with each
release named after a Perl Mongers group. The December 2013 release is
code-named after Advent, the non-geographical group which fits this time of
year.
Some of the changes in this release are outlined below:
+ The Whatever Star now works inside chain operators like comparisons
+ Private attributes from roles are now visible in the classes they apply to
+ Use invokedynamic in some places on the JVM.
+ Memory improvements in ListIter
+ Faster method List.combinations
+ Simple lookahead assertions in regexes are optimized
+ Regexes do less superfluous scanning
These are only some of the changes in this release. For a more
detailed list, see "docs/ChangeLog".
The development team thanks all of our contributors and sponsors for
making Rakudo Perl possible, as well as those people who worked on
Parrot, the Perl 6 test suite and the specification.
The following people contributed to this release:
Elizabeth Mattijsen, Timo Paulssen, Jonathan Worthington, Moritz Lenz, Tobias Leich, Larry Wall, Carl Mäsak
If you would like to contribute, see <http://rakudo.org/how-to-help>,
ask on the <perl6-compiler@perl.org> mailing list, or ask on IRC
\#perl6 on freenode.
The next release of Rakudo (#72), is scheduled for January 23, 2014.
A list of the other planned release dates and code names for future
releases is available in the "docs/release_guide.pod" file. A Rakudo
development release typically occurs a few days (often two) after the
third Tuesday of each month.
On behalf of the development team, I encourage you to try the new release,
step out of your comfort zone, and get a library card.
[^1]: What's the difference between the Rakudo compiler and the Rakudo
Star distribution?
The Rakudo compiler is a compiler for the Perl 6 language.
Nothing else.
The Rakudo Star distribution is the Rakudo compiler plus a selection
of useful Perl 6 modules, a module installer, the most recent
incarnation of the "Using Perl 6" book, and other software that can
be used with the Rakudo compiler to enhance its utility. Rakudo Star
is meant for early adopters who wish to explore what's possible with
Rakudo Perl 6 and provide feedback on what works, what doesn't, and
what else they would like to see included in the distribution.
=encoding UTF-8
=head1 release_guide.pod - guide to Rakudo releases
Rakudo's development release cycle is based on Parrot's release cycle.
......@@ -15,8 +17,7 @@ end of this document.
Releases are typically on the third Thursday of each month.
2013-12-19 Rakudo #71
2014-01-23 Rakudo #72
2014-01-23 Rakudo #72 masak
2014-02-20 Rakudo #73
2014-03-20 Rakudo #74
2014-04-17 Rakudo #75
......@@ -295,6 +296,7 @@ You're done! Celebrate with the appropriate amount of fun.
2013-09-19 Rakudo #68 "Shanghai" (masak)
2013-10-17 Rakudo #69 "Roederbergweg" (Coke)
2013-11-21 Rakudo #70 "Malmö" (lizmat)
2013-12-19 Rakudo #71 "Advent" (moritz)
=head1 COPYRIGHT
......
......@@ -1667,9 +1667,9 @@ class Perl6::Actions is HLL::Actions does STDActions {
unless $*HAS_SELF {
$*W.throw($/, ['X', 'Syntax', 'NoSelf'], variable => $past.name());
}
my $attr := get_attribute_meta_object($/, $past.name());
my $attr := get_attribute_meta_object($/, $past.name(), $past);
$past.returns($attr.type) if $attr;
$past.scope('attribute');
$past.returns($attr.type);
$past.unshift(instantiated_type(['$?CLASS'], $/));
$past.unshift(QAST::Var.new( :name('self'), :scope('lexical') ));
}
......@@ -1759,7 +1759,7 @@ class Perl6::Actions is HLL::Actions does STDActions {
$past
}
sub get_attribute_meta_object($/, $name) {
sub get_attribute_meta_object($/, $name, $later?) {
unless nqp::can($*PACKAGE.HOW, 'get_attribute_for_usage') {
$/.CURSOR.panic("Cannot understand $name in this context");
}
......@@ -1770,12 +1770,26 @@ class Perl6::Actions is HLL::Actions does STDActions {
$found := 1;
}
unless $found {
$*W.throw($/, ['X', 'Attribute', 'Undeclared'],
symbol => $name,
package-kind => $*PKGDECL,
package-name => $*PACKAGE.HOW.name($*PACKAGE),
what => 'attribute',
);
# need to check later
if $later {
my $seen := %*ATTR_USAGES{$name};
unless $seen {
%*ATTR_USAGES{$name} := $seen := nqp::list();
$later.node($/); # only need $/ for first error
}
$seen.push($later);
}
# now is later
else {
$*W.throw($/, ['X', 'Attribute', 'Undeclared'],
symbol => $name,
package-kind => $*PKGDECL,
package-name => $*PACKAGE.HOW.name($*PACKAGE),
what => 'attribute',
);
}
}
$attr
}
......@@ -1902,6 +1916,17 @@ class Perl6::Actions is HLL::Actions does STDActions {
$*W.create_signature(nqp::hash('parameters', [])));
}
# check up any private attribute usage
for %*ATTR_USAGES {
my $name := $_.key;
my @usages := $_.value;
for @usages {
my $past := $_;
my $attr := get_attribute_meta_object($past.node, $name);
$past.returns($attr.type);
}
}
# Document
Perl6::Pod::document($/, $*PACKAGE, $*DOC);
......@@ -3686,7 +3711,7 @@ class Perl6::Actions is HLL::Actions does STDActions {
# If it's !-twigil'd, ensure the attribute it mentions exists unless
# we're in a context where we should not do that.
if $_<bind_attr> && !$no_attr_check {
get_attribute_meta_object($/, $_<variable_name>);
get_attribute_meta_object($/, $_<variable_name>, QAST::Var.new);
}
# If we have a sub-signature, create that.
......@@ -5973,7 +5998,7 @@ class Perl6::Actions is HLL::Actions does STDActions {
my $curried :=
# It must be an op and...
nqp::istype($past, QAST::Op) && (
# Either a call that we're allowed to curry...
(($past.op eq 'call' || $past.op eq 'chain') &&
(nqp::index($past.name, '&infix:') == 0 ||
......@@ -5982,7 +6007,7 @@ class Perl6::Actions is HLL::Actions does STDActions {
(nqp::istype($past[0], QAST::Op) &&
nqp::index($past[0].name, '&METAOP') == 0)) &&
%curried{$past.name} // 2)
# Or not a call and an op in the list of alloweds.
|| ($past.op ne 'call' && %curried{$past.op} // 0)
......@@ -6002,33 +6027,51 @@ class Perl6::Actions is HLL::Actions does STDActions {
$i++;
}
if $whatevers {
my $was_chain := $past.op eq 'chain' ?? $past.name !! NQPMu;
my int $i := 0;
my @params;
my @old_args;
my $block := QAST::Block.new(QAST::Stmts.new(), $past);
$*W.cur_lexpad()[0].push($block);
while $i < $upto_arity {
my $old := $past[$i];
$old := $old[0] if (nqp::istype($old, QAST::Stmts) ||
$old := $old[0] if (nqp::istype($old, QAST::Stmts) ||
nqp::istype($old, QAST::Stmt)) &&
+@($old) == 1;
if istype($old.returns, $WhateverCode) {
my $new := QAST::Op.new( :op<call>, :node($/), $old);
my $acount := 0;
while $acount < $old.arity {
my $pname := '$x' ~ (+@params);
@params.push(hash(
:variable_name($pname),
:nominal_type($*W.find_symbol(['Mu'])),
:is_parcel(1),
));
$block[0].push(QAST::Var.new(:name($pname), :scope<lexical>, :decl('var')));
$new.push(QAST::Var.new(:name($pname), :scope<lexical>));
$acount++;
my $new;
if $was_chain && nqp::existskey($old, "chain_args") {
$new := QAST::Op.new( :op<chain>, :name($old<chain_name>), :node($/) );
$old<chain_block>[1] := QAST::Op.new( :op<die>, QAST::SVal.new( :value('This WhateverCode has been inlined into another WhateverCode and should not have been called!') ) );
for $old<chain_past> {
$new.push($_);
}
for $old<chain_args> -> %arg {
@params.push(%arg);
$block[0].push(QAST::Var.new(:name(%arg<variable_name>), :scope<lexical>, :decl<var>));
}
nqp::push(@old_args, $new);
} else {
$new := QAST::Op.new( :op<call>, :node($/), $old );
my $acount := 0;
while $acount < $old.arity {
my $pname := $*W.cur_lexpad()[0].unique('$whatevercode_arg');
@params.push(hash(
:variable_name($pname),
:nominal_type($*W.find_symbol(['Mu'])),
:is_parcel(1),
));
$block[0].push(QAST::Var.new(:name($pname), :scope<lexical>, :decl<var>));
my $to_push := QAST::Var.new(:name($pname), :scope<lexical>);
$new.push($to_push);
nqp::push(@old_args, $to_push) if $was_chain;
$acount++;
}
}
$past[$i] := $new;
}
elsif $curried > 1 && istype($old.returns, $Whatever) {
my $pname := '$x' ~ (+@params);
my $pname := $*W.cur_lexpad()[0].unique('$whatevercode_arg');
@params.push(hash(
:variable_name($pname),
:nominal_type($*W.find_symbol(['Mu'])),
......@@ -6036,6 +6079,9 @@ class Perl6::Actions is HLL::Actions does STDActions {
));
$block[0].push(QAST::Var.new(:name($pname), :scope<lexical>, :decl('var')));
$past[$i] := QAST::Var.new(:name($pname), :scope<lexical>);
nqp::push(@old_args, $past[$i]) if $was_chain;
} else {
nqp::push(@old_args, $past[$i]) if $was_chain;
}
$i++;
}
......@@ -6046,6 +6092,12 @@ class Perl6::Actions is HLL::Actions does STDActions {
$past := block_closure(reference_to_code_object($code, $block));
$past.returns($WhateverCode);
$past.arity(+@params);
if $was_chain {
$past<chain_past> := @old_args;
$past<chain_args> := @params;
$past<chain_name> := $was_chain;
$past<chain_block> := $block;
}
}
$past
}
......@@ -6547,6 +6599,25 @@ class Perl6::P5RegexActions is QRegex::P5Regex::Actions does STDActions {
:rxtype<subrule>, :subtype<method>, :node($/));
}
method p5metachar:sym<var>($/) {
if $*INTERPOLATE {
make QAST::Regex.new( QAST::Node.new(
QAST::SVal.new( :value('INTERPOLATE') ),
$<var>.ast,
QAST::IVal.new( :value(%*RX<i> ?? 1 !! 0) ),
QAST::IVal.new( :value($*SEQ ?? 1 !! 0) ),
QAST::IVal.new( :value(1) ) ),
:rxtype<subrule>, :subtype<method>, :node($/));
}
else {
make QAST::Regex.new( QAST::Node.new(
QAST::SVal.new( :value('!LITERAL') ),
$<var>.ast,
QAST::IVal.new( :value(%*RX<i> ?? 1 !! 0) ) ),
:rxtype<subrule>, :subtype<method>, :node($/));
}
}
method codeblock($/) {
my $blockref := $<block>.ast;
my $past :=
......
......@@ -1891,9 +1891,10 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
:my $*DOCEE;
<.attach_docs>
# Meta-object will live in here; also set default REPR (a trait
# Type-object will live in here; also set default REPR (a trait
# may override this, e.g. is repr('...')).
:my $*PACKAGE;
:my %*ATTR_USAGES;
:my $*REPR;
# Default to our scoped.
......@@ -2484,6 +2485,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
token regex_declarator:sym<rule> {
<sym>
:my %*RX;
:my $*INTERPOLATE := 1;
:my $*METHODTYPE := 'rule';
:my $*IN_DECL := 'rule';
{
......@@ -2495,6 +2497,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
token regex_declarator:sym<token> {
<sym>
:my %*RX;
:my $*INTERPOLATE := 1;
:my $*METHODTYPE := 'token';
:my $*IN_DECL := 'token';
{
......@@ -2505,6 +2508,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
token regex_declarator:sym<regex> {
<sym>
:my %*RX;
:my $*INTERPOLATE := 1;
:my $*METHODTYPE := 'regex';
:my $*IN_DECL := 'regex';
<regex_def>
......@@ -2924,12 +2928,14 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
token quote:sym</null/> { '/' \s* '/' <.typed_panic: "X::Syntax::Regex::NullRegex"> }
token quote:sym</ /> {
:my %*RX;
:my $*INTERPOLATE := 1;
'/' <nibble(self.quote_lang(%*LANG<Regex>, '/', '/'))> [ '/' || <.panic: "Unable to parse regex; couldn't find final '/'"> ]
<.old_rx_mods>?
}
token quote:sym<rx> {
<sym> >>
:my %*RX;
:my $*INTERPOLATE := 1;
<rx_adverbs>
<quibble(%*RX<P5> ?? %*LANG<P5Regex> !! %*LANG<Regex>)>
<!old_rx_mods>
......@@ -2938,6 +2944,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
token quote:sym<m> {
<sym> (s)**0..1>>
:my %*RX;
:my $*INTERPOLATE := 1;
{ %*RX<s> := 1 if $/[0] }
<rx_adverbs>
<quibble(%*RX<P5> ?? %*LANG<P5Regex> !! %*LANG<Regex>)>
......@@ -2975,6 +2982,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
token quote:sym<s> {
<sym> (s)**0..1 >>
:my %*RX;
:my $*INTERPOLATE := 1;
{
%*RX<s> := 1 if $/[0]
}
......@@ -3003,6 +3011,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
token quote:sym<tr> {
<sym>
:my %*RX;
:my $*INTERPOLATE := 1;
<rx_adverbs>
<tribble(%*RX<P5> ?? %*LANG<P5Regex> !! %*LANG<Regex>, %*LANG<Q>, ['cc'])>
<.old_rx_mods>?
......@@ -4231,7 +4240,11 @@ grammar Perl6::P5RegexGrammar is QRegex::P5Regex::Grammar does STD {
token p5metachar:sym<(??{ })> {
'(??' <?[{]> <codeblock> ')'
}
token p5metachar:sym<var> {
<?[$]> <var=.LANG('MAIN', 'variable')>
}
token codeblock {
<block=.LANG('MAIN','block')>
}
......
......@@ -12,6 +12,8 @@ class Perl6::Optimizer {
# Tracks the nested blocks we're in; it's the lexical chain, essentially.
has @!block_stack;
has %!adverbs;
# How deep a chain we're in, for chaining operators.
has int $!chain_depth;
......@@ -73,6 +75,7 @@ class Perl6::Optimizer {
# Work out optimization level.
my $*LEVEL := nqp::existskey(%adverbs, 'optimize') ??
+%adverbs<optimize> !! 2;
%!adverbs := %adverbs;
# Locate UNIT and some other useful symbols.
my $*GLOBALish := $past<GLOBALish>;
......@@ -154,9 +157,44 @@ class Perl6::Optimizer {
}
}
}
# We may also be able to optimize away the full-blown binder in some
# cases and on some backends.
my $code_obj := $block<code_object>;
my $backend := nqp::getcomp('perl6').backend.name;
if $backend eq 'jvm' && $*LEVEL >= 3 && nqp::isconcrete($code_obj) {
my $sig := $code_obj.signature;
self.try_eliminate_binder($block, $sig);
}
$block
}
method try_eliminate_binder($block, $sig) {
my $Signature := self.find_in_setting('Signature');
my @params := nqp::getattr($sig, $Signature, '$!params');
if nqp::elems(@params) == 0 {
# Zero args; no need for binder call, and no more to do.
try_remove_binder_call();
}
sub try_remove_binder_call() {
my int $found := 0;
for @($block[0]) {
if nqp::istype($_, QAST::Op) && $_.op eq 'p6bindsig' {
$_.op('null');
$found := 1;
last;
}
}
if $found {
$block.custom_args(0);
1
}
else {
0
}
}
}
method is_from_core($name) {
my int $i := +@!block_stack;
......@@ -488,9 +526,10 @@ class Perl6::Optimizer {
if $op.op eq 'chain' { $!chain_depth := $!chain_depth - 1 }
#say("# trial bind worked!");
if $*LEVEL >= 2 {
return nqp::can($obj, 'inline_info') && nqp::istype($obj.inline_info, QAST::Node)
?? self.inline_call($op, $obj)
!! copy_returns($op, $obj);
if nqp::can($obj, 'inline_info') && nqp::istype($obj.inline_info, QAST::Node) {
return self.inline_call($op, $obj);
}
copy_returns($op, $obj);
}
}
elsif $ct_result == -1 {
......@@ -498,6 +537,14 @@ class Perl6::Optimizer {
}
}
}
# If we get here, no inlining or compile-time decision was
# possible, but we may still be able to make it a callstatic,
# which is cheaper on some backends.
my $scopes := self.scopes_in($op.name);
if $scopes == 0 || $scopes == 1 && nqp::can($obj, 'soft') && !$obj.soft {
$op.op('callstatic');
}
}
else {
# We really should find routines; failure to do so is a CHECK
......@@ -525,7 +572,7 @@ class Perl6::Optimizer {
$op.unshift($inv);
$op.unshift($call);
$op.op('call');
$op.name(nqp::null());
$op.name(NQPMu);
}
}
else {
......@@ -550,8 +597,7 @@ class Perl6::Optimizer {
# Handles visiting a QAST::Want node.
method visit_want($want) {
# Just visit the children for now. We ignore the literal strings, so
# it all works out.
# Any literal in void context deserves a warning.
if $*VOID_CONTEXT && !$*IN_DECLARATION
&& +@($want) == 3 && $want.node {
......@@ -576,7 +622,15 @@ class Perl6::Optimizer {
return $NULL;
}
}
self.visit_children($want, :skip_selectors);
# If it's the sink context void node, then only visit the first
# child. Otherwise, see all.
if +@($want) == 3 && $want[1] eq 'v' {
self.visit_children($want, :first);
}
else {
self.visit_children($want, :skip_selectors);
}
$want;
}
......@@ -683,10 +737,11 @@ class Perl6::Optimizer {
}
# Visits all of a nodes children, and dispatches appropriately.
method visit_children($node, :$skip_selectors, :$resultchild) {
method visit_children($node, :$skip_selectors, :$resultchild, :$first) {
my int $r := $resultchild // -1;
my int $i := 0;
while $i < +@($node) {
my int $n := +@($node);
while $i < $n {
my $outer_void := $*VOID_CONTEXT;
my $outer_decl := $*IN_DECLARATION;
unless $skip_selectors && $i % 2 {
......@@ -710,9 +765,11 @@ class Perl6::Optimizer {
}
elsif nqp::istype($visit, QAST::Stmt) {
self.visit_children($visit, :resultchild($visit.resultchild // +@($visit) - 1));
} elsif nqp::istype($visit, QAST::Regex) {
QRegex::Optimizer.new().optimize($visit, @!block_stack[+@!block_stack - 1], |%!adverbs);
}
}
$i := $i + 1;
$i := $first ?? $n !! $i + 1;
}
}
......@@ -751,6 +808,22 @@ class Perl6::Optimizer {
0
}
# Works out how many scopes in from the outermost a given name is. A 0
# from this means the nearest declaration is from the setting; a 1 means
# it is in the mainline, etc.
method scopes_in($name) {
my int $i := +@!block_stack;
while $i > 0 {
$i := $i - 1;
my $block := @!block_stack[$i];
my %sym := $block.symbol($name);
if +%sym {
return $i;
}
}
nqp::die("Symbol $name not found");
}
# Inlines an immediate block.
method inline_immediate_block($block, $outer) {
# Sanity check.
......@@ -853,7 +926,7 @@ class Perl6::Optimizer {
),
QAST::IVal.new( :value($idx) )
));
$call.name(nqp::null());
$call.name(NQPMu);
$call.op('call');
#say("# Compile-time resolved a call to " ~ $proto.name);
last;
......
......@@ -317,6 +317,7 @@ sub minmax(*@args, :&by = &infix:<cmp>) { @args.minmax(&by) }
proto map(|) {*}
multi map(&code, *@values) { @values.map(&code) }
multi map(&code, Whatever) { (1..Inf).map(&code) }
proto grep(|) {*}
multi grep(Mu $test, *@values) { @values.grep($test) }
......@@ -420,10 +421,15 @@ sub SLICE_ONE ( \SELF, $one, $array, *%adv ) is hidden_from_backtrace {
my %a = %adv.clone;
my @nogo;
my $return = do {
my \result = do {
if %a.delete_key('delete') { # :delete:*
my $de = SELF.can( $array ?? 'delete_pos' !! 'delete_key' )[0];
if !%a { # :delete
if %a.delete_key('SINK') { # :delete:SINK
$de(SELF,$one);
Nil;
}
elsif !%a { # :delete
$de(SELF,$one);
}
elsif %a.exists_key('exists') { # :delete:exists(0|1):*
......@@ -591,7 +597,7 @@ sub SLICE_ONE ( \SELF, $one, $array, *%adv ) is hidden_from_backtrace {
@nogo || %a
?? SLICE_HUH( SELF, @nogo, %a, %adv )
!! $return;
!! result;
} #SLICE_ONE
# internal >1 element hash/array access with adverbs
......@@ -602,10 +608,15 @@ sub SLICE_MORE ( \SELF, $more, $array, *%adv ) is hidden_from_backtrace {
my $at = SELF.can( $array ?? 'at_pos' !! 'at_key' )[0];
my $ex = SELF.can( $array ?? 'exists_pos' !! 'exists_key' )[0];
my $return = do {
my \result = do {
if %a.delete_key('delete') { # :delete:*
my $de = SELF.can( $array ?? 'delete_pos' !! 'delete_key' )[0];
if !%a { # :delete
if %a.delete_key('SINK') { # :delete:SINK
$de(SELF,$_) for $more;
Nil;
}
elsif !%a { # :delete
$more.list.map( { $de(SELF,$_) } ).eager.Parcel;
}
elsif %a.exists_key('exists') { # :delete:exists(0|1):*
......@@ -815,5 +826,5 @@ sub SLICE_MORE ( \SELF, $more, $array, *%adv ) is hidden_from_backtrace {
@nogo || %a
?? SLICE_HUH( SELF, @nogo, %a, %adv )
!! $return;
!! result;
} #SLICE_MORE
......@@ -65,7 +65,12 @@ my class Backtrace is List {
next if $file eq 'src/gen/BOOTSTRAP.nqp' ||
$file eq 'src\\gen\\BOOTSTRAP.nqp';
last if $file eq 'src/stage2/gen/NQPHLL.nqp' ||
$file eq 'src\\stage2\\gen\\NQPHLL.nqp';
$file eq 'src\\stage2\\gen\\NQPHLL.nqp' ||
$file eq 'gen/parrot/stage2/NQPHLL.nqp' ||
$file eq 'gen\\parrot\\stage2\\NQPHLL.nqp' ||
$file eq 'gen/jvm/stage2/NQPHLL.nqp' ||
$file eq 'gen\\jvm\\stage2\\NQPHLL.nqp';
# XXX extend for moar
my $subname = nqp::p6box_s(nqp::getcodename($sub));
$subname = '<anon>' if $subname.substr(0, 6) eq '_block';
$new.push: Backtrace::Frame.new(
......
......@@ -3,8 +3,7 @@ my class Bag does Baggy {
has $!WHICH;
method total {
$!total //=
[+] nqp::getattr(self, Bag, '%!elems').values.map( { .value } );
$!total //= [+] %!elems.values.map( { .value } );
}
submethod WHICH { $!WHICH }
submethod BUILD (:%elems) {
......@@ -16,10 +15,9 @@ my class Bag does Baggy {
}
method at_key($k --> Int) {
my $elems := nqp::getattr(self, Bag, '%!elems');
my $key := $k.WHICH;
$elems.exists_key($key)
?? $elems{$key}.value
my $key := $k.WHICH;
%!elems.exists_key($key)
?? %!elems{$key}.value
!! 0;
}
......@@ -38,7 +36,7 @@ my class Bag does Baggy {
}
method Bag { self }
method BagHash { BagHash.new-fp(nqp::getattr(self, Bag, '%!elems').values) }
method Mix { Mix.new-fp(nqp::getattr(self, Bag, '%!elems').values) }
method MixHash { MixHash.new-fp(nqp::getattr(self, Bag, '%!elems').values) }
method BagHash { BagHash.new-fp(%!elems.values) }
method Mix { Mix.new-fp(%!elems.values) }
method MixHash { MixHash.new-fp(%!elems.values) }