Fix map/grep handling of returns in block with a new cumulate function

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

diff --git a/Nary.xs b/Nary.xs
index dc5612b1b46cdf0fe47cf6ef624923906bf808f6..c3f1bc59e1ec590ba587842e815de37a6950bd28 100644 (file)
--- a/Nary.xs
+++ b/Nary.xs
@@ -59,7 +59,7 @@ CODE:
   XSRETURN_IV(res);
  }
  hv = (HV *) SvRV(sv);
- res = hv_exists(hv, "0", 1) && hv_iterinit(hv) == 1;
+ res = hv_iterinit(hv) == 1 && hv_exists(hv, "0", 1);
  XSRETURN_IV(res);
 
 void
@@ -76,7 +76,7 @@ CODE:
   XSRETURN_IV(res);
  }
  hv = (HV *) SvRV(sv);
- res = hv_exists(hv, "list", 4) && hv_iterinit(hv) == 1;
+ res = hv_iterinit(hv) == 1 && hv_exists(hv, "list", 4);
  XSRETURN_IV(res);
 
 void
@@ -223,6 +223,49 @@ CODE:
  ST(0) = sv_2mortal(newRV_noinc((SV *) res));
  XSRETURN(1);
 
+void
+cumulate(SV *sv, SV *nsv, SV *csv)
+PROTOTYPE: $$$
+PREINIT:
+ HV *res;
+ SV *val;
+ HE *key;
+ NV c0, c, a;
+ UV i, n;
+CODE:
+ if (!SvOK(sv))
+  XSRETURN_UNDEF;
+ n  = SvUV(nsv);
+ c0 = SvNV(csv);
+ if (!n) {
+  ST(0) = sv_2mortal(newSVuv(0));
+  XSRETURN(1);
+ }
+ if (!SvROK(sv) || !c0) {
+  ST(0) = sv;
+  XSRETURN(1);
+ }
+ sv = SvRV(sv);
+ if (!hv_iterinit((HV *) sv))
+  XSRETURN_UNDEF;
+ c = 1;
+ a = c0;
+ for (; n > 0; n /= 2) {
+  if (n % 2)
+   c *= a;
+  a *= a;
+ }
+ c = (1 - c) / (1 - c0);
+ res = newHV();
+ while (key = hv_iternext((HV *) sv)) {
+  SV *k = HeSVKEY_force(key);
+  val = newSVnv(c * SvNV(HeVAL(key)));
+  if (!hv_store_ent(res, k, val, 0))
+   SvREFCNT_dec(val);
+ }
+ ST(0) = sv_2mortal(newRV_noinc((SV *) res));
+ XSRETURN(1);
+
 void
 combine(...)
 PROTOTYPE: @