make 'my %h; %h<a>=1; say %h<a>:p(0)' work

gistfile1.txt

diff --git a/src/core/Any.pm b/src/core/Any.pm
index 6c4a831..a0086ed 100644
--- a/src/core/Any.pm
+++ b/src/core/Any.pm
@@ -794,10 +794,14 @@ sub SLICE_ONE ( \SELF, $one, $array, *%adv ) is hidden_from_backtrace {
         elsif %a.exists_key('p') {            # :!delete?:p(0|1):*
             my $p := %a.delete_key('p');
             if !%a {                            # :!delete?:p(0|1)
-                !$p | $ex(SELF,$one)
-                  ?? RWPAIR($one,
-                       $array ?? SELF.at_pos($one) !! SELF.at_key($one))
-                  !! ();
+                if $ex(SELF,$one) {
+                    $p ?? RWPAIR($one,
+                        $array ?? SELF.at_pos($one) !! SELF.at_key($one))
+                       !! ($array ?? SELF.at_pos($one) !! SELF.at_key($one));
+                }
+                else {
+                    ();
+                }
             }
             else {
                 @nogo = <p>;

After this modification a basic example of passing :p() works:

$ perl6 -e 'my %h; %h<a>=1; say %h<a>:p'
"a" => 1
$ perl6 -e 'my %h; %h<a>=1; say %h<a>:p(0)'
1

since this is a hot path, we probably want to use ternaries instead of full blown -if-

diff --git a/src/core/Any.pm b/src/core/Any.pm
index 6c4a831..d328762 100644
--- a/src/core/Any.pm
+++ b/src/core/Any.pm
@@ -794,9 +794,11 @@ sub SLICE_ONE ( \SELF, $one, $array, *%adv ) is hidden_from
         elsif %a.exists_key('p') {            # :!delete?:p(0|1):*
             my $p := %a.delete_key('p');
             if !%a {                            # :!delete?:p(0|1)
-                !$p | $ex(SELF,$one)
-                  ?? RWPAIR($one,
-                       $array ?? SELF.at_pos($one) !! SELF.at_key($one))
+                $ex(SELF,$one)
+                  ?? $p
+                     ?? RWPAIR($one,
+                          $array ?? SELF.at_pos($one) !! SELF.at_key($one))
+                     !!   $array ?? SELF.at_pos($one) !! SELF.at_key($one)
                   !! ();
             }
             else {

For the records: Actually I missed the following bit from S02: "These adverbial forms all weed out non-existing entries if the adverb is true; if not, they leave them in, just as an ordinary slice would."

So the current implementation seems to be correct and my initial patch doesn't make any sense.

$ perl6 -e 'my %h; %h<a>=1; say %h<a>:p'
"a" => 1
$ perl6-m -e 'my %h; %h<a>=1; say %h<a>:p(0)'
"a" => 1
$ perl6-m -e 'my %h; %h<a>=1; say %h<b>:p  ## non-existing key'

$ perl6-m -e 'my %h; %h<a>=1; say %h<b>:p(0)  ## non-existing key'
"b" => Any

But on a related note (lizmat mentioned the ternaries): If I modify the original code it seems to run faster:

diff --git a/src/core/Any.pm b/src/core/Any.pm
index 6c4a831..6b0924e 100644
--- a/src/core/Any.pm
+++ b/src/core/Any.pm
@@ -794,10 +794,13 @@ sub SLICE_ONE ( \SELF, $one, $array, *%adv ) is hidden_from_backtrace {
         elsif %a.exists_key('p') {            # :!delete?:p(0|1):*
             my $p := %a.delete_key('p');
             if !%a {                            # :!delete?:p(0|1)
-                !$p | $ex(SELF,$one)
-                  ?? RWPAIR($one,
-                       $array ?? SELF.at_pos($one) !! SELF.at_key($one))
-                  !! ();
+                $ex(SELF,$one)
+                    ?? RWPAIR($one,
+                        $array ?? SELF.at_pos($one) !! SELF.at_key($one))
+                    !! !$p
+                        ?? RWPAIR($one,
+                            $array ?? SELF.at_pos($one) !! SELF.at_key($one))
+                        !! ();
             }
             else {
                 @nogo = <p>;

A naive timing for 4 different cases with current Rakudo:

$ perl6-m -e 'my %h; %h<a>=1; for ^5000 {%h<b>:!p}; END { say now - BEGIN now }'
3.5169272
$ perl6-m -e 'my %h; %h<a>=1; for ^5000 {%h<b>:p}; END { say now - BEGIN now }'
3.5344087
$ perl6-m -e 'my %h; %h<a>=1; for ^5000 {%h<a>:!p}; END { say now - BEGIN now }'
3.45983741
$ perl6-m -e 'my %h; %h<a>=1; for ^5000 {%h<a>:p}; END { say now - BEGIN now }'
3.4808253

The same commands with mentioned changes:

$ perl6-m -e 'my %h; %h<a>=1; for ^5000 {%h<b>:!p}; END { say now - BEGIN now }'
2.4890475
$ perl6-m -e 'my %h; %h<a>=1; for ^5000 {%h<b>:p}; END { say now - BEGIN now }'
2.40067595
$ perl6-m -e 'my %h; %h<a>=1; for ^5000 {%h<a>:!p}; END { say now - BEGIN now }'
2.4183241
$ perl6-m -e 'my %h; %h<a>=1; for ^5000 {%h<a>:p}; END { say now - BEGIN now }'
2.4305510