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

Implement typecheck and auto-coercers on constants #1935

Merged
merged 8 commits into from Jun 17, 2018
Copy path View file
@@ -4942,6 +4942,7 @@ class Perl6::Actions is HLL::Actions does STDActions {
}
method type_declarator:sym<constant>($/) {
my $W := $*W;
my $value_ast := $<initializer>.ast;
my $sigil := '';
@@ -4953,9 +4954,6 @@ class Perl6::Actions is HLL::Actions does STDActions {
elsif $<variable> {
if $<variable><sigil> {
$sigil := ~$<variable><sigil>;
if $sigil eq '@' {
$value_ast := QAST::Op.new( :op<callmethod>, :name<cache>, $value_ast);
}
}
if $<variable><twigil> {
my $twigil := ~$<variable><twigil>;
@@ -4968,7 +4966,7 @@ class Perl6::Actions is HLL::Actions does STDActions {
}
elsif $twigil eq '*' {
$*W.throw($/, 'X::Syntax::Variable::Twigil',
$W.throw($/, 'X::Syntax::Variable::Twigil',
what => 'constant',
twigil => $twigil,
scope => $*SCOPE,
@@ -4978,48 +4976,70 @@ class Perl6::Actions is HLL::Actions does STDActions {
# Don't handle other twigil'd case yet.
else {
$*W.throw($/, 'X::Comp::NYI',
$W.throw($/, 'X::Comp::NYI',
feature => "Constants with a '$twigil' twigil");
}
}
$name := ~$<variable>;
}
# Get constant value.
my $type := nqp::defined($*OFTYPE)
?? $*OFTYPE.ast !! $*W.find_symbol: ['Mu'];
my $Mu := $W.find_symbol: ['Mu'];
my $type := nqp::defined($*OFTYPE) ?? $*OFTYPE.ast !! $Mu;
if $<initializer><sym> eq '.=' {
$value_ast.unshift(QAST::WVal.new(:value($type)));
}
$value_ast.returns($type);
my $con_block := $*W.pop_lexpad();
my $con_block := $W.pop_lexpad();
my $value;
if $value_ast.has_compile_time_value {
$value := $value_ast.compile_time_value;
}
else {
$con_block.push($value_ast);
my $value_thunk := $*W.create_code_obj_and_add_child($con_block, 'Block');
$value := $*W.handle-begin-time-exceptions($/, 'evaluating a constant', $value_thunk);
my $value_thunk := $W.create_code_obj_and_add_child($con_block, 'Block');
$value := $W.handle-begin-time-exceptions($/, 'evaluating a constant', $value_thunk);
$*W.add_constant_folded_result($value);
}
if $sigil eq '%' {
my $Associative := $*W.find_symbol(['Associative']);
if !nqp::istype($value, $Associative) {
$*W.throw($/, 'X::TypeCheck',
operation => "constant declaration of " ~ ~$<variable>,
expected => $Associative, got => $*W.find_symbol([$value.HOW.name($value)]) );
sub check-type ($expected) {
nqp::istype($value, $expected)
|| $W.throw: $/, 'X::TypeCheck', :operation(
"constant declaration of " ~ ($name || '<anon>')
), :$expected, :got($W.find_symbol: [$value.HOW.name: $value]);
}
sub check-type-maybe-coerce($meth, $expected) {
unless nqp::istype($value, $expected) {
$value := $value."$meth"();
check-type($expected);
}
}
if $sigil eq '%' {
nqp::defined($*OFTYPE) && $W.throw: $/, 'X::ParametricConstant';
$W.lang-ver-before('d')
?? check-type($W.find_symbol: ['Associative'])
!! check-type-maybe-coerce('Map', $W.find_symbol: ['Associative'])
}
elsif $sigil eq '@' {
nqp::defined($*OFTYPE) && $W.throw: $/, 'X::ParametricConstant';
check-type-maybe-coerce('cache', $*W.find_symbol: ['Positional']);
}
elsif $sigil eq '&' {
nqp::defined($*OFTYPE) && $W.throw: $/, 'X::ParametricConstant';
check-type($W.find_symbol: ['Callable']);
}
elsif !($type =:= $Mu) && ! nqp::objprimspec($type) {
check-type($type);
}
if $name {
my $cur_pad := $*W.cur_lexpad();
my $cur_pad := $W.cur_lexpad();
if $cur_pad.symbol($name) {
$*W.throw($/, ['X', 'Redeclaration'], symbol => $name);
$W.throw($/, ['X', 'Redeclaration'], symbol => $name);
}
$*W.install_package($/, [$name], ($*SCOPE || 'our'),
$W.install_package($/, [$name], ($*SCOPE || 'our'),
'constant', $/.package, $cur_pad, $value);
}
for $<trait> {
Copy path View file
@@ -482,6 +482,16 @@ class Perl6::World is HLL::World {
Perl6::World.new(:handle(self.handle), :context(self.context()))
}
method lang-ver-before(str $want) {
nqp::chars($want) == 1 || nqp::die(
'Version to $*W.lang_ver_before'
~ " must be 1 char long ('c', 'd', etc). Got `$want`.");
nqp::cmp_s(
nqp::substr(nqp::getcomp('perl6').language_version, 2, 1),
$want
) == -1
}
method RAKUDO_MODULE_DEBUG() {
if nqp::isconcrete($!RAKUDO_MODULE_DEBUG) {
$!RAKUDO_MODULE_DEBUG
@@ -4969,17 +4979,21 @@ class Perl6::World is HLL::World {
sub safely_stringify($target) {
if $has_str && nqp::istype($target, $Str) {
return ~nqp::unbox_s($target);
return nqp::isconcrete($target)
?? ~nqp::unbox_s($target) !! '(Str)';
} elsif $has_int && nqp::istype($target, $Int) {
return ~nqp::unbox_i($target);
return nqp::isconcrete($target)
?? ~nqp::unbox_i($target) !! '(Int)';
} elsif $has_list && nqp::istype($target, $List) {
return '(List)' unless nqp::isconcrete($target);
my $storage := nqp::getattr($target, $List, '$!reified');
my @result;
for $storage {
nqp::push(@result, safely_stringify($_));
}
return "(" ~ join(", ", @result) ~ ")";
} elsif nqp::ishash($target) {
}
elsif nqp::ishash($target) {
my @result;
for $target -> $key {
@result.push("\n") if +@result != 0;
Copy path View file
@@ -2176,6 +2176,10 @@ my class X::Composition::NotComposable does X::Comp {
}
}
my class X::ParametricConstant is Exception {
method message { 'Parameterization of constants is forbidden' }
}
my class X::TypeCheck is Exception {
has $.operation;
has $.got is default(Nil);
Copy path View file
@@ -171,7 +171,10 @@ my class Map does Iterable does Associative { # declared in BOOTSTRAP
}
}.new(self)
}
method list(Map:D:) { Seq.new(self.iterator) }
method list(Map:D:) {
nqp::p6bindattrinvres(
nqp::create(List),List,'$!reified',self.IterationBuffer)
}
multi method pairs(Map:D:) { Seq.new(self.iterator) }
multi method keys(Map:D:) { Seq.new(Rakudo::Iterator.Mappy-keys(self)) }
multi method values(Map:D:) { Seq.new(Rakudo::Iterator.Mappy-values(self)) }
Copy path View file
@@ -0,0 +1,15 @@
use Test;
plan 1;
subtest '.lang-ver-before method on Perl6::World' => {
plan 5;
ok use v6.c; BEGIN $*W.lang-ver-before: 'd'.EVAL, 'c is before d';
nok use v6.c; BEGIN $*W.lang-ver-before: 'c'.EVAL, 'c is not before d';
nok use v6.d.PREVIEW; BEGIN $*W.lang-ver-before: 'd'.EVAL,
'd is not before d';
nok use v6.d.PREVIEW; BEGIN $*W.lang-ver-before: 'c'.EVAL,
'd is not before c';
throws-like BEGIN $*W.lang-ver-before: <6.d>, Exception,
:self{.exception.message.contains: 'must be 1 char long'},
'using wrong version format as argument throws';
}
Copy path View file
@@ -296,6 +296,7 @@ S04-blocks-and-statements/pointy-rw.t
S04-blocks-and-statements/pointy.t
S04-blocks-and-statements/temp.t
S04-declarations/constant.t
S04-declarations/constant-6.d.t
S04-declarations/implicit-parameter.t
S04-declarations/multiple.t
S04-declarations/my.t
ProTip! Use n and p to navigate between commits in a pull request.