Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Merge branch 'return-type-check-plugin'
  • Loading branch information
@jnthn
jnthn committed Aug 9, 2018
2 parents fa73bb4 + bf9ab42 commit dc68b93
Show file tree
Hide file tree
Showing 3 changed files with 172 additions and 121 deletions.
6 changes: 5 additions & 1 deletion src/Perl6/Optimizer.nqp
View file
Expand Up @@ -1312,7 +1312,8 @@ class Perl6::Optimizer {

# Boolifications don't need it, nor do _I/_i/_n/_s ops, with
# the exception of native assignment, which can decont_[ins]
# as appropriate, which may avoid a boxing.
# as appropriate, which may avoid a boxing. Same for QAST::WVal
# if we can see the value is not containerized.
my $last_stmt := get_last_stmt($value);
if nqp::istype($last_stmt, QAST::Op) {
my str $last_op := $last_stmt.op;
Expand Down Expand Up @@ -1343,6 +1344,9 @@ class Perl6::Optimizer {
return $value;
}
}
elsif nqp::istype($last_stmt, QAST::WVal) {
return $value unless nqp::iscont($last_stmt.value);
}
}

# Also some return type checks.
Expand Down
137 changes: 18 additions & 119 deletions src/vm/moar/Perl6/Ops.nqp
View file
Expand Up @@ -477,130 +477,29 @@ $ops.add_hll_op('perl6', 'p6typecheckrv', -> $qastcomp, $op {
$qastcomp.as_mast($op[0])
}
else {
my $target_type;

# emit a typecheck for the constraint type, the coercion will be
# performed later on
if $type.HOW.archetypes.coercive {
$target_type := $type.HOW.target_type($type);
$type := $type.HOW.constraint_type($type);
}

# if the type we want to check against is a definite type
# like Int:D, we can generate much more efficient code by
# splitting the check up into definedness check + type check
# against the base type. This saves us from a call into the
# metamodel for each check.
my int $emit_definite_check := -1;
if $type.HOW.archetypes.definite {
$emit_definite_check := $type.HOW.definite($type);
$type := $type.HOW.base_type($type);
}

# Use a spesh plugin to appropriately optimize return type checks.
my @ops;
my $value_res := $qastcomp.as_mast($op[0], :want($MVM_reg_obj));
my $type_res := $qastcomp.as_mast(QAST::WVal.new( :value($type) ), :want($MVM_reg_obj));
my $niltype_res := $qastcomp.as_mast($op[2]);

my $lbl_done := MAST::Label.new();
my $value_res := $qastcomp.as_mast($op[0], :want($MVM_reg_obj));
my $type_res := $qastcomp.as_mast(QAST::WVal.new( :value($type) ), :want($MVM_reg_obj));
push_ilist(@ops, $value_res);
push_ilist(@ops, $type_res);
my $decont := $*REGALLOC.fresh_o();
my $istype := $*REGALLOC.fresh_i();
my $isdefinite;
my $failure_o := $niltype_res.result_reg;

unless $emit_definite_check == -1 {
$isdefinite := $*REGALLOC.fresh_i();
}

nqp::push(@ops, MAST::Op.new( :op('decont'), $decont, $value_res.result_reg ));
nqp::push(@ops, MAST::Op.new( :op('istype'), $istype, $decont, $type_res.result_reg ));

if $emit_definite_check == -1 {
nqp::push(@ops, MAST::Op.new( :op('if_i'), $istype, $lbl_done ));
} else {
my $lbl_failed_initial_typecheck := MAST::Label.new();
nqp::push(@ops, MAST::Op.new( :op('unless_i'), $istype, $lbl_failed_initial_typecheck ));

nqp::push(@ops, MAST::Op.new( :op('isconcrete'), $isdefinite, $decont ));
if $emit_definite_check == 0 {
nqp::push(@ops, MAST::Op.new( :op('unless_i'), $isdefinite, $lbl_done ));
} else {
nqp::push(@ops, MAST::Op.new( :op('if_i'), $isdefinite, $lbl_done ));
}
nqp::push(@ops, $lbl_failed_initial_typecheck);
}

push_ilist(@ops, $niltype_res);
nqp::push(@ops, MAST::Op.new( :op('istype'), $istype, $decont, $failure_o) );
nqp::push(@ops, MAST::Op.new( :op('if_i'), $istype, $lbl_done ));
$*REGALLOC.release_register($decont, $MVM_reg_obj);
$*REGALLOC.release_register($istype, $MVM_reg_int64);
$*REGALLOC.release_register($failure_o, $MVM_reg_obj);

unless $emit_definite_check == -1 {
$*REGALLOC.release_register($isdefinite, $MVM_reg_int64);
}

# Error generation.
proto return_error($got, $wanted) {
my %ex := nqp::gethllsym('perl6', 'P6EX');
if nqp::isnull(%ex) || !nqp::existskey(%ex, 'X::TypeCheck::Return') {
nqp::die("Type check failed for return value; expected '" ~
$wanted.HOW.name($wanted) ~ "' but got '" ~
$got.HOW.name($got) ~ "'");
}
else {
nqp::atkey(%ex, 'X::TypeCheck::Return')($got, $wanted)
}
}
my $err_rep := $qastcomp.as_mast(QAST::WVal.new( :value(nqp::getcodeobj(&return_error)) ));
push_ilist(@ops, $err_rep);
my $plugin_reg := $*REGALLOC.fresh_o();
nqp::push(@ops, MAST::Call.new(
:target($err_rep.result_reg),
:flags($Arg::obj, $Arg::obj),
$value_res.result_reg, $type_res.result_reg
:target(MAST::SVal.new( :value('typecheckrv') )),
:flags([$Arg::obj, $Arg::obj]),
$value_res.result_reg,
$type_res.result_reg,
:result($plugin_reg),
:op(2)
));
nqp::push(@ops, $lbl_done);
$*REGALLOC.release_register($err_rep.result_reg, $MVM_reg_obj);

unless $target_type =:= NQPMu || $target_type =:= $type {
my $coerce_method := $target_type.HOW.name($target_type);
my $lbl_no_error := MAST::Label.new();

my $can := $*REGALLOC.fresh_i();
nqp::push(@ops,
MAST::Op.new(:op('can'), $can, $value_res.result_reg, MAST::SVal.new(:value($coerce_method))));
nqp::push(@ops,
MAST::Op.new(:op('if_i'), $can, $lbl_no_error));
$*REGALLOC.release_register($can, $MVM_reg_int64);

# inform the user that the coercion cannot be done
my $errstr_reg := $*REGALLOC.fresh_s();
my $dieret_reg := $*REGALLOC.fresh_o();
my $errstr := "Unable to coerce the return value from "
~ $type.HOW.name($type) ~ " to " ~ $target_type.HOW.name($type)
~ "; no coercion method defined";
nqp::push(@ops,
MAST::Op.new(:op('const_s'), $errstr_reg, MAST::SVal.new(:value($errstr))));
nqp::push(@ops,
MAST::Op.new(:op('die'), $dieret_reg, $errstr_reg));
$*REGALLOC.release_register($errstr_reg, $MVM_reg_str);
$*REGALLOC.release_register($dieret_reg, $MVM_reg_obj);

nqp::push(@ops,
$lbl_no_error);

# perform the type conversion directly into the value_res register
my $meth := $*REGALLOC.fresh_o();
nqp::push(@ops,
MAST::Op.new(:op('findmeth'), $meth, $value_res.result_reg, MAST::SVal.new(:value($coerce_method))));
nqp::push(@ops,
MAST::Call.new(:target($meth), :result($value_res.result_reg), :flags([$Arg::obj]), $value_res.result_reg));
$*REGALLOC.release_register($meth, $MVM_reg_obj);
}

nqp::push(@ops, MAST::Call.new(
:target($plugin_reg),
:flags([$Arg::obj]),
$value_res.result_reg,
:result($value_res.result_reg),
));
$*REGALLOC.release_register($plugin_reg, $MVM_reg_obj);
$*REGALLOC.release_register($type_res.result_reg, $MVM_reg_obj);
MAST::InstructionList.new(@ops, $value_res.result_reg, $MVM_reg_obj)
}
}
Expand Down
150 changes: 149 additions & 1 deletion src/vm/moar/spesh-plugins.nqp
View file
Expand Up @@ -49,11 +49,12 @@ nqp::speshreg('perl6', 'maybemeth', -> $obj, str $name {
# Often we have nothing at all to do, in which case we can make it a no-op.
# Other times, we need a decont. In a few, we need to re-wrap it.

sub identity($obj) { $obj }

{
# We look up Iterable when the plugin is used.
my $Iterable := nqp::null();

sub identity($obj) { $obj }
sub mu($replaced) { Mu }
sub decont($obj) { nqp::decont($obj) }
sub recont($obj) {
Expand Down Expand Up @@ -130,6 +131,153 @@ nqp::speshreg('perl6', 'maybemeth', -> $obj, str $name {
});
}

## Return value type check plugin

{
sub coercion_error($from_name, $to_name) {
nqp::die("Unable to coerce the return value from $from_name to $to_name; " ~
"no coercion method defined");
}

sub return_error($got, $wanted) {
my %ex := nqp::gethllsym('perl6', 'P6EX');
if nqp::isnull(%ex) || !nqp::existskey(%ex, 'X::TypeCheck::Return') {
nqp::die("Type check failed for return value; expected '" ~
$wanted.HOW.name($wanted) ~ "' but got '" ~
$got.HOW.name($got) ~ "'");
}
else {
nqp::atkey(%ex, 'X::TypeCheck::Return')($got, $wanted)
}
}

sub make-unchecked-coercion($rv, $coerce_to) {
# We already have the type fixed, so we can resolve to the coercion
# method if available.
my $name := $coerce_to.HOW.name($coerce_to);
my $meth := nqp::tryfindmethod($rv, $name);
return nqp::isnull($meth)
?? -> $ret { coercion_error($ret.HOW.name($ret), $name) }
!! $meth;
}

sub check_type_typeobj($type, $orig_type) {
-> $ret {
nqp::istype($ret, $type) && !nqp::isconcrete($ret)
?? $ret
!! return_error($ret, $orig_type)
}
}
sub check_type_concrete($type, $orig_type) {
-> $ret {
nqp::istype($ret, $type) && nqp::isconcrete($ret)
?? $ret
!! return_error($ret, $orig_type)
}
}
sub check_type($type, $orig_type) {
-> $ret {
nqp::istype($ret, $type) || nqp::istype($ret, Nil)
?? $ret
!! return_error($ret, $orig_type)
}
}

sub check_type_typeobj_coerce($type, $name, $orig_type) {
-> $ret {
nqp::istype($ret, $type) && !nqp::isconcrete($ret)
?? (nqp::isnull(my $cmeth := nqp::tryfindmethod($ret, $name))
?? coercion_error($ret.HOW.name($ret), $name)
!! $cmeth($ret))
!! return_error($ret, $orig_type)
}
}
sub check_type_concrete_coerce($type, $name, $orig_type) {
-> $ret {
nqp::istype($ret, $type) && nqp::isconcrete($ret)
?? (nqp::isnull(my $cmeth := nqp::tryfindmethod($ret, $name))
?? coercion_error($ret.HOW.name($ret), $name)
!! $cmeth($ret))
!! return_error($ret, $orig_type)
}
}
sub check_type_coerce($type, $name, $orig_type) {
-> $ret {
nqp::istype($ret, $type) || nqp::istype($ret, Nil)
?? (nqp::isnull(my $cmeth := nqp::tryfindmethod($ret, $name))
?? coercion_error($ret.HOW.name($ret), $name)
!! $cmeth($ret))
!! return_error($ret, $orig_type)
}
}

nqp::speshreg('perl6', 'typecheckrv', sub ($rv, $type) {
my $orig_type := $type;

# If the type is Mu or unset, then we can resolve to identity.
if nqp::isnull($type) || $type =:= Mu {
return &identity;
}

# Gather information about coercive and definite types, and resolve
# to the base type.
my $coerce_to := nqp::null();
my int $definite_check := -1;
if $type.HOW.archetypes.coercive {
$coerce_to := $type.HOW.target_type($type);
$type := $type.HOW.constraint_type($type);
}
if $type.HOW.archetypes.definite {
$definite_check := $type.HOW.definite($type);
$type := $type.HOW.base_type($type);
}

# See if the return value is containerized; if not, we can do some
# guarding/checking and maybe toss the checks altogether.
unless nqp::iscont($rv) {
if $type.HOW.archetypes.nominal &&
# Allow through Nil/Failure
(nqp::istype($rv, Nil) || (nqp::istype($rv, $type) &&
# Enforce definite checks.
($definite_check == 0 ?? !nqp::isconcrete($rv) !!
$definite_check == 1 ?? nqp::isconcrete($rv) !! 1))) {
# Type matches; add a type guard and we can elide checking
# that.
nqp::speshguardtype($rv, $rv.WHAT);

# If there's a definedness check, add guards for those too.
if $definite_check == 0 {
nqp::speshguardtypeobj($rv);
}
elsif $definite_check == 1 {
nqp::speshguardconcrete($rv);
}

# Now it's either an unchecked coercion or identity.
return nqp::isnull($coerce_to)
?? &identity
!! make-unchecked-coercion($rv, $coerce_to);
}
}

# If we get here, we've got a case we can't simplify much. Pick an
# appropriate variant that will do the type checks and coercions as
# needed.
if nqp::isnull($coerce_to) {
return $definite_check == 0 ?? check_type_typeobj($type, $orig_type) !!
$definite_check == 1 ?? check_type_concrete($type, $orig_type) !!
check_type($type, $orig_type);
}
else {
my $name := $coerce_to.HOW.name($coerce_to);
return $definite_check == 0 ?? check_type_typeobj_coerce($type, $name, $orig_type) !!
$definite_check == 1 ?? check_type_concrete_coerce($type, $name, $orig_type) !!
check_type_coerce($type, $name, $orig_type);
}
});
}


## Assignment plugin

# We case-analyze assignments and provide these optimized paths for a range of
Expand Down

0 comments on commit dc68b93

Please sign in to comment.