Permalink
Browse files

Correct handling of -> ASubsetType:D $x { }.

We took the base type of the definiteness type, and just assumed it
was already a simple nominal type. Now it is further analyzed, which
fixes the compilation and behavior of the above construct.
  • Loading branch information...
1 parent 59b7e51 commit 68afa3f1e77862e4b61f9946103047103fff3c2c @jnthn jnthn committed Jul 21, 2016
Showing with 41 additions and 38 deletions.
  1. +41 −38 src/Perl6/Actions.nqp
View
@@ -4905,44 +4905,7 @@ class Perl6::Actions is HLL::Actions does STDActions {
parameter => (%*PARAM_INFO<variable_name> // ''),
);
}
- my $type := $<typename>.ast;
- if nqp::isconcrete($type) {
- # Actual a value that parses type-ish.
- %*PARAM_INFO<nominal_type> := $type.WHAT;
- unless %*PARAM_INFO<post_constraints> {
- %*PARAM_INFO<post_constraints> := [];
- }
- %*PARAM_INFO<post_constraints>.push($type);
- }
- elsif $type.HOW.archetypes.nominal {
- %*PARAM_INFO<nominal_type> := $type;
- }
- elsif $type.HOW.archetypes.coercive {
- %*PARAM_INFO<nominal_type> := $type.HOW.constraint_type($type);
- %*PARAM_INFO<coerce_type> := $type.HOW.target_type($type);
- }
- elsif $type.HOW.archetypes.definite {
- %*PARAM_INFO<nominal_type> := $type.HOW.base_type($type);
- }
- elsif $type.HOW.archetypes.generic {
- %*PARAM_INFO<nominal_type> := $type;
- %*PARAM_INFO<nominal_generic> := 1;
- }
- elsif $type.HOW.archetypes.nominalizable {
- my $nom := $type.HOW.nominalize($type);
- %*PARAM_INFO<nominal_type> := $nom;
- unless %*PARAM_INFO<post_constraints> {
- %*PARAM_INFO<post_constraints> := [];
- }
- %*PARAM_INFO<post_constraints>.push($type);
- }
- else {
- $<typename>.CURSOR.typed_sorry('X::Parameter::BadType', :$type);
- }
- %*PARAM_INFO<of_type> := %*PARAM_INFO<nominal_type>;
- %*PARAM_INFO<of_type_match> := $<typename>;
- %*PARAM_INFO<defined_only> := 1 if $<typename><colonpairs><D>;
- %*PARAM_INFO<undefined_only> := 1 if $<typename><colonpairs><U>;
+ dissect_type_into_parameter($/, $<typename>.ast);
}
}
elsif $<value> {
@@ -4971,6 +4934,46 @@ class Perl6::Actions is HLL::Actions does STDActions {
}
}
+ sub dissect_type_into_parameter($/, $type) {
+ if nqp::isconcrete($type) {
+ # Actual a value that parses type-ish.
+ %*PARAM_INFO<nominal_type> := $type.WHAT;
+ unless %*PARAM_INFO<post_constraints> {
+ %*PARAM_INFO<post_constraints> := [];
+ }
+ %*PARAM_INFO<post_constraints>.push($type);
+ }
+ elsif $type.HOW.archetypes.nominal {
+ %*PARAM_INFO<nominal_type> := $type;
+ }
+ elsif $type.HOW.archetypes.coercive {
+ %*PARAM_INFO<nominal_type> := $type.HOW.constraint_type($type);
+ %*PARAM_INFO<coerce_type> := $type.HOW.target_type($type);
+ }
+ elsif $type.HOW.archetypes.definite {
+ dissect_type_into_parameter($/, $type.HOW.base_type($type));
+ }
+ elsif $type.HOW.archetypes.generic {
+ %*PARAM_INFO<nominal_type> := $type;
+ %*PARAM_INFO<nominal_generic> := 1;
+ }
+ elsif $type.HOW.archetypes.nominalizable {
+ my $nom := $type.HOW.nominalize($type);
+ %*PARAM_INFO<nominal_type> := $nom;
+ unless %*PARAM_INFO<post_constraints> {
+ %*PARAM_INFO<post_constraints> := [];
+ }
+ %*PARAM_INFO<post_constraints>.push($type);
+ }
+ else {
+ $<typename>.CURSOR.typed_sorry('X::Parameter::BadType', :$type);
+ }
+ %*PARAM_INFO<of_type> := %*PARAM_INFO<nominal_type>;
+ %*PARAM_INFO<of_type_match> := $<typename>;
+ %*PARAM_INFO<defined_only> := 1 if $<typename><colonpairs><D>;
+ %*PARAM_INFO<undefined_only> := 1 if $<typename><colonpairs><U>;
+ }
+
method post_constraint($/) {
if $*CONSTRAINT_USAGE eq 'param' {
if $<signature> {

0 comments on commit 68afa3f

Please sign in to comment.