Skip to content

Commit

Permalink
handle Type:D and Type:U on variables and attributes
Browse files Browse the repository at this point in the history 
`my Int:D $foo` compiles to something like `my Int $foo where *.defined = 0`
now.  Some occurrences of Int:D in the setting had to be removed because at
the time it is compiled we can't instanciate Pair.  And we need Pair to add
the constraint to the variable or attribute.
However, these occurrences had no affect yet anyway.
  • Loading branch information
@FROGGS
FROGGS committed Oct 5, 2015
1 parent 2765b6a commit 8dd7440
Show file tree
Hide file tree
Showing 4 changed files with 62 additions and 21 deletions.
51 changes: 46 additions & 5 deletions src/Perl6/Actions.nqp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2406,19 +2406,19 @@ Compilation unit '$file' contained the following violations:
}
elsif $<signature> {
# Go over the params and declare the variable defined in them.
my class FakeOfType { has $!type; method ast() { $!type } }
my $list := QAST::Op.new( :op('call'), :name('&infix:<,>') );
my @params := $<signature>.ast<parameters>;
my $common_of := $*OFTYPE;
for @params {
my $*OFTYPE := $common_of;
if nqp::existskey($_, 'of_type') {
if nqp::existskey($_, 'of_type') && nqp::existskey($_, 'of_type_match') {
if $common_of {
($_<node> // $<signature>).CURSOR.typed_sorry(
'X::Syntax::Variable::ConflictingTypes',
outer => $common_of.ast, inner => $_<of_type>);
}
$*OFTYPE := FakeOfType.new(type => $_<of_type>);
$*OFTYPE := $_<of_type_match>;
$*OFTYPE.make($_<of_type>);
}
if $_<variable_name> {
my $past := QAST::Var.new( :name($_<variable_name>) );
Expand Down Expand Up @@ -2562,7 +2562,7 @@ Compilation unit '$file' contained the following violations:
$/.CURSOR.panic("Cannot declare an anonymous attribute");
}
my $attrname := ~$sigil ~ '!' ~ $desigilname;
my %cont_info := $*W.container_type_info($/, $sigil, $*OFTYPE ?? [$*OFTYPE.ast] !! [], $shape, :@post);
my %cont_info := container_type_info($/, $sigil, $*OFTYPE ?? [$*OFTYPE] !! [], $shape, :@post);
my $descriptor := $*W.create_container_descriptor(
%cont_info<value_type>, 1, $attrname, %cont_info<default_value>);

Expand Down Expand Up @@ -2632,7 +2632,7 @@ Compilation unit '$file' contained the following violations:

# Create a container descriptor. Default to rw and set a
# type if we have one; a trait may twiddle with that later.
my %cont_info := $*W.container_type_info($/, $sigil, $*OFTYPE ?? [$*OFTYPE.ast] !! [], $shape, :@post);
my %cont_info := container_type_info($/, $sigil, $*OFTYPE ?? [$*OFTYPE] !! [], $shape, :@post);
my $descriptor := $*W.create_container_descriptor(
%cont_info<value_type>, 1, $varname || $name, %cont_info<default_value>);

Expand Down Expand Up @@ -2704,6 +2704,46 @@ Compilation unit '$file' contained the following violations:
$past
}

sub container_type_info($/, $sigil, @value_type, $shape, :@post) {
if @value_type {
my $of := @value_type[0].ast;
my $D;
my $U;
for (@value_type[0]<longname> ?? @value_type[0]<longname><colonpair> !! @value_type[0]<colonpair>) {
if $_<identifier> {
if $_<identifier>.Str eq 'D' {
$D := 1;
}
elsif $_<identifier>.Str eq 'U' {
$U := 1;
}
else {
nqp::die("Unsupported type smiley '" ~ $_<identifier>.Str ~ "' used in type name");
}
}
}

if $D {
my $Pair := $*W.find_symbol(['Pair']);
@post.push($Pair.new('defined', 1));
$*W.container_type_info($/, $sigil, [$of], $shape, :@post,
:subset_name(~@value_type[0]), :default_value($of.new()));
}
elsif $U {
my $Pair := $*W.find_symbol(['Pair']);
@post.push($Pair.new('defined', 0));
$*W.container_type_info($/, $sigil, [$of], $shape, :@post,
:subset_name(~@value_type[0]));
}
else {
$*W.container_type_info($/, $sigil, [$of], $shape, :@post);
}
}
else {
$*W.container_type_info($/, $sigil, [], $shape, :@post);
}
}

sub add_lexical_accessor($/, $var_past, $meth_name, $install_in) {
# Generate and install code block for accessor.
my $a_past := $*W.push_lexpad($/);
Expand Down Expand Up @@ -4362,6 +4402,7 @@ Compilation unit '$file' contained the following violations:
$<typename>.CURSOR.typed_sorry('X::Parameter::BadType', :$type);
}
%*PARAM_INFO<of_type> := %*PARAM_INFO<nominal_type>;
%*PARAM_INFO<of_type_match> := $<typename>;
for ($<typename><longname> ?? $<typename><longname><colonpair> !! $<typename><colonpair>) {
if $_<identifier> {
if $_<identifier>.Str eq 'D' {
Expand Down
6 changes: 3 additions & 3 deletions src/Perl6/World.nqp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1221,14 +1221,14 @@ class Perl6::World is HLL::World {
# attribute/lexpad), bind constraint (what could we bind to this
# slot later), and if specified a constraint on the inner value
# and a default value.
method container_type_info($/, $sigil, @value_type, $shape?, :@post) {
method container_type_info($/, $sigil, @value_type, $shape?, :@post, :$subset_name, :$default_value) {
my %info;
%info<sigil> := $sigil;
@value_type[0] := nqp::decont(@value_type[0]) if @value_type;
for @post -> $con {
@value_type[0] := self.create_subset(self.resolve_mo($/, 'subset'),
@value_type ?? @value_type[0] !! self.find_symbol(['Mu']),
$con);
$con, :name($subset_name));
}
if $sigil eq '@' {
%info<bind_constraint> := self.find_symbol(['Positional']);
Expand Down Expand Up @@ -1319,7 +1319,7 @@ class Perl6::World is HLL::World {
if @value_type {
%info<bind_constraint> := @value_type[0];
%info<value_type> := @value_type[0];
%info<default_value> := @value_type[0];
%info<default_value> := $default_value // @value_type[0];
}
else {
%info<bind_constraint> := self.find_symbol(['Mu']);
Expand Down
14 changes: 7 additions & 7 deletions src/core/Range.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -79,7 +79,7 @@ my class Range is Cool does Iterable does Positional {
method elems {
return Inf if $!min === -Inf || $!max === Inf;
if nqp::istype($!min, Int) && nqp::istype($!max, Int) {
my Int:D $least =
my Int $least =
$!excludes-min ?? $!min + 1 !! $!min;
return 1 + ($!excludes-max ?? $!max.Int - 1 !! $!max.Int) - $least;
}
Expand Down Expand Up @@ -226,19 +226,19 @@ my class Range is Cool does Iterable does Positional {
return self.list.roll
unless nqp::istype($!min, Int) && nqp::istype($!max, Numeric);

my Int:D $least =
my Int $least =
$!excludes-min ?? $!min + 1 !! $!min;
my Int:D $elems =
my Int $elems =
1 + ($!excludes-max ?? $!max.Int - 1 !! $!max.Int) - $least;
$elems ?? ($least + nqp::rand_I(nqp::decont($elems), Int)) !! Any;
}
multi method roll(Int(Cool) $num) {
return self.list.roll($num)
unless nqp::istype($!min, Int) && nqp::istype($!max, Numeric);

my Int:D $least =
my Int $least =
$!excludes-min ?? $!min + 1 !! $!min;
my Int:D $elems =
my Int $elems =
1 + ($!excludes-max ?? $!max.Int - 1 !! $!max.Int) - $least;

my int $todo = nqp::unbox_i($num.Int);
Expand All @@ -260,9 +260,9 @@ my class Range is Cool does Iterable does Positional {
return self.list.pick($n)
unless nqp::istype($!min, Int) && nqp::istype($!max, Numeric);

my Int:D $least =
my Int $least =
$!excludes-min ?? $!min + 1 !! $!min;
my Int:D $elems =
my Int $elems =
1 + ($!excludes-max ?? $!max.Int - 1 !! $!max.Int) - $least;
my int $todo = nqp::unbox_i($n.Int);

Expand Down
12 changes: 6 additions & 6 deletions src/core/allomorphs.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -198,7 +198,7 @@ multi sub val(Str $MAYBEVAL, :$val-or-fail = False) {

my sub parse-int-frac-exp() {
# Integer part, if any
my Int:D $int := 0;
my Int $int := 0;
if nqp::isne_i($ch, 46) { # '.'
parse_fail "Cannot convert radix of $radix (max 36)"
if $radix > 36;
Expand All @@ -218,8 +218,8 @@ multi sub val(Str $MAYBEVAL, :$val-or-fail = False) {
}

# Fraction, if any
my Int:D $frac := 0;
my Int:D $base := 0;
my Int $frac := 0;
my Int $base := 0;
if nqp::iseq_i($ch, 46) { # '.'
$pos = nqp::add_i($pos, 1);
$parse := nqp::radix_I($radix, $str, $pos,
Expand Down Expand Up @@ -279,7 +279,7 @@ multi sub val(Str $MAYBEVAL, :$val-or-fail = False) {
return $int unless $base;

# Otherwise, return a Rat
my Int:D $numerator := $int * $base + $frac;
my Int $numerator := $int * $base + $frac;
return Rat.new($numerator, $base);
}

Expand Down Expand Up @@ -321,8 +321,8 @@ multi sub val(Str $MAYBEVAL, :$val-or-fail = False) {
}
elsif nqp::iseq_i($ch, 91) { # '['
$pos = nqp::add_i($pos, 1);
my Int:D $result := 0;
my Int:D $digit := 0;
my Int $result := 0;
my Int $digit := 0;
while nqp::islt_i($pos, $eos)
&& nqp::isne_i(nqp::ord($str, $pos), 93) { # ']'
$parse := nqp::radix_I(10, $str, $pos, 0, Int);
Expand Down

0 comments on commit 8dd7440

Please sign in to comment.