Skip to content

Commit

Permalink
Use a spesh plugin for return value type checks
Browse files Browse the repository at this point in the history 
Decreases the size of the bytecode we produce for return type checks,
since the code to do that can be quite complex (especially given the
Nil/Failure sneak-through semantics and that we might have a coercion
to do). Also lets us optimize some cases a little better.
  • Loading branch information
@jnthn
jnthn committed Aug 8, 2018
1 parent 677f23f commit fe5c8d4
Show file tree
Hide file tree
Showing 2 changed files with 167 additions and 120 deletions.
135 changes: 15 additions & 120 deletions src/vm/moar/Perl6/Ops.nqp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -477,130 +477,25 @@ $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));
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]),
$value_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);
MAST::InstructionList.new(@ops, $value_res.result_reg, $MVM_reg_obj)
}
}
Expand Down
152 changes: 152 additions & 0 deletions src/vm/moar/spesh-plugins.nqp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -130,6 +130,158 @@ nqp::speshreg('perl6', 'maybemeth', -> $obj, str $name {
});
}

## Return value type check plugin

# Since spesh plugins are tied to a bytecode location, and called from there,
# we can simply look at the plugin's callercode to find information about the
# return type constraint.

{
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 identity($obj) { $obj }

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) {
# Obtain the return type.
my $code := nqp::getcodeobj(nqp::callercode());
my $sig := nqp::getattr($code, Code, '$!signature');
my $type := nqp::getattr($sig, Signature, '$!returns');
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 && (nqp::istype($rv, $type) || nqp::istype($rv, Nil)) {
# 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 fe5c8d4

Please sign in to comment.