Skip to content

Commit

Permalink
Properly support uints in BUILDPLANs
Browse files Browse the repository at this point in the history 
Re-number BUILDPLAN to accomodate uint support. Rakudo maps from primspec to
BUILDPLAN opcode and back, but the numbers required for primspec 10 (uint) were
already taken. So re-number to make space and support uint where appropriate.
  • Loading branch information
@niner
niner committed Feb 1, 2022
1 parent 753c173 commit a38bebe
Show file tree
Hide file tree
Showing 4 changed files with 261 additions and 193 deletions.
50 changes: 26 additions & 24 deletions src/Perl6/Metamodel/BUILDPLAN.nqp
View file
Expand Up @@ -17,21 +17,23 @@ role Perl6::Metamodel::BUILDPLAN {
# 1 class name attr_name = set a native int attribute from init hash
# 2 class name attr_name = set a native num attribute from init hash
# 3 class name attr_name = set a native str attribute from init hash
# 4 class attr_name code = call default value closure if needed
# 5 class attr_name code = call default value closure if needed, int or uint 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
# 11 same as 0, but init to nqp::list if value absent (nqp only)
# 12 same as 0, but init to nqp::hash if value absent (nqp only)
# 13 same as 0 but *bind* the received value + optional type constraint
# 14 same as 4 but *bind* the default value + optional type constraint
# 15 die if a required int attribute is 0
# 16 die if a required num attribute is 0e0
# 17 die if a required str attribute is null_s (will be '' in the future)
# 24 die if a required uint attribute is 0
# 10 class name attr_name = set a native uint attribute from init hash
# 400 class attr_name code = call default value closure if needed
# 401 class attr_name code = call default value closure if needed, int attr
# 402 class attr_name code = call default value closure if needed, num attr
# 403 class attr_name code = call default value closure if needed, str attr
# 410 class attr_name code = call default value closure if needed, uint attr
# 800 die if a required attribute is not present
# 900 class attr_name code = run attribute container initializer
# 1000 class attr_name = touch/vivify attribute if part of mixin
# 1100 same as 0, but init to nqp::list if value absent (nqp only)
# 1200 same as 0, but init to nqp::hash if value absent (nqp only)
# 1300 same as 0 but *bind* the received value + optional type constraint
# 1400 same as 400 but *bind* the default value + optional type constraint
# 1501 die if a required int attribute is 0
# 1502 die if a required num attribute is 0e0
# 1503 die if a required str attribute is null_s (will be '' in the future)
# 1510 die if a required uint attribute is 0
method create_BUILDPLAN($obj) {
# First, we'll create the build plan for just this class.
my @plan;
Expand Down Expand Up @@ -68,7 +70,7 @@ role Perl6::Metamodel::BUILDPLAN {
}
}

nqp::push(@plan,[9, $obj, $_.name, $ci]);
nqp::push(@plan,[900, $obj, $_.name, $ci]);
next;
}
}
Expand Down Expand Up @@ -113,13 +115,13 @@ role Perl6::Metamodel::BUILDPLAN {
if $_.is_built {
my $name := $_.name;
my $action := $primspec || !$_.is_bound
?? $primspec == 10 ?? 1 !! 0 + $primspec
!! 13;
?? 0 + $primspec
!! 1300;

my $info := [$action,$obj,$name,nqp::substr($name,2)];

# binding may need type info for runtime checks
if $action == 13 {
if $action == 1300 {
my $type := $_.type;
# since we may wind up here at runtime, get Mu by
# HLLizing a VMNull instead of looking it up through
Expand All @@ -139,7 +141,7 @@ role Perl6::Metamodel::BUILDPLAN {
if nqp::can($_, 'required') && $_.required {
my $type := $_.type;
my int $primspec := nqp::objprimspec($type);
my int $op := $primspec ?? $primspec == 10 ?? 24 !! 14 + $primspec !! 8;
my int $op := $primspec ?? 1500 + $primspec !! 800;
nqp::push(@plan,[$op, $obj, $_.name, $_.required]);
nqp::deletekey(%attrs_untouched, $_.name);
}
Expand All @@ -160,11 +162,11 @@ role Perl6::Metamodel::BUILDPLAN {
# compile check constants for correct type
if nqp::isconcrete($default) {
my $name := $_.name;
my $opcode := $primspec || !$_.is_bound ?? $primspec == 10 ?? 5 !! 4 + $primspec !! 14;
my $opcode := $primspec || !$_.is_bound ?? 400 + $primspec !! 1400;
my @action := [$opcode, $obj, $name, $default];

# binding defaults to additional check at runtime
my $check-at-runtime := $opcode == 14;
my $check-at-runtime := $opcode == 1400;

# currently compiling, so we can do typechecking now.
if !nqp::isnull(nqp::getlexdyn('$*W')) && $*W.in_unit_parse {
Expand Down Expand Up @@ -226,7 +228,7 @@ role Perl6::Metamodel::BUILDPLAN {
# Add vivify instructions.
for @attrs { # iterate over the array to get a consistent order
if nqp::existskey(%attrs_untouched, $_.name) {
nqp::push(@plan,[10, $obj, $_.name]);
nqp::push(@plan,[1000, $obj, $_.name]);
}
}

Expand Down Expand Up @@ -254,7 +256,7 @@ role Perl6::Metamodel::BUILDPLAN {
$i := $i - 1;
my $class := @mro[$i];
for $class.HOW.BUILDPLAN($class) {
if nqp::islist($_) && $_[0] == 10 { # noop in BUILDALLPLAN
if nqp::islist($_) && $_[0] == 1000 { # noop in BUILDALLPLAN
$noops := 1;
}
else {
Expand Down
67 changes: 34 additions & 33 deletions src/Perl6/World.nqp
View file
Expand Up @@ -3632,8 +3632,8 @@ class Perl6::World is HLL::World {
QAST::SVal.new( :value(nqp::atpos($task,2)) );

my int $code := nqp::atpos($task,0);
# 0,11,12,13 = initialize opaque from %init
if $code == 0 || $code == 11 || $code == 12 || $code == 13 {
# 0,1100,1200,1300 = initialize opaque from %init
if $code == 0 || $code == 1100 || $code == 1200 || $code == 1300 {

# 'a'
my $key :=
Expand Down Expand Up @@ -3675,7 +3675,7 @@ class Perl6::World is HLL::World {
}

# nqp::bindattr(self,Foo,'$!a',tmp)
elsif $code == 13 {
elsif $code == 1300 {
my $arg := QAST::Var.new( :name($tmp), :scope<local> );
if nqp::elems($task) == 5 {
$arg := QAST::Op.new(
Expand All @@ -3702,14 +3702,14 @@ class Perl6::World is HLL::World {
);
}

# 11,12
# 1100,1200
# bindattr(self,Foo,'$!a',nqp::list|hash)
if $code == 11 || $code == 12 {
if $code == 1100 || $code == 1200 {
$if.push(
QAST::Op.new(:op<bindattr>,
$!self, $class, $attr,
QAST::Op.new(
:op($code == 11 ?? 'list' !! 'hash')
:op($code == 1100 ?? 'list' !! 'hash')
)
)
);
Expand All @@ -3719,8 +3719,8 @@ class Perl6::World is HLL::World {
$stmts.push($if);
}

# 1,2,3 = initialize native from %init
elsif $code < 4 {
# 1,2,3,10 = initialize native from %init
elsif $code < 100 {

# nqp::unless(
# nqp::isnull(my \tmp := nqp::atkey($init,'a')),
Expand All @@ -3745,8 +3745,8 @@ class Perl6::World is HLL::World {
);
}

# 4 = set opaque with default if not set yet
elsif $code == 4 || $code == 14 {
# 400 = set opaque with default if not set yet
elsif $code == 400 || $code == 1400 {

# nqp::getattr(self,Foo,'$!a')
my $getattr := QAST::Op.new( :op<getattr>,
Expand Down Expand Up @@ -3783,7 +3783,7 @@ class Perl6::World is HLL::World {
);
}

elsif $code == 14 {
elsif $code == 1400 {
# (nqp::bindattr(self,Foo,'$!a',$code(self,nqp::getattr(self,Foo,'$!a'))))
if nqp::elems($task) == 5 {
$initializer := QAST::Op.new(
Expand Down Expand Up @@ -3818,8 +3818,8 @@ class Perl6::World is HLL::World {
$!w.add_object_if_no_sc(nqp::atpos($task,3));
}

# 5,6 = set native numeric with default if not set
elsif $code < 7 {
# 401,402,410 = set native numeric with default if not set
elsif $code == 401 || $code == 402 || $code == 410 {
# nqp::if(
# nqp::iseq_x(
# nqp::getattr_x(self,Foo,'$!a'),
Expand All @@ -3829,16 +3829,16 @@ class Perl6::World is HLL::World {
# $initializer(self,nqp::getattr_x(self,Foo,'$!a')))
# ),
my $getattr := QAST::Op.new(
:op('getattr' ~ @psp[$code - 4]),
:op('getattr' ~ @psp[$code - 400]),
$!self, $class, $attr
);
$stmts.push(
QAST::Op.new( :op<if>,
QAST::Op.new( :op('iseq' ~ @psp[$code - 4]),
QAST::Op.new( :op('iseq' ~ @psp[$code - 400]),
$getattr,
@psd[$code - 4],
@psd[$code - 400],
),
QAST::Op.new( :op('bindattr' ~ @psp[$code - 4]),
QAST::Op.new( :op('bindattr' ~ @psp[$code - 400]),
$!self, $class, $attr,
nqp::if(
nqp::istype(nqp::atpos($task,3),$!Block),
Expand All @@ -3848,7 +3848,7 @@ class Perl6::World is HLL::World {
$getattr
),
nqp::if(
nqp::iseq_i($code,5),
nqp::iseq_i($code,401) || nqp::iseq_i($code,410),
QAST::IVal.new(:value(nqp::atpos($task,3))),
QAST::NVal.new(:value(nqp::atpos($task,3)))
)
Expand All @@ -3860,8 +3860,8 @@ class Perl6::World is HLL::World {
$!w.add_object_if_no_sc(nqp::atpos($task,3));
}

# 7 = set native string with default if not set
elsif $code == 7 {
# 403 = set native string with default if not set
elsif $code == 403 {
# nqp::if(
# nqp::isnull_s(nqp::getattr_s(self,Foo,'$!a')),
# nqp::bindattr_s(self,Foo,'$!a',
Expand Down Expand Up @@ -3891,27 +3891,28 @@ class Perl6::World is HLL::World {
$!w.add_object_if_no_sc(nqp::atpos($task,3));
}

# 8 = die if opaque not yet initialized
# 15 = die if int is 0
# 16 = die if num is 0e0
# 17 = die if str is null_s
elsif $code == 8 || $code >= 15 && $code <= 17 || $code == 24 {
# 800 = die if opaque not yet initialized
# 1501 = die if int is 0
# 1502 = die if num is 0e0
# 1503 = die if str is null_s
# 1510 = die if uint is 0
elsif $code == 800 || $code > 1500 && $code < 1600 {
# nqp::unless(
# nqp::p6attrinited(nqp::getattr(self,Foo,'$!a')),
# X::Attribute::Required.new(name => '$!a', why => (value))
# ),
my $check;
if $code == 15 {
if $code == 1501 {
$check := QAST::Op.new( :op<getattr_i>,
$!self, $class, $attr
);
}
elsif $code == 16 {
elsif $code == 1502 {
$check := QAST::Op.new( :op<getattr_n>,
$!self, $class, $attr
);
}
elsif $code == 17 {
elsif $code == 1503 {
$check := QAST::Op.new( :op<not_i>,
QAST::Op.new( :op<isnull_s>,
QAST::Op.new( :op<getattr_s>,
Expand All @@ -3920,7 +3921,7 @@ class Perl6::World is HLL::World {
)
);
}
elsif $code == 24 {
elsif $code == 1510 {
$check := QAST::Op.new( :op<getattr_u>,
$!self, $class, $attr
);
Expand Down Expand Up @@ -3949,8 +3950,8 @@ class Perl6::World is HLL::World {
);
}

# 9 = run attribute container initializer
elsif $code == 9 {
# 900 = run attribute container initializer
elsif $code == 900 {

# nqp::bindattr(self,Foo,'$!a',$initializer())
$stmts.push(
Expand All @@ -3965,8 +3966,8 @@ class Perl6::World is HLL::World {
$!w.add_object_if_no_sc(nqp::atpos($task,3));
}

# 10 = set attrinited on attribute
elsif $code == 10 {
# 1000 = set attrinited on attribute
elsif $code == 1000 {
# nqp::getattr(self,Foo,'$!a')
$stmts.push(
QAST::Op.new(:op<getattr>, $!self, $class, $attr)
Expand Down

0 comments on commit a38bebe

Please sign in to comment.