Allow push/pop/keys/etc to act on references

All built-in functions that operate directly on array or hash
containers now also accept hard references to arrays or hashes:

  |----------------------------+---------------------------|
  | Traditional syntax         | Terse syntax              |
  |----------------------------+---------------------------|
  | push @$arrayref, @stuff    | push $arrayref, @stuff    |
  | unshift @$arrayref, @stuff | unshift $arrayref, @stuff |
  | pop @$arrayref             | pop $arrayref             |
  | shift @$arrayref           | shift $arrayref           |
  | splice @$arrayref, 0, 2    | splice $arrayref, 0, 2    |
  | keys %$hashref             | keys $hashref             |
  | keys @$arrayref            | keys $arrayref            |
  | values %$hashref           | values $hashref           |
  | values @$arrayref          | values $arrayref          |
  | ($k,$v) = each %$hashref   | ($k,$v) = each $hashref   |
  | ($k,$v) = each @$arrayref  | ($k,$v) = each $arrayref  |
  |----------------------------+---------------------------|

This allows these built-in functions to act on long dereferencing
chains or on the return value of subroutines without needing to wrap
them in C<@{}> or C<%{}>:

  push @{$obj->tags}, $new_tag;  # old way
  push $obj->tags,    $new_tag;  # new way

  for ( keys %{$hoh->{genres}{artists}} ) {...} # old way
  for ( keys $hoh->{genres}{artists}    ) {...} # new way

For C<push>, C<unshift> and C<splice>, the reference will auto-vivify
if it is not defined, just as if it were wrapped with C<@{}>.

Calling C<keys> or C<values> directly on a reference gives a
substantial performance improvement over explicit dereferencing.

For C<keys>, C<values>, C<each>, when overloaded dereferencing is
present, the overloaded dereference is used instead of dereferencing
the underlying reftype.  Warnings are issued about assumptions made in
the following three ambiguous cases:

  (a) If both %{} and @{} overloading exists, %{} is used
  (b) If %{} overloading exists on a blessed arrayref, %{} is used
  (c) If @{} overloading exists on a blessed hashref, @{} is used

1 files changed, 79 insertions, 2 deletions

diff --git a/pp.c b/pp.c
index c73fdbf115..4e4555546f 100644
--- a/pp.c
+++ b/pp.c
@@ -429,7 +429,19 @@ PP(pp_prototype)
 		    goto set;
 		}
 		if (code == -KEY_keys || code == -KEY_values || code == -KEY_each) {
-		    ret = newSVpvs_flags("\\[@%]", SVs_TEMP);
+		    ret = newSVpvs_flags("+", SVs_TEMP);
+		    goto set;
+		}
+		if (code == -KEY_push || code == -KEY_unshift) {
+		    ret = newSVpvs_flags("+@", SVs_TEMP);
+		    goto set;
+		}
+		if (code == -KEY_pop || code == -KEY_shift) {
+		    ret = newSVpvs_flags(";+", SVs_TEMP);
+		    goto set;
+		}
+		if (code == -KEY_splice) {
+		    ret = newSVpvs_flags("+;$$@", SVs_TEMP);
 		    goto set;
 		}
 		if (code == -KEY_tied || code == -KEY_untie) {
@@ -4625,6 +4637,71 @@ PP(pp_aslice)
     RETURN;
 }
 
+/* Smart dereferencing for keys, values and each */
+PP(pp_rkeys)
+{
+    dVAR;
+    dSP;
+    dPOPss;
+
+    if (!SvOK(sv))
+	RETURN;
+
+    if (SvROK(sv)) {
+	SvGETMAGIC(sv);
+	if (SvAMAGIC(sv)) {
+	    /* N.B.: AMG macros return sv if no overloading is found */
+	    SV *maybe_hv = AMG_CALLun_var(sv,to_hv_amg);
+	    SV *maybe_av = AMG_CALLun_var(sv,to_av_amg);
+	    if ( maybe_hv != sv && maybe_av != sv ) {
+		Perl_ck_warner(aTHX_ packWARN(WARN_AMBIGUOUS), "%s",
+		    Perl_form(aTHX_ "Ambiguous overloaded argument to %s resolved as %%{}",
+			PL_op_desc[PL_op->op_type]
+		    )
+		);
+		sv = maybe_hv;
+	    }
+	    else if ( maybe_av != sv ) {
+		if ( SvTYPE(SvRV(sv)) == SVt_PVHV ) {
+		    /* @{} overload, but underlying reftype is HV */
+		    Perl_ck_warner(aTHX_ packWARN(WARN_AMBIGUOUS), "%s",
+			Perl_form(aTHX_ "Ambiguous overloaded argument to %s resolved as @{}",
+			    PL_op_desc[PL_op->op_type]
+			)
+		    );
+		}
+		sv = maybe_av;
+	    }
+	    else if ( maybe_hv != sv ) {
+		if ( SvTYPE(SvRV(sv)) == SVt_PVAV ) {
+		    /* %{} overload, but underlying reftype is AV */
+		    Perl_ck_warner(aTHX_ packWARN(WARN_AMBIGUOUS), "%s",
+			Perl_form(aTHX_ "Ambiguous overloaded argument to %s resolved as %%{}",
+			    PL_op_desc[PL_op->op_type]
+			)
+		    );
+		}
+		sv = maybe_hv;
+	    }
+	}
+	sv = SvRV(sv);
+    }
+
+    if ( SvTYPE(sv) != SVt_PVHV && SvTYPE(sv) != SVt_PVAV ) {
+	DIE(aTHX_ Perl_form(aTHX_ "Type of argument to %s must be hashref or arrayref",
+	    PL_op_desc[PL_op->op_type] ));
+    }
+
+    /* Delegate to correct function for op type */
+    PUSHs(sv);
+    if (PL_op->op_type == OP_RKEYS || PL_op->op_type == OP_RVALUES) {
+	return (SvTYPE(sv) == SVt_PVHV) ? Perl_do_kv(aTHX) : Perl_pp_akeys(aTHX);
+    }
+    else {
+	return (SvTYPE(sv) == SVt_PVHV) ? Perl_pp_each(aTHX) : Perl_pp_aeach(aTHX);
+    }
+}
+
 PP(pp_aeach)
 {
     dVAR;
@@ -4670,7 +4747,7 @@ PP(pp_akeys)
 
         EXTEND(SP, n + 1);
 
-	if (PL_op->op_type == OP_AKEYS) {
+	if (PL_op->op_type == OP_AKEYS || PL_op->op_type == OP_RKEYS) {
 	    n += i;
 	    for (;  i <= n;  i++) {
 		mPUSHi(i);