]> git.vpit.fr Git - perl/modules/autovivification.git/blobdiff - autovivification.xs
Bump copyright year
[perl/modules/autovivification.git] / autovivification.xs
index 34cd2da1d2f95747a38c518f1b58063fd2966d8d..554056c1c53a024050d703df2f08cb0346b2093f 100644 (file)
 #define A_HINT_WARN   2
 #define A_HINT_FETCH  4
 #define A_HINT_STORE  8
-#define A_HINT_EXISTS 16
-#define A_HINT_DELETE 32
+#define A_HINT_KEYS   16
+#define A_HINT_VALUES 32
+#define A_HINT_EXISTS 64
+#define A_HINT_DELETE 128
 #define A_HINT_NOTIFY (A_HINT_STRICT|A_HINT_WARN)
-#define A_HINT_DO     (A_HINT_FETCH|A_HINT_STORE|A_HINT_EXISTS|A_HINT_DELETE)
+#define A_HINT_DO     (A_HINT_FETCH|A_HINT_STORE|A_HINT_KEYS|A_HINT_VALUES|A_HINT_EXISTS|A_HINT_DELETE)
 #define A_HINT_MASK   (A_HINT_NOTIFY|A_HINT_DO)
 
 /* Only used in op flags */
-#define A_HINT_ROOT   64
-#define A_HINT_DEREF  128
+#define A_HINT_ROOT   256
+#define A_HINT_SECOND 512
+#define A_HINT_DEREF  1024
 
 #define XSH_HINTS_TYPE_UV 1
 
 # define A_HAS_MULTIDEREF XSH_HAS_PERL(5, 21, 7)
 #endif
 
+#ifndef A_HAS_SCALARKEYS_OPT
+# define A_HAS_SCALARKEYS_OPT XSH_HAS_PERL(5, 27, 3)
+#endif
+
 /* ... Our vivify_ref() .................................................... */
 
 /* Perl_vivify_ref() is not exported, so we have to reimplement it. */
@@ -231,17 +238,18 @@ static void a_map_store_root(pTHX_ const OP *root, OP *(*old_pp)(pTHX), UV flags
  return;
 }
 
-static void a_map_update_flags_topdown(const OP *root, UV flags) {
+static void a_map_update_flags_topdown(const OP *root, UV mask, UV flags) {
  a_op_info *oi;
  const OP *o = root;
 
  XSH_LOCK(&a_op_map_mutex);
 
- flags &= ~A_HINT_ROOT;
+ mask  |= A_HINT_ROOT;
+ flags &= ~mask;
 
  do {
   if ((oi = ptable_fetch(a_op_map, o)))
-   oi->flags = (oi->flags & A_HINT_ROOT) | flags;
+   oi->flags = (oi->flags & mask) | flags;
   if (!(o->op_flags & OPf_KIDS))
    break;
   o = a_map_descend(o);
@@ -252,8 +260,6 @@ static void a_map_update_flags_topdown(const OP *root, UV flags) {
  return;
 }
 
-#define a_map_cancel(R) a_map_update_flags_topdown((R), 0)
-
 static void a_map_update_flags_bottomup(const OP *o, UV flags, UV rflags) {
  a_op_info *oi;
 
@@ -294,8 +300,10 @@ static UV a_map_resolve(const OP *o, const a_op_info *oi) {
  if (root->op_flags & OPf_MOD) {
   if (rflags & A_HINT_STORE)
    flags = (A_HINT_STORE|A_HINT_DEREF);
- } else if (rflags & A_HINT_FETCH)
-   flags = (A_HINT_FETCH|A_HINT_DEREF);
+ } else {
+  if (rflags & (A_HINT_FETCH|A_HINT_KEYS|A_HINT_VALUES))
+   flags = (rflags|A_HINT_DEREF);
+ }
 
  if (!flags) {
 cancel:
@@ -404,6 +412,29 @@ static OP *a_pp_rv2hv(pTHX) {
  return oi->old_pp(aTHX);
 }
 
+#if A_HAS_SCALARKEYS_OPT
+
+static OP *a_pp_rv2hv_dokeys(pTHX) {
+ dA_MAP_THX;
+ const a_op_info *oi;
+ dSP;
+
+ oi = a_map_fetch(PL_op);
+
+ if (oi->flags & A_HINT_KEYS) {
+  if (a_undef(TOPs)) {
+   dTARGET;
+   (void) POPs;
+   PUSHi(0);
+   RETURN;
+  }
+ }
+
+ return oi->old_pp(aTHX);
+}
+
+#endif
+
 /* ... pp_deref (aelem,helem,rv2sv,padsv) .................................. */
 
 static void a_cannot_vivify(pTHX_ UV flags) {
@@ -1001,23 +1032,36 @@ static OP *a_ck_root(pTHX_ OP *o) {
   case OP_KEYS:
    old_ck  = a_old_ck_keys;
    new_pp  = a_pp_root_unop;
-   enabled = hint & A_HINT_FETCH;
+   enabled = hint & A_HINT_KEYS;
    break;
   case OP_VALUES:
    old_ck  = a_old_ck_values;
    new_pp  = a_pp_root_unop;
-   enabled = hint & A_HINT_FETCH;
+   enabled = hint & A_HINT_VALUES;
    break;
  }
  o = old_ck(aTHX_ o);
 
  if (hint & A_HINT_DO) {
   if (enabled) {
-   a_map_update_flags_topdown(o, hint | A_HINT_DEREF);
+#if A_HAS_SCALARKEYS_OPT
+   if ((enabled == A_HINT_KEYS) && (o->op_flags & OPf_KIDS)) {
+    OP *kid = cUNOPo->op_first;
+    if (kid->op_type == OP_RV2HV) {
+     dA_MAP_THX;
+     const a_op_info *koi = a_map_fetch(kid);
+     a_map_store(kid, koi ? koi->old_pp : kid->op_ppaddr, NULL,
+                      hint | A_HINT_SECOND);
+     if (!koi)
+      kid->op_ppaddr = a_pp_rv2hv;
+    }
+   }
+#endif
+   a_map_update_flags_topdown(o, A_HINT_SECOND, hint | A_HINT_DEREF);
    a_map_store_root(o, o->op_ppaddr, hint);
    o->op_ppaddr = new_pp;
   } else {
-   a_map_cancel(o);
+   a_map_update_flags_topdown(o, 0, 0);
   }
  } else
   a_map_delete(o);
@@ -1068,16 +1112,34 @@ static void xsh_peep_rec(pTHX_ OP *o, ptable *seen) {
      o->op_ppaddr  = oi->old_pp;
     break;
    case OP_RV2AV:
-   case OP_RV2HV:
-    if (   o->op_ppaddr != a_pp_rv2av
-        && o->op_ppaddr != a_pp_rv2hv
-        && o->op_ppaddr != a_pp_rv2hv_simple)
+    if (o->op_ppaddr != a_pp_rv2av)
      break;
     oi = a_map_fetch(o);
     if (!oi)
      break;
     if (!(oi->flags & A_HINT_DEREF))
-     o->op_ppaddr  = oi->old_pp;
+     o->op_ppaddr = oi->old_pp;
+    break;
+   case OP_RV2HV:
+    if (o->op_ppaddr != a_pp_rv2hv && o->op_ppaddr != a_pp_rv2hv_simple)
+     break;
+    oi = a_map_fetch(o);
+    if (!oi)
+     break;
+    if (!(oi->flags & A_HINT_DEREF)) {
+     o->op_ppaddr = oi->old_pp;
+     break;
+    }
+#if A_HAS_SCALARKEYS_OPT
+    flags = oi->flags;
+    if ((flags & A_HINT_KEYS) && (flags & A_HINT_SECOND)) {
+     U8 want = o->op_flags & OPf_WANT;
+     if (want == OPf_WANT_VOID || want == OPf_WANT_SCALAR)
+      o->op_ppaddr = a_pp_rv2hv_dokeys;
+     else if (oi->old_pp == a_pp_rv2hv || oi->old_pp == a_pp_rv2hv_simple)
+      o->op_ppaddr = oi->old_pp;
+    }
+#endif
     break;
 #if A_HAS_MULTIDEREF
    case OP_MULTIDEREF:
@@ -1138,6 +1200,8 @@ static void xsh_user_local_setup(pTHX) {
  newCONSTSUB(stash, "A_HINT_WARN",   newSVuv(A_HINT_WARN));
  newCONSTSUB(stash, "A_HINT_FETCH",  newSVuv(A_HINT_FETCH));
  newCONSTSUB(stash, "A_HINT_STORE",  newSVuv(A_HINT_STORE));
+ newCONSTSUB(stash, "A_HINT_KEYS",   newSVuv(A_HINT_KEYS));
+ newCONSTSUB(stash, "A_HINT_VALUES", newSVuv(A_HINT_VALUES));
  newCONSTSUB(stash, "A_HINT_EXISTS", newSVuv(A_HINT_EXISTS));
  newCONSTSUB(stash, "A_HINT_DELETE", newSVuv(A_HINT_DELETE));
  newCONSTSUB(stash, "A_HINT_MASK",   newSVuv(A_HINT_MASK));