Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Don't make signature part of a callable named parameter #4538

Merged
merged 5 commits into from Oct 5, 2021
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Jump to
Jump to file
Failed to load files.
Diff view
Diff view
115 changes: 89 additions & 26 deletions src/Perl6/Actions.nqp
Expand Up @@ -5582,7 +5582,7 @@ class Perl6::Actions is HLL::Actions does STDActions {
# Set name, if there is one.
if $<name> {
%*PARAM_INFO<variable_name> := ~$<declname>;
%*PARAM_INFO<desigilname> := ~$<name>;
%*PARAM_INFO<desigilname> := ~($<name><subshortname> // $<name>);
}
%*PARAM_INFO<sigil> := my $sigil := ~$<sigil>;

Expand Down Expand Up @@ -5693,19 +5693,7 @@ class Perl6::Actions is HLL::Actions does STDActions {
}

if $<name><sigterm> || $<sigterm> -> $sig {
unless %*PARAM_INFO<post_constraints> {
%*PARAM_INFO<post_constraints> := [];
}
my $get_signature_past := QAST::Op.new(
:op('callmethod'),
:name('signature'),
WANTED(QAST::Var.new( :name('$_'), :scope('lexical') ),'param_var')
);
my $fakesig := $sig<fakesignature>;
my $closure_signature := $fakesig.ast;

my $where := make_where_block($fakesig, $closure_signature, $get_signature_past);
%*PARAM_INFO<post_constraints>.push($where);
%*PARAM_INFO<signature_constraint> := $sig<fakesignature>.ast.value;
}

if $<arrayshape> {
Expand Down Expand Up @@ -5759,7 +5747,10 @@ class Perl6::Actions is HLL::Actions does STDActions {
method named_param($/) {
%*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>); }
elsif $<param_var><name> {
my $name := $<param_var><name>;
nqp::push_s(%*PARAM_INFO<named_names>, ~($name<subshortname> // $name));
}
else { nqp::push_s(%*PARAM_INFO<named_names>, ''); }
}

Expand Down Expand Up @@ -9427,29 +9418,35 @@ class Perl6::Actions is HLL::Actions does STDActions {
}
}

# Handle coercion.
# For a generic we can't know beforehand if it's going to be a coercive or any other nominalizable. Thus
# we have to fetch the instantiated parameter object and do run-time processing.
if $ptype_archetypes.generic {
# For a generic-typed parameter get its instantiated clone and see if its type is a coercion.
$decont_name_invalid := 1;
my $inst_param := QAST::Node.unique('__lowered_param_obj_');
my $low_param_type := QAST::Node.unique('__lowered_param_type');
my $inst_param;
# Make sure we have (possibly instantiated) parameter object ready when we need it
if $is_generic || %info<signature_constraint> {
my $inst_param_name := QAST::Node.unique('__lowered_param_obj_');
$var.push( # Fetch instantiated Parameter object
QAST::Op.new(
:op('bind'),
QAST::Var.new( :name($inst_param), :scope('local'), :decl('var') ),
QAST::Var.new( :name($inst_param_name), :scope('local'), :decl('var') ),
QAST::Op.new(
:op('atpos'),
signature_params($var),
QAST::IVal.new(:value($i)))));
$inst_param := QAST::Var.new(:name($inst_param_name), :scope<local>);
}

# Handle coercion.
# For a generic we can't know beforehand if it's going to be a coercive or any other nominalizable. Thus
# we have to fetch the instantiated parameter object and do run-time processing.
if $is_generic {
# For a generic-typed parameter get its instantiated clone and see if its type is a coercion.
$decont_name_invalid := 1;
my $low_param_type := QAST::Node.unique('__lowered_param_type');
$var.push( # Get actual parameter type
QAST::Op.new(
:op('bind'),
QAST::Var.new(:name($low_param_type), :scope('local'), :decl('var')),
QAST::Op.new(
:op('getattr'),
QAST::Var.new(:name($inst_param), :scope('local')),
$inst_param,
QAST::WVal.new(:value($Param)),
QAST::SVal.new(:value('$!type')))));
$var.push(
Expand All @@ -9466,7 +9463,7 @@ class Perl6::Actions is HLL::Actions does STDActions {
:op('bitand_i'),
QAST::Op.new(
:op('getattr'),
QAST::Var.new(:name($inst_param), :scope('local')),
$inst_param,
QAST::WVal.new(:value($Param)),
QAST::SVal.new(:value('$!flags'))
),
Expand Down Expand Up @@ -9713,6 +9710,72 @@ class Perl6::Actions is HLL::Actions does STDActions {
}
}

if %info<signature_constraint> {
my $var-qast := QAST::Var.new( :name($name), :scope('local') );
my $var-decont := get_decont_name()
?? QAST::Var.new( :name(get_decont_name()), :scope('local') )
!! QAST::Op.new( :op('decont'), $var-qast );
my $sigc_name := QAST::Node.unique('__lowered_sig_constraint_');
my $sigc-var := QAST::Var.new( :name($sigc_name), :scope<local>);
my $sigc-qast;
# Produce different code for generic/non-generic signatures because in the latter case instantiation
# code would be a waste of memory and performance.
if %info<signature_constraint>.is_generic {
$sigc-qast := QAST::Op.new(
:op<if>,
QAST::Op.new(
:op<callmethod>,
:name<is_generic>,
QAST::Op.new(
:op<bind>,
QAST::Var.new( :name($sigc_name), :scope<local>, :decl<var>),
QAST::Op.new(
:op<getattr>,
$inst_param,
QAST::WVal.new(:value($Param)),
QAST::SVal.new(:value('$!signature_constraint'))))),
QAST::Op.new(
:op<callmethod>,
:name<instantiate_generic>,
$sigc-var,
QAST::Op.new(
:op<ctxlexpad>,
QAST::Op.new(:op<ctx>))),
$sigc-var );
}
else {
$sigc-qast := QAST::Op.new(
:op<getattr>,
$inst_param,
QAST::WVal.new(:value($Param)),
QAST::SVal.new(:value('$!signature_constraint')));
}
$var.push(QAST::ParamTypeCheck.new(
QAST::Op.new(
# If argument is a type object and is the same as parameter default then skip signature
# matching. So far, this is the best way I know to determine if corresponding argument was
# passed or not without inspecting the capture which is too slow.
vrurg marked this conversation as resolved.
Show resolved Hide resolved
:op<unless>,
QAST::Op.new(
:op<if>,
QAST::Op.new(
:op<not_i>,
QAST::Op.new( :op<isconcrete>, $var-decont )),
QAST::Op.new(:op<eqaddr>, $var-decont, QAST::WVal.new(:value(%info<type>)))),
# If argument is concrete or is not parameter's default type then try signature matching
QAST::Op.new(
:op<if>,
QAST::Op.new(:op<can>, $var-qast, QAST::SVal.new(:value<signature>)),
QAST::Op.new(
:op<callmethod>,
:name<ACCEPTS>,
$sigc-qast,
QAST::Op.new(
:op<callmethod>,
:name<signature>,
$var-qast ))))));
}

# Apply post-constraints (must come after variable bind, as constraints can
# refer to the var).
if %info<post_constraints> {
Expand Down
3 changes: 3 additions & 0 deletions src/Perl6/World.nqp
Expand Up @@ -2286,6 +2286,9 @@ class Perl6::World is HLL::World {
if nqp::existskey(%param_info, 'sub_signature') {
nqp::bindattr($parameter, $par_type, '$!sub_signature', %param_info<sub_signature>);
}
if nqp::existskey(%param_info, 'signature_constraint') {
nqp::bindattr($parameter, $par_type, '$!signature_constraint', %param_info<signature_constraint>);
}

if nqp::existskey(%param_info, 'dummy') {
my $dummy := %param_info<dummy>;
Expand Down
49 changes: 45 additions & 4 deletions src/Perl6/bootstrap.c/BOOTSTRAP.nqp
Expand Up @@ -486,6 +486,33 @@ my class Binder {
nqp::bindkey($lexpad, 'self', nqp::decont($oval));
}

if nqp::defined(my $sigc := nqp::getattr($param, Parameter, '$!signature_constraint')) {
# Assume argument not passed if it is undefined and is the same as parameter default type
unless !nqp::isconcrete($oval) && nqp::eqaddr(nqp::decont($oval), nqp::getattr($param, Parameter, '$!type')) {
my $can_signature;
unless ($can_signature := nqp::can($oval, 'signature'))
&& ( $sigc.is_generic
?? ($sigc := $sigc.instantiate_generic($lexpad))
!! $sigc ).ACCEPTS($oval.signature)
{
if nqp::defined($error) {
$error[0] := {
Perl6::Metamodel::Configuration.throw_or_die(
'X::TypeCheck::Binding::Parameter',
"Signature check failed for parameter '$varname'",
:got($can_signature ?? $oval.signature !! Nil),
:expected($sigc),
:symbol($varname),
:parameter($param),
:what("Signature constraint")
)
};
}
return $BIND_RESULT_FAIL;
}
}
}

# Handle any constraint types (note that they may refer to the parameter by
# name, so we need to have bound it already).
my $post_cons := nqp::getattr($param, Parameter, '@!post_constraints');
Expand Down Expand Up @@ -1938,12 +1965,17 @@ BEGIN {
Parameter.HOW.add_attribute(Parameter, scalar_attr('$!container_descriptor', Mu, Parameter, :!auto_viv_container));
Parameter.HOW.add_attribute(Parameter, Attribute.new(:name<$!attr_package>, :type(Mu), :package(Parameter)));
Parameter.HOW.add_attribute(Parameter, Attribute.new(:name<$!why>, :type(Mu), :package(Parameter)));
Parameter.HOW.add_attribute(Parameter, Attribute.new(:name<$!signature_constraint>, :type(Signature), :package(Parameter)));
Parameter.HOW.add_method(Parameter, 'is_generic', nqp::getstaticcode(sub ($self) {
# If nonimnal type or attr_package is generic, so are we.
my $type := nqp::getattr($self, Parameter, '$!type');
my $ap := nqp::getattr($self, Parameter, '$!attr_package');
nqp::hllboolfor($type.HOW.archetypes.generic ||
(!nqp::isnull($ap) && $ap.HOW.archetypes.generic), "Raku")
my $sigc := nqp::getattr($self, Parameter, '$!signature_constraint');
nqp::hllboolfor(
$type.HOW.archetypes.generic
|| (!nqp::isnull($ap) && $ap.HOW.archetypes.generic)
|| (nqp::defined($sigc) && $sigc.is_generic),
"Raku")
}));
Parameter.HOW.add_method(Parameter, 'instantiate_generic', nqp::getstaticcode(sub ($self, $type_environment) {
# Clone with the type instantiated.
Expand All @@ -1953,6 +1985,7 @@ BEGIN {
my $type := nqp::getattr($self, Parameter, '$!type');
my $cd := nqp::getattr($self, Parameter, '$!container_descriptor');
my $ap := nqp::getattr($self, Parameter, '$!attr_package');
my $sigc := nqp::getattr($self, Parameter, '$!signature_constraint');
my $ins_type := $type;
my $ins_cd := $cd;
if $type.HOW.archetypes.generic {
Expand All @@ -1963,6 +1996,10 @@ BEGIN {
!nqp::isnull($ap) && $ap.HOW.archetypes.generic
?? $ap.HOW.instantiate_generic($ap, $type_environment)
!! $ap;
my $ins_sigc :=
nqp::defined($sigc) && $sigc.is_generic
?? $sigc.instantiate_generic($type_environment)
!! $sigc;
my int $flags := nqp::getattr_i($ins, Parameter, '$!flags');
unless $ins_type.HOW.archetypes.generic {
if $flags +& $SIG_ELEM_TYPE_GENERIC {
Expand All @@ -1976,6 +2013,7 @@ BEGIN {
nqp::bindattr($ins, Parameter, '$!type', $ins_type);
nqp::bindattr($ins, Parameter, '$!container_descriptor', $ins_cd);
nqp::bindattr($ins, Parameter, '$!attr_package', $ins_ap);
nqp::bindattr($ins, Parameter, '$!signature_constraint', $ins_sigc);
$ins
}));
Parameter.HOW.add_method(Parameter, 'set_rw', nqp::getstaticcode(sub ($self) {
Expand Down Expand Up @@ -2466,7 +2504,9 @@ BEGIN {
# to check constraint on every dispatch. Same if it's got a
# `where` clause.
unless nqp::isnull(nqp::getattr($param, Parameter, '$!sub_signature')) &&
nqp::isnull(nqp::getattr($param, Parameter, '@!post_constraints')) {
nqp::isnull(nqp::getattr($param, Parameter, '@!post_constraints')) &&
!nqp::defined(nqp::getattr($param, Parameter, '$!signature_constraint'))
{
%info<bind_check> := 1;
%info<constrainty> := 1;
}
Expand Down Expand Up @@ -2536,7 +2576,8 @@ BEGIN {
}
%info<types>[$significant_param] := $ptype;
}
unless nqp::isnull(nqp::getattr($param, Parameter, '@!post_constraints')) {
unless nqp::isnull(nqp::getattr($param, Parameter, '@!post_constraints'))
&& !nqp::defined(nqp::getattr($param, Parameter, '$!signature_constraint')) {
%info<constraints>[$significant_param] := 1;
}
if $flags +& $SIG_ELEM_MULTI_INVOCANT {
Expand Down
10 changes: 9 additions & 1 deletion src/core.c/Exception.pm6
Expand Up @@ -2493,9 +2493,17 @@ my class X::TypeCheck::Binding is X::TypeCheck {
my class X::TypeCheck::Binding::Parameter is X::TypeCheck::Binding {
has Parameter $.parameter;
has Bool $.constraint;
has Str $.what;
method expectedn() {
$.constraint && nqp::istype(self.expected, Code)
?? 'anonymous constraint to be met'
!! (nqp::istype($.expected, Signature)
?? $.expected.raku
!! callsame())
}
method gotn() {
nqp::istype($.expected, Signature) && nqp::eqaddr($.got, Nil)
?? "none"
!! callsame()
}
method message() {
Expand All @@ -2505,7 +2513,7 @@ my class X::TypeCheck::Binding::Parameter is X::TypeCheck::Binding {
my $expected = nqp::eqaddr(self.expected, self.got)
?? "expected type $.expectedn cannot be itself"
!! "expected $.expectedn but got $.gotn";
my $what-check = $.constraint ?? 'Constraint type' !! 'Type';
my $what-check = $.what // ($.constraint ?? 'Constraint type' !! 'Type');
self.priors() ~ "$what-check check failed in $.operation$to; $expected";
}
}
Expand Down
16 changes: 16 additions & 0 deletions src/core.c/Parameter.pm6
Expand Up @@ -510,6 +510,15 @@ my class Parameter { # declared in BOOTSTRAP
return False;
}

my \osignature_constraint := nqp::getattr(o, Parameter, '$!signature_constraint');
if nqp::defined($!signature_constraint) {
return False unless nqp::defined(osignature_constraint)
&& $!signature_constraint.ACCEPTS(osignature_constraint);
}
else {
return False if nqp::defined(osignature_constraint);
}

# we have a post constraint
if nqp::islist(@!post_constraints) {

Expand Down Expand Up @@ -568,6 +577,9 @@ my class Parameter { # declared in BOOTSTRAP
} else {
$name ~= $sigil ~ $twigil ~ $usage-name;
}
if nqp::isconcrete($!signature_constraint) {
$name ~= $!signature_constraint.raku;
}
if nqp::isconcrete(@!named_names) {
my $var-is-named = False;
my @outer-names = gather for @.named_names {
Expand Down Expand Up @@ -626,6 +638,10 @@ my class Parameter { # declared in BOOTSTRAP
nqp::isnull($!sub_signature) ?? Signature !! $!sub_signature
}

method signature_constraint(Parameter:D: --> Signature:_) {
nqp::isnull($!signature_constraint) ?? Signature !! $!signature_constraint
}

method set_why(Parameter:D: $why --> Nil) {
$!why := $why;
}
Expand Down