X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=Nary.xs;h=084b9ebe51c0593e0c940aff2916d5cfe9e667b6;hb=3b10ab9a7a01f579892a98a1ffc53202d6adc8d6;hp=75892ce3338d7bcd61ca2996b5d4a865e1c7dc94;hpb=91deeda20173f3d35c5b936c9e6db1cbe08f0e00;p=perl%2Fmodules%2FSub-Nary.git

diff --git a/Nary.xs b/Nary.xs
index 75892ce..084b9eb 100644
--- a/Nary.xs
+++ b/Nary.xs
@@ -59,24 +59,7 @@ CODE:
   XSRETURN_IV(res);
  }
  hv = (HV *) SvRV(sv);
- res = hv_exists(hv, "0", 1) && hv_iterinit(hv) == 1;
- XSRETURN_IV(res);
-
-void
-list(SV *sv)
-PROTOTYPE: $
-PREINIT:
- HV *hv;
- IV res;
-CODE:
- if (!SvOK(sv))
-  XSRETURN_IV(0);
- if (!SvROK(sv)) {
-  res = strEQ(SvPV_nolen(sv), "list");
-  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, "0", 1);
  XSRETURN_IV(res);
 
 void
@@ -112,20 +95,14 @@ CODE:
  res = newHV();
  if (!SvROK(sv)) {
   val = newSVuv(1);
-  if (!hv_store_ent(res, sv, val, 0)) {
+  if (!hv_store_ent(res, sv, val, 0))
    SvREFCNT_dec(val);
-   SvREFCNT_dec(res);
-   XSRETURN_UNDEF;
-  }
  } else {
   hv = (HV *) SvRV(sv);
   if (!hv_iterinit(hv)) {
    val = newSVuv(1);
-   if (!hv_store(res, "0", 1, val, 0)) {
+   if (!hv_store(res, "0", 1, val, 0))
     SvREFCNT_dec(val);
-    SvREFCNT_dec(res);
-    XSRETURN_UNDEF;
-   }
   } else {
    while (key = hv_iternext(hv)) {
     c += SvNV(HeVAL(key));
@@ -141,6 +118,137 @@ CODE:
  ST(0) = sv_2mortal(newRV_noinc((SV *) res));
  XSRETURN(1);
 
+void
+scale(SV *csv, SV *sv)
+PROTOTYPE: $;$
+PREINIT:
+ HV *hv, *res;
+ HE *key;
+ SV *val;
+ NV c = 1;
+CODE:
+ if (!SvOK(sv))
+  XSRETURN_UNDEF;
+ if (SvOK(csv))
+  c = SvNV(csv);
+ res = newHV();
+ if (!SvROK(sv)) {
+  val = newSVnv(c);
+  if (!hv_store_ent(res, sv, val, 0))
+   SvREFCNT_dec(val);
+ } else {
+  hv = (HV *) SvRV(sv);
+  if (!hv_iterinit(hv)) {
+   val = newSVnv(c);
+   if (!hv_store(res, "0", 1, val, 0))
+    SvREFCNT_dec(val);
+  } else {
+   hv_iterinit(hv);
+   while (key = hv_iternext(hv)) {
+    val = newSVnv(SvNV(HeVAL(key)) * c);
+    if (!hv_store_ent(res, HeSVKEY_force(key), val, HeHASH(key)))
+     SvREFCNT_dec(val);
+   }
+  }
+ }
+ 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
+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: @