Add slice syntax to localize_{elem,delete}

[perl/modules/Scope-Upper.git] / Upper.xs

diff --git a/Upper.xs b/Upper.xs
index e54e42cda5767985ed2bd9a2942dd3dd87bdf326..5c3dec6a65ce1913e42dc5c8bcf4f0d419bde191 100644 (file)
--- a/Upper.xs
+++ b/Upper.xs
@@ -115,8 +115,9 @@ STATIC void su_save_adelete(pTHX_ AV *av, I32 key) {
 
 #endif /* SAVEADELETE */
 
-STATIC void su_save_aelem(pTHX_ AV *av, SV *key, SV *val) {
+STATIC void su_save_aelem(pTHX_ void *av_, SV *key, SV *val) {
 #define su_save_aelem(A, K, V) su_save_aelem(aTHX_ (A), (K), (V))
+ AV *av = av_;
  I32 idx;
  I32 preeminent;
  SV **svp;
@@ -152,8 +153,9 @@ STATIC I32 su_hv_preeminent(pTHX_ HV *hv, SV *keysv) {
  return 1;
 }
 
-STATIC void su_save_helem(pTHX_ HV *hv, SV *keysv, SV *val) {
+STATIC void su_save_helem(pTHX_ void *hv_, SV *keysv, SV *val) {
 #define su_save_helem(H, K, V) su_save_helem(aTHX_ (H), (K), (V))
+ HV *hv = hv_;
  I32 preeminent;
  HE *he;
  SV **svp;
@@ -271,6 +273,32 @@ typedef struct {
  SV *elem;
 } su_ud_localize;
 
+STATIC void su_localize_elem(pTHX_ void *obj, SV *elem, SV *val, void (*do_elem)(pTHX_ void *, SV *, SV *)) {
+#define su_localize_elem(O, E, V, D) su_localize_elem(aTHX_ (O), (E), (V), (D))
+ AV *aelem, *aval;
+ if (SvROK(elem) && (aelem = (AV *) SvRV(elem), SvTYPE(aelem) == SVt_PVAV)) {
+  I32 i, last = av_len(aelem);
+  SV **svpe, **svpv;
+  if (!val) {
+   for (i = 0; i <= last; ++i) {
+    svpe = av_fetch(aelem, i, 0);
+    if (!svpe) continue;
+    do_elem(aTHX_ obj, *svpe, NULL);
+   }
+  } else if (SvROK(val) && (aval = (AV *) SvRV(val), SvTYPE(aval) == SVt_PVAV)){
+   for (i = 0; i <= last; ++i) {
+    svpe = av_fetch(aelem, i, 0);
+    if (!svpe) continue;
+    svpv = av_fetch(aval,  i, 0);
+    if (!svpv) continue;
+    do_elem(aTHX_ obj, *svpe, *svpv);
+   }
+  }
+ } else {
+  do_elem(aTHX_ obj, elem, val);
+ }
+}
+
 STATIC void su_localize(pTHX_ void *ud_) {
 #define su_localize(U) su_localize(aTHX_ (U))
  su_ud_localize *ud = (su_ud_localize *) ud_;
@@ -332,16 +360,14 @@ STATIC void su_localize(pTHX_ void *ud_) {
  switch (t) {
   case SVt_PVAV:
    if (elem) {
-    AV *av = GvAV(gv);
-    su_save_aelem(av, elem, val);
+    su_localize_elem(GvAV(gv), elem, val, su_save_aelem);
     goto done;
    } else
     save_ary(gv);
    break;
   case SVt_PVHV:
    if (elem) {
-    HV *hv = GvHV(gv);
-    su_save_helem(hv, elem, val);
+    su_localize_elem(GvHV(gv), elem, val, su_save_helem);
     goto done;
    } else
     save_hash(gv);
@@ -553,7 +579,7 @@ void
 localize_elem(SV *sv, SV *elem, SV *val, ...)
 PROTOTYPE: $$$;$
 PREINIT:
- I32 level = 0;
+ I32 level = 0, slots = 1;
  su_ud_localize *ud;
 CODE:
  SU_GET_LEVEL(3);
@@ -565,13 +591,15 @@ CODE:
  ud->val  = newSVsv(val);
  SvREFCNT_inc(elem);
  ud->elem = elem;
- su_init(level, ud, 4);
+ if (SvROK(elem) && (elem = SvRV(elem), SvTYPE(elem) == SVt_PVAV))
+  slots = 1 + av_len((AV *) elem);
+ su_init(level, ud, slots * 4);
 
 void
 localize_delete(SV *sv, SV *elem, ...)
 PROTOTYPE: $$;$
 PREINIT:
- I32 level = 0;
+ I32 level = 0, slots = 1;
  su_ud_localize *ud;
 CODE:
  SU_GET_LEVEL(2);
@@ -583,4 +611,6 @@ CODE:
  ud->val  = NULL;
  SvREFCNT_inc(elem);
  ud->elem = elem;
- su_init(level, ud, 4);
+ if (SvROK(elem) && (elem = SvRV(elem), SvTYPE(elem) == SVt_PVAV))
+  slots = 1 + av_len((AV *) elem);
+ su_init(level, ud, slots * 3);