Skip to content

Commit

Permalink
The first draft of new coercion semantics
Browse files Browse the repository at this point in the history 
This is a research work inspired by #1285. The following
changes are included:

- Coerions are made first-class type objects. It's now possible to pass
  a coercion around normally. Non-instantiable though akin to definites
  and subsets.
- A parameter is now marked as `coercive` if its type is a coerce.
- Coercions redelegate method calls to their target type.
- Coercions type checks almost as they should. This is a temporary
  situation. Yet, `Str ~~ Int(Str)` is `True`, and 'Rat ~~ Int(Str)` is
  `False`.
- Coercions are nominalizable. Nominalize into the target type.

Aside of these, coercion protocol is introduced. If `coerce` method of
`Metamodel::CoercionHOW` is used for `Foo(Bar)` then the following
methods are tried in the order of mentioning:

- the current standard of `Bar.Foo`
- `Bar.COERCE-INTO(Foo)`
- `Foo.COERCE-FROM(Bar)`

Considering the discussion in Raku/problem-solving#137, the last one is
the fallback of despair because, as was mentioned in the ticket, `Foo`
might not have full information about `Bar` state and thus may not
result in proper coercion. But the approach is safe to use for coercing
from simple type objects. And in any case I think it is better to have
something than have nothing and be forced to use augmentation.

In either case, the use of `COERCE-*` methods allows to handle types
with compound names without the risk of name clashes if short names of
two or more type objects match.
  • Loading branch information
@vrurg
vrurg committed Nov 15, 2020
1 parent 2a5dd9e commit f2d7328
Show file tree
Hide file tree
Showing 5 changed files with 223 additions and 40 deletions.
82 changes: 80 additions & 2 deletions src/Perl6/Actions.nqp
View file
Expand Up @@ -3701,7 +3701,7 @@ class Perl6::Actions is HLL::Actions does STDActions {
if $*OFTYPE {
$of_type := $*OFTYPE.ast;
my $archetypes := $of_type.HOW.archetypes;
unless $archetypes.nominal || $archetypes.nominalizable || $archetypes.generic || $archetypes.definite {
unless $archetypes.nominal || $archetypes.nominalizable || $archetypes.generic || $archetypes.definite || $archetypes.coercive {
$*OFTYPE.typed_sorry('X::Syntax::Variable::BadType', type => $of_type);
}
}
Expand Down Expand Up @@ -8994,6 +8994,8 @@ class Perl6::Actions is HLL::Actions does STDActions {
my @result;
my $clear_topic_bind;
my $saw_slurpy;
my $instantiated_code;
my $Code := $*W.find_single_symbol('Code', :setting-only);
my $Sig := $*W.find_single_symbol('Signature', :setting-only);
my $Param := $*W.find_single_symbol('Parameter', :setting-only);
my $Iterable := $*W.find_single_symbol('Iterable');
Expand Down Expand Up @@ -9211,7 +9213,83 @@ class Perl6::Actions is HLL::Actions does STDActions {

# Handle coercion.
my $coerce_to := nqp::getattr($param_obj, $Param, '$!coerce_type');
unless nqp::isnull($coerce_to) {
my $nominal_type := nqp::getattr($param_obj, $Param, '$!nominal_type');
if nqp::getenvhash<RAKUDO_DEBUG> {
say("<<< Parameter ", $name, " type: ", $nominal_type.HOW.name($nominal_type), ", generic: ", $nominal_type.HOW.archetypes.generic);
}
if $nominal_type.HOW.archetypes.generic {
# For a generic-typed parameter get its instantiated clone and see if its type is a coercion.
$decont_name_invalid := 1;
unless $instantiated_code {
# Produce current code object variable with the first generic-typed parameter encountered. Any
# next generic paramter would re-use the variable sparing a few CPU cycles per call.
$instantiated_code := QAST::Node.unique('__lowered_code_obj_');
$var.push(
QAST::Op.new(
:op('bind'),
QAST::Var.new(:name($instantiated_code), :scope('local'), :decl('var')),
QAST::Op.new(
:op('getcodeobj'),
QAST::Op.new(
:op('ctxcode'),
QAST::Op.new(:op('ctx')))
)
));
}
my $inst_param := QAST::Node.unique('__lowered_param_obj_');
$var.push(
QAST::Op.new(
:op('bind'),
QAST::Var.new( :name($inst_param), :scope('local'), :decl('var') ),
QAST::Op.new(
:op('atpos'),
QAST::Op.new(
:op('getattr'),
QAST::Op.new(
:op('getattr'),
QAST::Var.new(:name($instantiated_code), :scope('local')),
QAST::WVal.new(:value($Code)),
QAST::SVal.new(:value('$!signature'))
),
QAST::WVal.new(:value($Sig)),
QAST::SVal.new(:value('@!params'))
),
QAST::IVal.new(:value($i)))));
my $nominal_type := QAST::Node.unique('__lowered_nominal_type_');
$var.push(
QAST::Op.new(
:op('if'),
QAST::Op.new(
:op('callmethod'),
:name('coercive'),
QAST::Var.new(:name($inst_param), :scope('local'))
),
QAST::Op.new(
:op('bind'),
QAST::Var.new( :name($name), :scope('local') ),
QAST::Stmts.new(
QAST::Op.new(
:op('bind'),
QAST::Var.new(:name($nominal_type), :scope('local'), :decl('var')),
QAST::Op.new(
:op('getattr'),
QAST::Var.new(:name($inst_param), :scope('local')),
QAST::WVal.new(:value($Param)),
QAST::SVal.new(:value('$!nominal_type'))
)
),
QAST::Op.new(
:op('callmethod'),
:name('coerce'),
QAST::Op.new(
:op('how'),
QAST::Var.new(:name($nominal_type), :scope('local')),
),
QAST::Var.new(:name($nominal_type), :scope('local')),
QAST::Var.new(:name($name), :scope('local'))
)))));
}
elsif !nqp::isnull($coerce_to) {
if $coerce_to.HOW.archetypes.generic {
return 0;
}
Expand Down
145 changes: 113 additions & 32 deletions src/Perl6/Metamodel/CoercionHOW.nqp
View file
Expand Up @@ -4,63 +4,144 @@
# This means we get cross-compilation-unit interning "for free", as well as
# avoiding a meta-object instance per coercion type created.
class Perl6::Metamodel::CoercionHOW
does Perl6::Metamodel::MethodDelegation
does Perl6::Metamodel::TypePretense
# does Perl6::Metamodel::MethodDelegation
# does Perl6::Metamodel::TypePretense
{
my $archetypes := Perl6::Metamodel::Archetypes.new(:coercive);
has $!composed;
has $!target_type;
has $!constraint_type;

my $archetypes := Perl6::Metamodel::Archetypes.new(:coercive, :nominalizable);
method archetypes() {
$archetypes
}

method new(*%named) {
nqp::findmethod(NQPMu, 'BUILDALL')(nqp::create(self), |%named)
}

method new_type($target, $constraint) {
my $root := nqp::parameterizetype((Perl6::Metamodel::CoercionHOW.WHO)<root>,
my $coercion_type := nqp::parameterizetype((Perl6::Metamodel::CoercionHOW.WHO)<root>,
[$target, $constraint]);
nqp::setdebugtypename($root, self.name($root));
nqp::setdebugtypename($coercion_type, $coercion_type.HOW.name($coercion_type));
$coercion_type
}

method name($coercion_type) {
if nqp::isnull(nqp::typeparameterized($coercion_type)) {
'?(?)'
}
else {
my $target := nqp::typeparameterat($coercion_type, 0);
my $constraint := nqp::typeparameterat($coercion_type, 1);
$target.HOW.name($target) ~ '(' ~ $constraint.HOW.name($constraint) ~ ')'
method compose($coercion_type) {
if $!composed {
return $coercion_type;
}
my $tt := $coercion_type.HOW.target_type($coercion_type);
my $ct := $coercion_type.HOW.constraint_type($coercion_type);
note("CoercionHOW.compose(", $coercion_type.HOW.name($coercion_type), "|", nqp::objectid($coercion_type), ") ", $tt.HOW.name($tt), " ", $ct.HOW.name($ct));
# TODO typecache must iterate over MRO with roles
nqp::settypecache($coercion_type,
nqp::list(
$coercion_type.HOW.target_type($coercion_type),
$coercion_type.HOW.constraint_type($coercion_type)));
$!composed := 1;
$coercion_type
}

method shortname($coercion_type) {
if nqp::isnull(nqp::typeparameterized($coercion_type)) {
'?(?)'
}
else {
my $target := nqp::typeparameterat($coercion_type, 0);
my $constraint := nqp::typeparameterat($coercion_type, 1);
$target.HOW.shortname($target) ~ '(' ~ $constraint.HOW.shortname($constraint) ~ ')'
}
method set_target_type($target_type) {
$!target_type := $target_type;
}

sub check_instantiated($coercion_type) {
nqp::die('Cannot perform this operation on an uninstantiated coercion type')
if nqp::isnull(nqp::typeparameterized($coercion_type));
method set_constraint_type($constraint_type) {
$!constraint_type := $constraint_type;
}

method name($coercion_type) {
$!target_type.HOW.name($!target_type) ~ '(' ~ $!constraint_type.HOW.name($!constraint_type) ~ ')'
}

method shortname($coercion_type) {
$!target_type.HOW.shortname($!target_type) ~ '(' ~ $!constraint_type.HOW.shortname($!constraint_type) ~ ')'
}

method target_type($coercion_type) {
check_instantiated($coercion_type);
nqp::typeparameterat($coercion_type, 0)
$!target_type
}

method constraint_type($coercion_type) {
check_instantiated($coercion_type);
nqp::typeparameterat($coercion_type, 1)
$!constraint_type
}

method nominalize($coercion_type) {
my $target_type := $coercion_type.HOW.target_type($coercion_type);
$target_type.HOW.archetypes.nominalizable
?? $target_type.HOW.nominalize($target_type)
!! $target_type
}

method find_method($coercion_type, $name, *%c) {
say('find_method(', $coercion_type.HOW.name($coercion_type), ", ", $name, ')') if nqp::getenvhash<RAKUDO_DEBUG>;
my $target_type := $coercion_type.HOW.target_type($coercion_type);
$target_type.HOW.find_method($target_type, $name, |%c)
}

method type_check($obj, $checkee) {
say("type_check, obj:", $obj.HOW.name($obj), ", checkee:", $checkee.HOW.name($checkee)) if nqp::getenvhash<RAKUDO_DEBUG>;
if $obj =:= $checkee {
return 1;
}
my $target_type := $obj.HOW.target_type($obj);
my $rc := $target_type.HOW.type_check($target_type, $checkee);
say("type checked: ", $rc) if nqp::getenvhash<RAKUDO_DEBUG>;
$rc
}

method accepts_type($coercion_type, $checkee) {
say("accepts_type, obj:", $coercion_type.HOW.name($coercion_type), ", checkee:", $checkee.HOW.name($checkee)) if nqp::getenvhash<RAKUDO_DEBUG>;
my $target_type := $coercion_type.HOW.target_type($coercion_type);
my $constraint_type := $coercion_type.HOW.constraint_type($coercion_type);
my $rc := nqp::istype($checkee, $target_type) || nqp::istype($checkee, $constraint_type);
say("accepted: ", $rc) if nqp::getenvhash<RAKUDO_DEBUG>;
$rc
}

# Coercion protocol method.
method coerce($obj, $value) {
my $value_type := nqp::what($value);
if nqp::istype($value_type, $!target_type) {
return $value
}

# First we try $value.TargetType() approach
my $method := $value_type.HOW.find_method($value_type, $!target_type.HOW.name($!target_type), :no_fallback);
unless nqp::isnull($method) {
return $method($value)
}

# Next we try $value.COERCE-INTO(TargetType). This would make possible coercion into types with compound names
# like MyPackage::TargetType.
$method := $value_type.HOW.find_method($value_type, 'COERCE-INTO');
if nqp::defined($method) {
return $method($value, $!target_type);
}

# As the last resort we fallback to TargetType.COERCE-FROM($value). This is the worst possible variant because
# the best possible coercion may require access to source calss private data. Yet, this may work for many simple
# cases like TargetType(Str), for example.
$method := $!target_type.HOW.find_method($!target_type, 'COERCE-FROM');
if nqp::defined($method) {
return $method($!target_type, $value);
}

# TODO To be replaced with a proper Exception throwing.
nqp::die("Impossible coercion of " ~ $value_type.HOW.name($value_type)
~ " into " ~ $!target_type.HOW.name($!target_type));
}
}
BEGIN {
my $root := nqp::newtype(Perl6::Metamodel::CoercionHOW, 'Uninstantiable');
my $root := nqp::newtype(Perl6::Metamodel::CoercionHOW.new, 'Uninstantiable');
nqp::settypehll($root, 'Raku');
nqp::setparameterizer($root, sub ($type, $params) {
# Re-use same HOW.
nqp::settypehll(nqp::newtype($type.HOW, 'Uninstantiable'), 'Raku');
my $metaclass := $type.HOW.new();
$metaclass.set_target_type($params[0]);
$metaclass.set_constraint_type($params[1]);
my $coercion_type := nqp::settypehll(nqp::newtype($metaclass, 'Uninstantiable'), 'Raku');
nqp::settypecheckmode($coercion_type, 2)
});
(Perl6::Metamodel::CoercionHOW.WHO)<root> := $root;
}
Expand Down
2 changes: 1 addition & 1 deletion src/Perl6/World.nqp
View file
Expand Up @@ -4127,7 +4127,7 @@ class Perl6::World is HLL::World {
self.ex-handle($/, {
my $type := $/.how('coercion').new_type($target, $constraint);
if nqp::isnull(nqp::getobjsc($type)) { self.add_object_if_no_sc($type); }
$type
$type.HOW.compose($type)
})
}

Expand Down
26 changes: 21 additions & 5 deletions src/Perl6/bootstrap.c/BOOTSTRAP.nqp
View file
Expand Up @@ -1949,6 +1949,13 @@ BEGIN {
nqp::bindattr($ins, Parameter, '$!nominal_type', $ins_type);
nqp::bindattr($ins, Parameter, '$!container_descriptor', $ins_cd);
nqp::bindattr($ins, Parameter, '$!attr_package', $ins_ap);
nqp::say("...PARAM type: " ~ $ins_type.HOW.name($ins_type)) if nqp::getenvhash<RAKUDO_DEBUG>;
if $ins_type.HOW.archetypes.coercive {
nqp::say("... COERCIVE") if nqp::getenvhash<RAKUDO_DEBUG>;
my $target_type := $ins_type.HOW.target_type($ins_type);
nqp::say("... SETTING PARAM coerce_type to " ~ $target_type.HOW.name($target_type)) if nqp::getenvhash<RAKUDO_DEBUG>;
$ins.set_coercion($target_type);
}
$ins
}));
Parameter.HOW.add_method(Parameter, 'set_rw', nqp::getstaticcode(sub ($self) {
Expand Down Expand Up @@ -2016,12 +2023,21 @@ BEGIN {
$dcself
}));
Parameter.HOW.add_method(Parameter, 'set_coercion', nqp::getstaticcode(sub ($self, $type) {
nqp::say('... set_coercion method') if nqp::getenvhash<RAKUDO_DEBUG>;
my int $SIG_ELEM_IS_COERCIVE := 67108864;
my $dcself := nqp::decont($self);
my int $flags := nqp::getattr_i($dcself, Parameter, '$!flags');
nqp::bindattr_s($dcself, Parameter, '$!coerce_method',
nqp::istype($type.HOW, Perl6::Metamodel::DefiniteHOW)
?? $type.HOW.base_type($type).HOW.name($type.HOW.base_type: $type)
!! $type.HOW.name($type));
nqp::istype($type.HOW, Perl6::Metamodel::DefiniteHOW)
?? $type.HOW.base_type($type).HOW.name($type.HOW.base_type: $type)
!! $type.HOW.name($type));
nqp::bindattr($dcself, Parameter, '$!coerce_type', nqp::decont($type));
nqp::say("<<< set flags " ~ nqp::defined($flags) ~ " -- " ~ $flags) if nqp::getenvhash<RAKUDO_DEBUG>;
unless $flags +& $SIG_ELEM_IS_COERCIVE {
nqp::say("... FLAGS") if nqp::getenvhash<RAKUDO_DEBUG>;
nqp::bindattr_i($dcself, Parameter, '$!flags',
nqp::bitor_i($flags, $SIG_ELEM_IS_COERCIVE));
}
$dcself
}));
Parameter.HOW.add_method(Parameter, 'WHY', nqp::getstaticcode(sub ($self) {
Expand Down Expand Up @@ -4034,8 +4050,8 @@ Perl6::Metamodel::PackageHOW.pretend_to_be([Any, Mu]);
Perl6::Metamodel::PackageHOW.delegate_methods_to(Any);
Perl6::Metamodel::ModuleHOW.pretend_to_be([Any, Mu]);
Perl6::Metamodel::ModuleHOW.delegate_methods_to(Any);
Perl6::Metamodel::CoercionHOW.pretend_to_be([Any, Mu]);
Perl6::Metamodel::CoercionHOW.delegate_methods_to(Any);
# Perl6::Metamodel::CoercionHOW.pretend_to_be([Any, Mu]);
# Perl6::Metamodel::CoercionHOW.delegate_methods_to(Any);

# Let ClassHOW and EnumHOW know about the invocation handler.
Perl6::Metamodel::ClassHOW.set_default_invoke_handler(
Expand Down
8 changes: 8 additions & 0 deletions src/core.c/Parameter.pm6
View file
Expand Up @@ -35,6 +35,7 @@ my class Parameter { # declared in BOOTSTRAP
my constant $SIG_ELEM_DEFAULT_IS_LITERAL = 1 +< 20;
my constant $SIG_ELEM_SLURPY_ONEARG = 1 +< 24;
my constant $SIG_ELEM_CODE_SIGIL = 1 +< 25;
my constant $SIG_ELEM_IS_COERCIVE = 1 +< 26;

my constant $SIG_ELEM_IS_NOT_POSITIONAL = $SIG_ELEM_SLURPY_POS
+| $SIG_ELEM_SLURPY_NAMED
Expand Down Expand Up @@ -376,6 +377,13 @@ my class Parameter { # declared in BOOTSTRAP
method multi-invocant(Parameter:D: --> Bool:D) {
nqp::hllbool(nqp::bitand_i($!flags,$SIG_ELEM_MULTI_INVOCANT))
}
method coercive(Parameter:D: --> Bool:D) {
if nqp::getenvhash<RAKUDO_DEBUG> {
nqp::say("??? Parameter::coercive on " ~ self.name ~ " of " ~ $!nominal_type.^name);
nqp::say("??? " ~ $SIG_ELEM_IS_COERCIVE.fmt('%08x') ~ " +& " ~ $!flags.fmt('%08x') ~ " -> " ~ nqp::hllbool(nqp::bitand_i($!flags,$SIG_ELEM_IS_COERCIVE)));
}
nqp::hllbool(nqp::bitand_i($!flags,$SIG_ELEM_IS_COERCIVE))
}

method default(Parameter:D: --> Code:_) {
nqp::isnull($!default_value)
Expand Down

0 comments on commit f2d7328

Please sign in to comment.