Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Migrate from at_key c.s. to AT-KEY 
This is a proof-of-concept of changing the infamous implementation specific
internal methods for accessing arrays and hashes into something more release
ready.  The following transformations were done:

OLD             NEW
at_pos          AT-POS
exists_pos      EXISTS-POS
delete_pos      DELETE-POS
assign_pos      ASSIGN-POS
bind_pos        BIND-POS
at_key          AT-KEY
exists_key      EXISTS-KEY
delete_key      DELETE-KEY
assign_key      ASSIGN-KEY
bind_key        BIND-KEY

All of the methods have a catch method with DEPRECATION message to ensure
anyting out there in the ecosystem will continue to work.

Please feel free to revert if this change does not get consensus.
  • Loading branch information
@lizmat
lizmat committed Mar 7, 2015
1 parent b497d41 commit 80d506d
Show file tree
Hide file tree
Showing 46 changed files with 486 additions and 435 deletions.
8 changes: 4 additions & 4 deletions src/Perl6/World.nqp
View file
Expand Up @@ -2148,15 +2148,15 @@ class Perl6::World is HLL::World {
self.create_container_descriptor($mu, 1, '!INIT_VALUES'));
}
$*UNIT[0].push(QAST::Op.new(
:op('callmethod'), :name('bind_key'),
:op('callmethod'), :name('BIND-KEY'),
QAST::Var.new( :name('!INIT_VALUES'), :scope('lexical') ),
QAST::SVal.new( :value($phaser_past.cuid) ),
QAST::Op.new(
:op('call'),
QAST::WVal.new( :value($block) )
)));
return QAST::Op.new(
:op('callmethod'), :name('at_key'),
:op('callmethod'), :name('AT-KEY'),
QAST::Var.new( :name('!INIT_VALUES'), :scope('lexical') ),
QAST::SVal.new( :value($phaser_past.cuid) )
);
Expand Down Expand Up @@ -2703,10 +2703,10 @@ class Perl6::World is HLL::World {
}
}

# The final lookup will always be just an at_key call on a Stash.
# The final lookup will always be just an AT-KEY call on a Stash.
my $final_name := @name.pop();
my $lookup := QAST::Op.new(
:op('callmethod'), :name('at_key'),
:op('callmethod'), :name('AT-KEY'),
self.add_constant('Str', 'str', $final_name));

# If there's no explicit qualification, then look it up in the
Expand Down
180 changes: 116 additions & 64 deletions src/core/Any.pm
View file
Expand Up @@ -15,19 +15,34 @@ my class Any { # declared in BOOTSTRAP

multi method ACCEPTS(Any:D: Mu \a) { self === a }

proto method exists_key(|){ * }
multi method exists_key(Any:U: $) { False }
multi method exists_key(Any:D: $) { False }
method exists_key(|c) {
DEPRECATED('EXISTS-KEY',|<2014.03 2015.03>);
self.EXISTS-KEY(|c);
}

proto method EXISTS-KEY(|){ * }
multi method EXISTS-KEY(Any:U: $) { False }
multi method EXISTS-KEY(Any:D: $) { False }

method delete_key(|c) {
DEPRECATED('DELETE-KEY',|<2014.03 2015.03>);
self.DELETE-KEY(|c);
}

proto method delete_key(|) { * }
multi method delete_key(Any:U: $) { Nil }
multi method delete_key(Any:D: $) {
proto method DELETE-KEY(|) { * }
multi method DELETE-KEY(Any:U: $) { Nil }
multi method DELETE-KEY(Any:D: $) {
fail "Can not remove values from a {self.^name}";
}

proto method delete_pos(|) { * }
multi method delete_pos(Any:U: $pos) { Nil }
multi method delete_pos(Any:D: $pos) {
method delete_pos(|c) {
DEPRECATED('DELETE-POS',|<2014.03 2015.03>);
self.DELETE-POS(|c);
}

proto method DELETE-POS(|) { * }
multi method DELETE-POS(Any:U: $pos) { Nil }
multi method DELETE-POS(Any:D: $pos) {
fail "Can not remove elements from a {self.^name}";
}

Expand Down Expand Up @@ -93,15 +108,15 @@ my class Any { # declared in BOOTSTRAP
my int $elems = self.elems;

gather while $i < $elems {
my Mu $it := $list.at_pos($i++);
my Mu $it := $list.AT-POS($i++);
if nqp::istype($it,Enum) {
take $it.key => $it.value;
}
elsif nqp::istype($it,EnumMap) and !nqp::iscont($it) {
take $it.pairs;
}
elsif $i < $elems {
take $it => $list.at_pos($i++);
take $it => $list.AT-POS($i++);
}
else {
X::Pairup::OddNumber.new.throw;
Expand Down Expand Up @@ -300,7 +315,7 @@ my class Any { # declared in BOOTSTRAP
my int $index = $elems;
while $index {
$index = $index - 1;
return nqp::box_i($index,Int) if self.at_pos($index).match($test);
return nqp::box_i($index,Int) if self.AT-POS($index).match($test);
}
Nil;
}
Expand All @@ -311,7 +326,7 @@ my class Any { # declared in BOOTSTRAP
my int $index = $elems;
while $index {
$index = $index - 1;
return nqp::box_i($index,Int) if $test(self.at_pos($index));
return nqp::box_i($index,Int) if $test(self.AT-POS($index));
}
Nil;
}
Expand All @@ -322,7 +337,7 @@ my class Any { # declared in BOOTSTRAP
my int $index = $elems;
while $index {
$index = $index - 1;
return nqp::box_i($index,Int) if self.at_pos($index) ~~ $test;
return nqp::box_i($index,Int) if self.AT-POS($index) ~~ $test;
}
Nil;
}
Expand Down Expand Up @@ -417,96 +432,116 @@ my class Any { # declared in BOOTSTRAP
:excludes-max($excludes-max));
}

proto method exists_pos(|) { * }
multi method exists_pos(Any:U: Any:D $) { False }
multi method exists_pos(Any:U: Any:U $pos) is rw {
method exists_pos(|c) {
DEPRECATED('EXISTS-POS',|<2014.03 2015.03>);
self.EXISTS-POS(|c);
}

proto method EXISTS-POS(|) { * }
multi method EXISTS-POS(Any:U: Any:D $) { False }
multi method EXISTS-POS(Any:U: Any:U $pos) is rw {
die "Cannot use '{$pos.^name}' as an index";
}

multi method exists_pos(Any:D: int \pos) {
multi method EXISTS-POS(Any:D: int \pos) {
nqp::p6bool(nqp::iseq_i(pos,0));
}
multi method exists_pos(Any:D: Int:D \pos) {
multi method EXISTS-POS(Any:D: Int:D \pos) {
pos == 0;
}
multi method exists_pos(Any:D: Num:D \pos) {
multi method EXISTS-POS(Any:D: Num:D \pos) {
X::Item.new(aggregate => self, index => pos).throw
if nqp::isnanorinf(pos);
self.at_pos(nqp::unbox_i(pos.Int));
self.AT-POS(nqp::unbox_i(pos.Int));
pos == 0;
}
multi method exists_pos(Any:D: Any:D \pos) {
multi method EXISTS-POS(Any:D: Any:D \pos) {
pos.Int == 0;
}
multi method exists_pos(Any:D: Any:U \pos) {
multi method EXISTS-POS(Any:D: Any:U \pos) {
die "Cannot use '{pos.^name}' as an index";
}

proto method at_pos(|) {*}
multi method at_pos(Any:U \SELF: int \pos) is rw {
method at_pos(|c) {
DEPRECATED('AT-POS',|<2014.03 2015.03>);
self.AT-POS(|c);
}

proto method AT-POS(|) {*}
multi method AT-POS(Any:U \SELF: int \pos) is rw {
nqp::bindattr(my $v, Scalar, '$!whence',
-> { SELF.defined || (SELF = Array.new);
SELF.bind_pos(pos, $v) });
SELF.BIND-POS(pos, $v) });
$v
}
multi method at_pos(Any:U \SELF: Int:D \pos) is rw {
multi method AT-POS(Any:U \SELF: Int:D \pos) is rw {
nqp::bindattr(my $v, Scalar, '$!whence',
-> { SELF.defined || (SELF = Array.new);
SELF.bind_pos(nqp::unbox_i(pos), $v) });
SELF.BIND-POS(nqp::unbox_i(pos), $v) });
$v
}
multi method at_pos(Any:U: Num:D \pos) is rw {
multi method AT-POS(Any:U: Num:D \pos) is rw {
fail X::Item.new(aggregate => self, index => pos)
if nqp::isnanorinf(pos);
self.at_pos(nqp::unbox_i(pos.Int));
self.AT-POS(nqp::unbox_i(pos.Int));
}
multi method at_pos(Any:U: Any:D \pos) is rw {
self.at_pos(nqp::unbox_i(pos.Int));
multi method AT-POS(Any:U: Any:D \pos) is rw {
self.AT-POS(nqp::unbox_i(pos.Int));
}

multi method at_pos(Any:D: int \pos) {
multi method AT-POS(Any:D: int \pos) {
fail X::OutOfRange.new(:what<Index>, :got(pos), :range<0..0>)
unless nqp::not_i(pos);
self;
}
multi method at_pos(Any:D: Int:D \pos) {
multi method AT-POS(Any:D: Int:D \pos) {
fail X::OutOfRange.new(:what<Index>, :got(pos), :range<0..0>)
if pos != 0;
self;
}
multi method at_pos(Any:D: Num:D \pos) {
multi method AT-POS(Any:D: Num:D \pos) {
fail X::Item.new(aggregate => self, index => pos)
if nqp::isnanorinf(pos);
self.at_pos(nqp::unbox_i(pos.Int));
self.AT-POS(nqp::unbox_i(pos.Int));
}
multi method at_pos(Any:D: Any:D \pos) {
self.at_pos(nqp::unbox_i(pos.Int));
multi method AT-POS(Any:D: Any:D \pos) {
self.AT-POS(nqp::unbox_i(pos.Int));
}

multi method at_pos(Any: Any:U \pos) is rw {
multi method AT-POS(Any: Any:U \pos) is rw {
die "Cannot use '{pos.^name}' as an index";
}

proto method assign_pos(|) { * }
multi method assign_pos(Any:U \SELF: \pos, Mu \assignee) {
SELF.at_pos(pos) = assignee; # defer < 0 check
method bind_pos(|c) {
DEPRECATED('BIND-POS',|<2014.03 2015.03>);
self.BIND-POS(|c);
}

method assign_pos(|c) {
DEPRECATED('ASSIGN-POS',|<2014.03 2015.03>);
self.ASSIGN-POS(|c);
}

proto method ASSIGN-POS(|) { * }
multi method ASSIGN-POS(Any:U \SELF: \pos, Mu \assignee) {
SELF.AT-POS(pos) = assignee; # defer < 0 check
}

multi method assign_pos(Any:D: int \pos, Mu \assignee) {
self.at_pos(pos) = assignee; # defer < 0 check
multi method ASSIGN-POS(Any:D: int \pos, Mu \assignee) {
self.AT-POS(pos) = assignee; # defer < 0 check
}
multi method assign_pos(Any:D: Int:D \pos, Mu \assignee) {
self.at_pos(pos) = assignee; # defer < 0 check
multi method ASSIGN-POS(Any:D: Int:D \pos, Mu \assignee) {
self.AT-POS(pos) = assignee; # defer < 0 check
}
multi method assign_pos(Any:D: Num:D \pos, Mu \assignee) {
multi method ASSIGN-POS(Any:D: Num:D \pos, Mu \assignee) {
fail X::Item.new(aggregate => self, index => pos)
if nqp::isnanorinf(pos);
self.at_pos(nqp::unbox_i(pos.Int)) = assignee; # defer < 0 check
self.AT-POS(nqp::unbox_i(pos.Int)) = assignee; # defer < 0 check
}
multi method assign_pos(Any:D: Any:D \pos, Mu \assignee) {
self.at_pos(nqp::unbox_i(pos.Int)) = assignee; # defer < 0 check
multi method ASSIGN-POS(Any:D: Any:D \pos, Mu \assignee) {
self.AT-POS(nqp::unbox_i(pos.Int)) = assignee; # defer < 0 check
}
multi method assign_pos(Any:D: Any:U \pos, Mu \assignee) {
multi method ASSIGN-POS(Any:D: Any:U \pos, Mu \assignee) {
die "Cannot use '{pos.^name}' as an index";
}

Expand All @@ -515,29 +550,46 @@ my class Any { # declared in BOOTSTRAP
method one() { one(self.list) }
method none() { none(self.list) }

method at_key(|c) {
DEPRECATED('AT-KEY',|<2014.03 2015.03>);
self.AT-KEY(|c);
}

# internals
proto method at_key(|) { * }
multi method at_key(Any:D: $key) {
proto method AT-KEY(|) { * }
multi method AT-KEY(Any:D: $key) {
fail "postcircumfix:<\{ \}> not defined for type {self.WHAT.perl}";
}
multi method at_key(Any:U \SELF: $key) is rw {
multi method AT-KEY(Any:U \SELF: $key) is rw {
nqp::bindattr(my $v, Scalar, '$!whence',
-> { SELF.defined || (SELF = Hash.new);
SELF.bind_key($key, $v) });
SELF.BIND-KEY($key, $v) });
$v
}
proto method bind_key(|) { * }
multi method bind_key(Any:D: $key, $BIND ) {

method bind_key(|c) {
DEPRECATED('BIND-KEY',|<2014.03 2015.03>);
self.BIND-KEY(|c);
}

proto method BIND-KEY(|) { * }
multi method BIND-KEY(Any:D: $key, $BIND ) {
fail "postcircumfix:<\{ \}> binding not defined for type {self.WHAT.perl}";
}
multi method bind_key(Any:U \SELF: $key, $BIND ) is rw {
multi method BIND-KEY(Any:U \SELF: $key, $BIND ) is rw {
SELF = Hash.new;
SELF.bind_key($key, $BIND);
SELF.BIND-KEY($key, $BIND);
$BIND
}
proto method assign_key(|) { * }
multi method assign_key(\SELF: \key, Mu \assignee) {
SELF.at_key(key) = assignee;

method assign_key(|c) {
DEPRECATED('ASSIGN-KEY',|<2014.03 2015.03>);
self.ASSIGN-KEY(|c);
}

proto method ASSIGN-KEY(|) { * }
multi method ASSIGN-KEY(\SELF: \key, Mu \assignee) {
SELF.AT-KEY(key) = assignee;
}

method FLATTENABLE_LIST() {
Expand Down Expand Up @@ -710,7 +762,7 @@ multi sub squish(*@values, |c) { @values.squish(|c) }

proto sub sort(|) {*}
multi sub sort(*@values) {
nqp::istype(@values.at_pos(0), Callable)
nqp::istype(@values.AT-POS(0), Callable)
?? SEQ(my $cmp := @values.shift; @values.sort($cmp) )
!! @values.sort;
}
Expand All @@ -736,7 +788,7 @@ sub OBJECT_HUH (\SELF) {

sub SLICE_HUH ( \SELF, @nogo, Mu $d, %adv ) is hidden_from_backtrace {
@nogo.unshift('delete') # recover any :delete if necessary
if @nogo && @nogo[0] ne 'delete' && %adv.exists_key('delete');
if @nogo && @nogo[0] ne 'delete' && %adv.EXISTS-KEY('delete');
for <delete exists kv p k v> -> $valid { # check all valid params
if nqp::existskey($d,nqp::unbox_s($valid)) {
nqp::deletekey($d,nqp::unbox_s($valid));
Expand Down

0 comments on commit 80d506d

Please sign in to comment.