Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Make Parameter.[named_names, type_captures] list_s
Even with just `perl6 -e ''` lots of Parameters are created, this reduces
the memory used by these attributes, as well as the CPU needed to
box/unbox them.
  • Loading branch information
MasterDuke17 committed Feb 12, 2017
1 parent 266f345 commit b2e0ac0
Show file tree
Hide file tree
Showing 4 changed files with 38 additions and 26 deletions.
30 changes: 17 additions & 13 deletions src/Perl6/Actions.nqp
Expand Up @@ -2752,7 +2752,7 @@ class Perl6::Actions is HLL::Actions does STDActions {
my @params := %sig_info<parameters>;
@params.unshift(hash(
is_multi_invocant => 1,
type_captures => ['$?CLASS', '::?CLASS']
type_captures => nqp::list_s('$?CLASS', '::?CLASS')
));
my $sig := $*W.create_signature_and_params($<signature>, %sig_info, $block, 'Mu');
add_signature_binding_code($block, $sig, @params);
Expand Down Expand Up @@ -4993,10 +4993,10 @@ class Perl6::Actions is HLL::Actions does STDActions {
}

method named_param($/) {
%*PARAM_INFO<named_names> := %*PARAM_INFO<named_names> || [];
if $<name> { %*PARAM_INFO<named_names>.push(~$<name>); }
elsif $<param_var><name> { %*PARAM_INFO<named_names>.push(~$<param_var><name>); }
else { %*PARAM_INFO<named_names>.push(''); }
%*PARAM_INFO<named_names> := %*PARAM_INFO<named_names> || nqp::list_s();
if $<name> { nqp::push_s(%*PARAM_INFO<named_names>, ~$<name>); }
elsif $<param_var><name> { nqp::push_s(%*PARAM_INFO<named_names>, ~$<param_var><name>); }
else { nqp::push_s(%*PARAM_INFO<named_names>, ''); }
}

method default_value($/) {
Expand All @@ -5008,11 +5008,11 @@ class Perl6::Actions is HLL::Actions does STDActions {
my str $typename := ~$<typename>;
if nqp::eqat($typename, '::', 0) && !nqp::eqat($typename, '?', 2) {
# Set up signature so it will find the typename.
my $desigilname := nqp::substr($typename, 2);
my str $desigilname := nqp::substr($typename, 2);
unless %*PARAM_INFO<type_captures> {
%*PARAM_INFO<type_captures> := []
%*PARAM_INFO<type_captures> := nqp::list_s()
}
%*PARAM_INFO<type_captures>.push($desigilname);
nqp::push_s(%*PARAM_INFO<type_captures>, $desigilname);

# Install type variable in the static lexpad. Of course,
# we'll find the real thing at runtime, but in the static
Expand Down Expand Up @@ -8116,10 +8116,13 @@ class Perl6::Actions is HLL::Actions does STDActions {
elsif nqp::existskey(%info, 'named_names') {
my @names := %info<named_names>;
if nqp::elems(@names) == 1 {
$var.named(@names[0]);
$var.named(nqp::atpos_s(@names, 0));
}
elsif nqp::elems(@names) == 2 {
$var.named(@names);
my @names_copy;
@names_copy[0] := nqp::atpos_s(@names, 0);
@names_copy[1] := nqp::atpos_s(@names, 1);
$var.named(@names_copy);
}
else {
return 0;
Expand Down Expand Up @@ -8323,10 +8326,11 @@ class Perl6::Actions is HLL::Actions does STDActions {
# In theory, we could bind a local with the result of the WHAT
# operation, but I'm not convinced it's sufficiently expensive.
if %info<type_captures> {
for %info<type_captures> {
my $iter := nqp::iterator(%info<type_captures>);
while $iter {
$var.push( QAST::Op.new(
:op<bind>,
QAST::Var.new( :name($_), :scope<lexical> ),
QAST::Var.new( :name(nqp::shift($iter)), :scope<lexical> ),
QAST::Op.new( :op<what>,
QAST::Var.new( :name($name), :scope<local> ) )
)
Expand Down Expand Up @@ -8608,7 +8612,7 @@ class Perl6::Actions is HLL::Actions does STDActions {

# If it's named, just shove it on the end, but before any slurpies.
elsif $named {
%param_info<named_names> := [$ident];
%param_info<named_names> := nqp::list_s($ident);
my @popped;
while @params
&& (@params[+@params - 1]<pos_slurpy> || @params[+@params - 1]<named_slurpy>) {
Expand Down
10 changes: 5 additions & 5 deletions src/Perl6/Metamodel/BOOTSTRAP.nqp
Expand Up @@ -349,7 +349,7 @@ my class Binder {
my int $num_type_caps := nqp::elems($type_caps);
my int $i := 0;
while $i < $num_type_caps {
nqp::bindkey($lexpad, nqp::atpos($type_caps, $i), $oval.WHAT);
nqp::bindkey($lexpad, nqp::atpos_s($type_caps, $i), $oval.WHAT);
$i++;
}
}
Expand Down Expand Up @@ -816,7 +816,7 @@ my class Binder {
my int $j := 0;
my str $cur_name;
while $j < $num_names {
$cur_name := nqp::atpos($named_names, $j);
$cur_name := nqp::atpos_s($named_names, $j);
$value := nqp::atkey($named_args, $cur_name);
unless nqp::isnull($value) {
nqp::deletekey($named_args, $cur_name);
Expand Down Expand Up @@ -1466,8 +1466,8 @@ BEGIN {
# has Mu $!why;
Parameter.HOW.add_parent(Parameter, Any);
Parameter.HOW.add_attribute(Parameter, Attribute.new(:name<$!variable_name>, :type(str), :package(Parameter)));
Parameter.HOW.add_attribute(Parameter, scalar_attr('@!named_names', List, Parameter, :!auto_viv_container));
Parameter.HOW.add_attribute(Parameter, scalar_attr('@!type_captures', List, Parameter, :!auto_viv_container));
Parameter.HOW.add_attribute(Parameter, scalar_attr('@!named_names', Mu, Parameter, :!auto_viv_container));
Parameter.HOW.add_attribute(Parameter, scalar_attr('@!type_captures', Mu, Parameter, :!auto_viv_container));
Parameter.HOW.add_attribute(Parameter, Attribute.new(:name<$!flags>, :type(int), :package(Parameter)));
Parameter.HOW.add_attribute(Parameter, Attribute.new(:name<$!nominal_type>, :type(Mu), :package(Parameter)));
Parameter.HOW.add_attribute(Parameter, scalar_attr('@!post_constraints', List, Parameter, :!auto_viv_container));
Expand Down Expand Up @@ -1988,7 +1988,7 @@ BEGIN {
if $flags +& $SIG_ELEM_MULTI_INVOCANT {
unless $flags +& $SIG_ELEM_IS_OPTIONAL {
if nqp::elems($named_names) == 1 {
%info<req_named> := nqp::atpos($named_names, 0);
%info<req_named> := nqp::atpos_s($named_names, 0);
}
}
%info<bind_check> := 1;
Expand Down
6 changes: 2 additions & 4 deletions src/Perl6/World.nqp
Expand Up @@ -1884,12 +1884,10 @@ class Perl6::World is HLL::World {
nqp::bindattr($parameter, $par_type, '$!nominal_type', %param_info<nominal_type>);
nqp::bindattr_i($parameter, $par_type, '$!flags', $flags);
if %param_info<named_names> {
my @names := %param_info<named_names>;
nqp::bindattr($parameter, $par_type, '@!named_names', @names);
nqp::bindattr($parameter, $par_type, '@!named_names', %param_info<named_names>);
}
if %param_info<type_captures> {
my @type_names := %param_info<type_captures>;
nqp::bindattr($parameter, $par_type, '@!type_captures', @type_names);
nqp::bindattr($parameter, $par_type, '@!type_captures', %param_info<type_captures>);
}
if %param_info<post_constraints> {
nqp::bindattr($parameter, $par_type, '@!post_constraints',
Expand Down
18 changes: 14 additions & 4 deletions src/core/Parameter.pm
Expand Up @@ -100,7 +100,12 @@ my class Parameter { # declared in BOOTSTRAP

method type() { $!nominal_type }
method named_names() {
nqp::p6bindattrinvres(nqp::create(List),List,'$!reified',@!named_names)
my $nn := nqp::list();
my int $elems = @!named_names ?? nqp::elems(@!named_names) !! 0;
for ^$elems {
nqp::push($nn, nqp::atpos_s(@!named_names, $_));
}
nqp::p6bindattrinvres(nqp::create(List),List,'$!reified',$elems ?? $nn !! nqp::null)
}
method named() {
nqp::p6bool(
Expand Down Expand Up @@ -155,7 +160,12 @@ my class Parameter { # declared in BOOTSTRAP
!! { $!default_value }
}
method type_captures() {
nqp::p6bindattrinvres(nqp::create(List),List,'$!reified',@!type_captures)
my $ct := nqp::list();
my int $elems = @!type_captures ?? nqp::elems(@!type_captures) !! 0;
for ^$elems {
nqp::push($ct, nqp::atpos_s(@!type_captures, $_));
}
nqp::p6bindattrinvres(nqp::create(List),List,'$!reified',$elems ?? $ct !! nqp::null)
}

method !flags() { $!flags }
Expand Down Expand Up @@ -236,14 +246,14 @@ my class Parameter { # declared in BOOTSTRAP
# set up lookup hash
my $lookup := nqp::hash;
my int $i = -1;
nqp::bindkey($lookup,nqp::atpos(@!named_names,$i),1)
nqp::bindkey($lookup,nqp::atpos_s(@!named_names,$i),1)
while nqp::islt_i(++$i,$elems);

# make sure the other nameds are all here
$elems = nqp::elems($onamed_names);
$i = -1;
return False unless
nqp::existskey($lookup,nqp::atpos($onamed_names,$i))
nqp::existskey($lookup,nqp::atpos_s($onamed_names,$i))
while nqp::islt_i(++$i,$elems);
}
}
Expand Down

0 comments on commit b2e0ac0

Please sign in to comment.