Skip to content

Commit

Permalink
Adapt BUILDPLAN further
Browse files Browse the repository at this point in the history 
- replace state 0 for calling BUILD/TWEAK by just the Callable
  - saves one int + one list for each BUILD/TWEAK method in class or derived
  - adapt Mu.BUILDALL/BUILD_LEAST_DERIVED accordingly
  - runtime improvements within noise
- move up all other states one notch
  • Loading branch information
@lizmat
lizmat committed Sep 13, 2017
1 parent 9b527d0 commit 2574f88
Show file tree
Hide file tree
Showing 2 changed files with 84 additions and 86 deletions.
50 changes: 26 additions & 24 deletions src/Perl6/Metamodel/BUILDPLAN.nqp
View file
Expand Up @@ -5,20 +5,22 @@ role Perl6::Metamodel::BUILDPLAN {
# Creates the plan for building up the object. This works
# out what we'll need to do up front, so we can just zip
# through the "todo list" each time we need to make an object.
# The plan is an array of arrays. The first element of each
# nested array is an "op" representing the task to perform:
# 0 code = call specified BUILD or TWEAK method
# 1 class name attr_name = try to find initialization value
# 2 class attr_name code = call default value closure if needed
# 3 class name attr_name = set a native int attribute
# 4 class name attr_name = set a native num attribute
# 5 class name attr_name = set a native str attribute
# 6 class attr_name code = call default value closure if needed, int attr
# 7 class attr_name code = call default value closure if needed, num attr
# 8 class attr_name code = call default value closure if needed, str attr
# 9 die if a required attribute is not present
# 10 class attr_name code = run attribute container initializer
# 11 class attr_name = touch/vivify attribute if part of mixin
# The plan is an array of code objects / arrays. If the element
# is a code object, it should be called as a method without any
# further parameters. If it is an array, then the first element
# of each array is an "op" # representing the task to perform:
# code = call as method (for BUILD or TWEAK)
# 0 class name attr_name = try to find initialization value
# 1 class attr_name code = call default value closure if needed
# 2 class name attr_name = set a native int attribute
# 3 class name attr_name = set a native num attribute
# 4 class name attr_name = set a native str attribute
# 5 class attr_name code = call default value closure if needed, int attr
# 6 class attr_name code = call default value closure if needed, num attr
# 7 class attr_name code = call default value closure if needed, str attr
# 8 die if a required attribute is not present
# 9 class attr_name code = run attribute container initializer
# 10 class attr_name = touch/vivify attribute if part of mixin
method create_BUILDPLAN($obj) {
# First, we'll create the build plan for just this class.
my @plan;
Expand All @@ -32,7 +34,7 @@ role Perl6::Metamodel::BUILDPLAN {
if nqp::can($_, 'container_initializer') {
my $ci := $_.container_initializer;
if nqp::isconcrete($ci) {
nqp::push(@plan,[10, $obj, $_.name, $ci]);
nqp::push(@plan,[9, $obj, $_.name, $ci]);
next;
}
}
Expand All @@ -45,7 +47,7 @@ role Perl6::Metamodel::BUILDPLAN {
my $build := $obj.HOW.find_method($obj, 'BUILD', :no_fallback(1));
if !nqp::isnull($build) && $build {
# We'll call the custom one.
nqp::push(@plan,[0, $build]);
nqp::push(@plan,$build);
}
else {
# No custom BUILD. Rather than having an actual BUILD
Expand All @@ -57,10 +59,10 @@ role Perl6::Metamodel::BUILDPLAN {
my $name := nqp::substr($attr_name, 2);
my $typespec := nqp::objprimspec($_.type);
if $typespec {
nqp::push(@plan,[nqp::add_i(2, $typespec),
nqp::push(@plan,[nqp::add_i(1, $typespec),
$obj, $name, $attr_name]);
} else {
nqp::push(@plan,[1, $obj, $name, $attr_name]);
nqp::push(@plan,[0, $obj, $name, $attr_name]);
}
}
}
Expand All @@ -69,7 +71,7 @@ role Perl6::Metamodel::BUILDPLAN {
# Ensure that any required attributes are set
for @attrs {
if nqp::can($_, 'required') && $_.required {
nqp::push(@plan,[9, $obj, $_.name, $_.required]);
nqp::push(@plan,[8, $obj, $_.name, $_.required]);
nqp::deletekey(%attrs_untouched, $_.name);
}
}
Expand All @@ -81,10 +83,10 @@ role Perl6::Metamodel::BUILDPLAN {
if !nqp::isnull($default) && $default {
my $typespec := nqp::objprimspec($_.type);
if $typespec {
nqp::push(@plan,[nqp::add_i(5, $typespec), $obj, $_.name, $default]);
nqp::push(@plan,[nqp::add_i(4, $typespec), $obj, $_.name, $default]);
}
else {
nqp::push(@plan,[2, $obj, $_.name, $default]);
nqp::push(@plan,[1, $obj, $_.name, $default]);
}
nqp::deletekey(%attrs_untouched, $_.name);
}
Expand All @@ -93,13 +95,13 @@ role Perl6::Metamodel::BUILDPLAN {

# Add vivify instructions.
for %attrs_untouched {
nqp::push(@plan,[11, $obj, $_.key]);
nqp::push(@plan,[10, $obj, $_.key]);
}

# Does it have a TWEAK?
my $TWEAK := $obj.HOW.find_method($obj, 'TWEAK', :no_fallback(1));
if !nqp::isnull($TWEAK) && $TWEAK {
nqp::push(@plan,[0, $TWEAK]);
nqp::push(@plan,$TWEAK);
}

# Install plan for this class.
Expand All @@ -115,7 +117,7 @@ role Perl6::Metamodel::BUILDPLAN {
$i := $i - 1;
my $class := @mro[$i];
for $class.HOW.BUILDPLAN($class) {
if $_[0] == 11 { # 11 is a noop in BUILDALLPLAN
if nqp::islist($_) && $_[0] == 10 { # noop in BUILDALLPLAN
$noops := 1;
}
else {
Expand Down
120 changes: 58 additions & 62 deletions src/core/Mu.pm
View file
Expand Up @@ -160,19 +160,30 @@ Perhaps it can be found at https://docs.perl6.org/type/$name"
nqp::islt_i($i = nqp::add_i($i,1),$count),

nqp::if(
($code = nqp::atpos(($task := nqp::atpos($bp,$i)),0)),
nqp::istype(($task := nqp::atpos($bp,$i)),Callable),
nqp::if( # BUILD/TWEAK
nqp::istype(
($build := nqp::if(
nqp::elems($init),
$task(self,|%attrinit),
$task(self)
)),
Failure
),
return $build
),

nqp::if( # >0
nqp::iseq_i($code,1), # 1
nqp::if(
nqp::if( # not just calling
nqp::iseq_i(($code = nqp::atpos($task,0)),0),
nqp::if( # 0
nqp::existskey($init,nqp::atpos($task,2)),
(nqp::getattr(self,nqp::atpos($task,1),nqp::atpos($task,3))
= %attrinit.AT-KEY(nqp::atpos($task,2))),
),

nqp::if(
nqp::iseq_i($code,2),
nqp::unless( # 2
nqp::iseq_i($code,1),
nqp::unless( # 1
nqp::attrinited(self,
nqp::atpos($task,1),
nqp::atpos($task,2)
Expand All @@ -187,24 +198,24 @@ Perhaps it can be found at https://docs.perl6.org/type/$name"
),

nqp::if(
nqp::isle_i($code,5),
nqp::if( # 3,4,5
nqp::isle_i($code,4),
nqp::if( # 2,3,4
nqp::existskey($init,nqp::atpos($task,2)),
nqp::if( # can initialize
nqp::iseq_i($code,3),
nqp::bindattr_i(self, # 3
nqp::iseq_i($code,2),
nqp::bindattr_i(self, # 2
nqp::atpos($task,1),
nqp::atpos($task,3),
nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,2)))
),
nqp::if(
nqp::iseq_i($code,4),
nqp::bindattr_n(self, # 4
nqp::iseq_i($code,3),
nqp::bindattr_n(self, # 3
nqp::atpos($task,1),
nqp::atpos($task,3),
nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,2)))
),
nqp::bindattr_s(self, # 5
nqp::bindattr_s(self, # 4
nqp::atpos($task,1),
nqp::atpos($task,3),
nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,2)))
Expand All @@ -214,8 +225,8 @@ Perhaps it can be found at https://docs.perl6.org/type/$name"
),

nqp::if(
nqp::iseq_i($code,6),
nqp::if( # 6
nqp::iseq_i($code,5),
nqp::if( # 5
nqp::iseq_i($int = nqp::getattr_i(self,
nqp::atpos($task,1),
nqp::atpos($task,2)
Expand All @@ -228,8 +239,8 @@ Perhaps it can be found at https://docs.perl6.org/type/$name"
),

nqp::if(
nqp::iseq_i($code,7),
nqp::if( # 7
nqp::iseq_i($code,6),
nqp::if( # 6
nqp::iseq_n($num = nqp::getattr_n(self,
nqp::atpos($task,1),
nqp::atpos($task,2)
Expand All @@ -242,8 +253,8 @@ Perhaps it can be found at https://docs.perl6.org/type/$name"
),

nqp::if(
nqp::iseq_i($code,8),
nqp::if( # 8
nqp::iseq_i($code,7),
nqp::if( # 7
nqp::isnull_s($str = nqp::getattr_s(self,
nqp::atpos($task,1),
nqp::atpos($task,2)
Expand All @@ -256,8 +267,8 @@ Perhaps it can be found at https://docs.perl6.org/type/$name"
),

nqp::if(
nqp::iseq_i($code,9),
nqp::unless( # 9
nqp::iseq_i($code,8),
nqp::unless( # 8
nqp::attrinited(self,
nqp::atpos($task,1),
nqp::atpos($task,2)
Expand All @@ -269,27 +280,14 @@ Perhaps it can be found at https://docs.perl6.org/type/$name"
),

nqp::if(
nqp::iseq_i($code,10),
nqp::bindattr(self, # 10
nqp::iseq_i($code,9),
nqp::bindattr(self, # 9
nqp::atpos($task,1),
nqp::atpos($task,2),
(nqp::atpos($task,3)())
),
die("Invalid BUILDALL plan")
)))))))),

nqp::if( # 0 BUILD/TWEAK
nqp::istype(
($build := nqp::if(
nqp::elems($init),
nqp::atpos($task,1)(self,|%attrinit),
nqp::atpos($task,1)(self)
)),
Failure
),
return $build
)
)
))))))))),
);
self
}
Expand All @@ -311,24 +309,22 @@ Perhaps it can be found at https://docs.perl6.org/type/$name"
nqp::islt_i($i = nqp::add_i($i,1),$count),

nqp::if(
nqp::iseq_i(($code = nqp::atpos(
($task := nqp::atpos($bp,$i)),0
)),0),
nqp::if( # 0 BUILD/TWEAK
nqp::istype(($task := nqp::atpos($bp,$i)),Callable),
nqp::if( # BUILD/TWEAK
nqp::istype(
($build := nqp::if(
nqp::elems($init),
nqp::atpos($task,1)(self,|%attrinit),
nqp::atpos($task,1)(self)
$task(self,|%attrinit),
$task(self)
)),
Failure
),
return $build
),

nqp::if(
nqp::iseq_i($code,1),
nqp::if( # 1
nqp::iseq_i(($code = nqp::atpos($task,0)),0),
nqp::if( # 0
nqp::existskey($init,nqp::atpos($task,2)),
(nqp::getattr(self,nqp::atpos($task,1),nqp::atpos($task,3))
= nqp::decont(
Expand All @@ -338,8 +334,8 @@ Perhaps it can be found at https://docs.perl6.org/type/$name"
),

nqp::if(
nqp::iseq_i($code,2),
nqp::unless( # 2
nqp::iseq_i($code,1),
nqp::unless( # 1
nqp::attrinited(self,
nqp::atpos($task,1),
nqp::atpos($task,2)
Expand All @@ -354,8 +350,8 @@ Perhaps it can be found at https://docs.perl6.org/type/$name"
),

nqp::if(
nqp::iseq_i($code,3),
nqp::if( # 3
nqp::iseq_i($code,2),
nqp::if( # 2
nqp::existskey($init,nqp::atpos($task,2)),
nqp::bindattr_i(self,
nqp::atpos($task,1),
Expand All @@ -367,8 +363,8 @@ Perhaps it can be found at https://docs.perl6.org/type/$name"
),

nqp::if(
nqp::iseq_i($code,4),
nqp::if( # 4
nqp::iseq_i($code,3),
nqp::if( # 3
nqp::existskey($init,nqp::atpos($task,2)),
nqp::bindattr_n(self,
nqp::atpos($task,1),
Expand All @@ -380,8 +376,8 @@ Perhaps it can be found at https://docs.perl6.org/type/$name"
),

nqp::if(
nqp::iseq_i($code,5),
nqp::if( # 5
nqp::iseq_i($code,4),
nqp::if( # 4
nqp::existskey($init,nqp::atpos($task,2)),
nqp::bindattr_s(self,
nqp::atpos($task,1),
Expand All @@ -393,8 +389,8 @@ Perhaps it can be found at https://docs.perl6.org/type/$name"
),

nqp::if(
nqp::iseq_i($code,6),
nqp::if( # 6
nqp::iseq_i($code,5),
nqp::if( # 5
nqp::iseq_i($int = nqp::getattr_i(self,
nqp::atpos($task,1),
nqp::atpos($task,2)
Expand All @@ -407,8 +403,8 @@ Perhaps it can be found at https://docs.perl6.org/type/$name"
),

nqp::if(
nqp::iseq_i($code,7),
nqp::if( # 7
nqp::iseq_i($code,6),
nqp::if( # 6
nqp::iseq_n($num = nqp::getattr_n(self,
nqp::atpos($task,1),
nqp::atpos($task,2)
Expand All @@ -421,8 +417,8 @@ Perhaps it can be found at https://docs.perl6.org/type/$name"
),

nqp::if(
nqp::iseq_i($code,8),
nqp::if( # 8
nqp::iseq_i($code,7),
nqp::if( # 7
nqp::isnull_s($str = nqp::getattr_s(self,
nqp::atpos($task,1),
nqp::atpos($task,2)
Expand All @@ -435,16 +431,16 @@ Perhaps it can be found at https://docs.perl6.org/type/$name"
),

nqp::if(
nqp::iseq_i($code,11),
nqp::iseq_i($code,10),
# Force vivification, for the sake of meta-object
# mix-ins at compile time ending up with correctly
# shared containers.
nqp::stmts( # 11
nqp::stmts( # 10
nqp::getattr(self,
nqp::atpos($task,1),
nqp::atpos($task,2)
),
nqp::while( # 11's flock together
nqp::while( # 10's flock together
nqp::islt_i(
($i = nqp::add_i($i,1)),
$count
Expand Down

0 comments on commit 2574f88

Please sign in to comment.