Rewrite add in XS. List::Util is no longer a prerequisite

[perl/modules/Sub-Nary.git] / Nary.xs

diff --git a/Nary.xs b/Nary.xs
index cea5f955b8448707c89e97e1162d8785eb0cec34..dc5612b1b46cdf0fe47cf6ef624923906bf808f6 100644 (file)
--- a/Nary.xs
+++ b/Nary.xs
@@ -171,6 +171,58 @@ CODE:
  ST(0) = sv_2mortal(newRV_noinc((SV *) res));
  XSRETURN(1);
 
+void
+add(...)
+PROTOTYPE: @
+PREINIT:
+ HV *res;
+ SV *cur, *val;
+ HE *key, *old;
+ I32 i;
+CODE:
+ if (!items)
+  XSRETURN_UNDEF;
+ res = newHV();
+ for (i = 0; i < items; ++i) {
+  cur = ST(i);
+  if (!SvOK(cur))
+   continue;
+  if (!SvROK(cur)) {
+   if (strEQ(SvPV_nolen(cur), "list")) {
+    hv_clear(res);
+    val = newSVuv(1);
+    if (!hv_store(res, "list", 4, val, sn_hash_list))
+     SvREFCNT_dec(val);
+    break;
+   } else {
+    NV v = 1;
+    if ((old = hv_fetch_ent(res, cur, 1, 0)) && SvOK(val = HeVAL(old)))
+     v += SvNV(val);
+    val = newSVnv(v);
+    if (!hv_store_ent(res, cur, val, 0))
+     SvREFCNT_dec(val);
+    continue;
+   }
+  }
+  cur = SvRV(cur);
+  hv_iterinit((HV *) cur);
+  while (key = hv_iternext((HV *) cur)) {
+   SV *k = HeSVKEY_force(key);
+   NV  v = SvNV(HeVAL(key));
+   if ((old = hv_fetch_ent(res, k, 1, 0)) && SvOK(val = HeVAL(old)))
+    v += SvNV(val);
+   val = newSVnv(v);
+   if (!hv_store_ent(res, k, val, 0))
+    SvREFCNT_dec(val);
+  }
+ }
+ if (!hv_iterinit(res)) {
+  SvREFCNT_dec(res);
+  XSRETURN_UNDEF;
+ }
+ ST(0) = sv_2mortal(newRV_noinc((SV *) res));
+ XSRETURN(1);
+
 void
 combine(...)
 PROTOTYPE: @