NV v;
} sn_combcache;
+STATIC void sn_store(pTHX_ HV *tb, const char *key, I32 klen, SV *val, U32 hash) {
+#define sn_store(T, K, KL, V, H) sn_store(aTHX_ (T), (K), (KL), (V), (H))
+ if (!hv_store(tb, key, klen, val, hash))
+ SvREFCNT_dec(val);
+}
+
+STATIC void sn_store_ent(pTHX_ HV *tb, SV *key, SV *val, U32 hash) {
+#define sn_store_ent(T, K, V, H) sn_store_ent(aTHX_ (T), (K), (V), (H))
+ if (!hv_store_ent(tb, key, val, hash))
+ SvREFCNT_dec(val);
+}
+
+
STATIC U32 sn_hash_list = 0;
/* --- XS ------------------------------------------------------------------ */
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
PREINIT:
HV *hv, *res;
HE *key;
- SV *val;
NV c = 0;
CODE:
if (!SvOK(sv))
XSRETURN_UNDEF;
res = newHV();
if (!SvROK(sv)) {
- val = newSVuv(1);
- if (!hv_store_ent(res, sv, val, 0)) {
- SvREFCNT_dec(val);
- SvREFCNT_dec(res);
- XSRETURN_UNDEF;
- }
+ sn_store_ent(res, sv, newSVuv(1), 0);
} else {
hv = (HV *) SvRV(sv);
if (!hv_iterinit(hv)) {
- val = newSVuv(1);
- if (!hv_store(res, "0", 1, val, 0)) {
- SvREFCNT_dec(val);
- SvREFCNT_dec(res);
- XSRETURN_UNDEF;
- }
+ sn_store(res, "0", 1, newSVuv(1), 0);
} else {
- while (key = hv_iternext(hv)) {
+ while (key = hv_iternext(hv))
c += SvNV(HeVAL(key));
+ hv_iterinit(hv);
+ while (key = hv_iternext(hv)) {
+ SV *val = newSVnv(SvNV(HeVAL(key)) / c);
+ sn_store_ent(res, HeSVKEY_force(key), val, HeHASH(key));
}
+ }
+ }
+ ST(0) = sv_2mortal(newRV_noinc((SV *) res));
+ XSRETURN(1);
+
+void
+scale(SV *csv, SV *sv)
+PROTOTYPE: $;$
+PREINIT:
+ HV *hv, *res;
+ HE *key;
+ NV c = 1;
+CODE:
+ if (!SvOK(sv))
+ XSRETURN_UNDEF;
+ if (SvOK(csv))
+ c = SvNV(csv);
+ res = newHV();
+ if (!SvROK(sv)) {
+ sn_store_ent(res, sv, newSVnv(c), 0);
+ } else {
+ hv = (HV *) SvRV(sv);
+ if (!hv_iterinit(hv)) {
+ sn_store(res, "0", 1, newSVnv(c), 0);
+ } 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);
+ SV *val = newSVnv(SvNV(HeVAL(key)) * c);
+ sn_store_ent(res, HeSVKEY_force(key), val, HeHASH(key));
+ }
+ }
+ }
+ 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);
+ sn_store(res, "list", 4, newSVuv(1), sn_hash_list);
+ break;
+ } else {
+ NV v = 1;
+ if ((old = hv_fetch_ent(res, cur, 1, 0)) && SvOK(val = HeVAL(old)))
+ v += SvNV(val);
+ sn_store_ent(res, cur, newSVnv(v), 0);
+ 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);
+ sn_store_ent(res, k, newSVnv(v), 0);
+ }
+ }
+ 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;
+ 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);
+ SV *val = newSVnv(c * SvNV(HeVAL(key)));
+ sn_store_ent(res, k, val, 0);
}
ST(0) = sv_2mortal(newRV_noinc((SV *) res));
XSRETURN(1);
if (strEQ(SvPV_nolen(cur), "list")) {
res[0] = newHV();
n = 0;
- val = newSVuv(1);
- if (!hv_store(res[0], "list", 4, val, sn_hash_list))
- SvREFCNT_dec(val);
+ sn_store(res[0], "list", 4, newSVuv(1), sn_hash_list);
i = items;
if (!shift)
do_shift = 0;
}
cur = SvRV(cur);
res[0] = newHV();
- while (key = hv_iternext((HV *) cur)) {
- val = newSVsv(HeVAL(key));
- if (!hv_store_ent(res[0], HeSVKEY_force(key), val, 0))
- SvREFCNT_dec(val);
- }
+ while (key = hv_iternext((HV *) cur))
+ sn_store_ent(res[0], HeSVKEY_force(key), newSVsv(HeVAL(key)), 0);
n = 0;
if (!shift)
do_shift = 0;
if (!SvROK(cur)) {
if (strEQ(SvPV_nolen(cur), "list")) {
hv_clear(res[n]);
- val = newSVuv(1);
- if (!hv_store(res[n], "list", 4, val, sn_hash_list))
- SvREFCNT_dec(val);
+ sn_store(res[n], "list", 4, newSVuv(1), sn_hash_list);
shift = 0;
do_shift = 0;
break;
list2 = hv_delete(res[n], "list", 4, 0);
n2 = hv_iterinit(res[n]);
if ((list1 && !n1) || (list2 && !n2)) {
- val = newSViv(1);
- if (!hv_store(res[o], "list", 4, val, sn_hash_list))
- SvREFCNT_dec(val);
+ sn_store(res[o], "list", 4, newSViv(1), sn_hash_list);
n = o;
break;
} else if (list1 || list2) {
NV l1 = list1 ? SvNV(list1) : 0;
NV l2 = list2 ? SvNV(list2) : 0;
val = newSVnv(l1 + l2 - l1 * l2);
- if (!hv_store(res[o], "list", 4, val, sn_hash_list))
- SvREFCNT_dec(val);
+ sn_store(res[o], "list", 4, val, sn_hash_list);
}
if (n2 > cachelen) {
Renew(cache, n2, sn_combcache);
} else {
val = newSVnv(v * cache[j].v);
}
- if (!hv_store_ent(res[o], temp, val, 0))
- SvREFCNT_dec(val);
+ sn_store_ent(res[o], temp, val, 0);
}
}
n = o;
if (!res[n]) {
res[n] = newHV();
sv_setiv(temp, shift);
- val = newSViv(1);
- if (!hv_store_ent(res[n], temp, val, 0))
- SvREFCNT_dec(val);
+ sn_store_ent(res[n], temp, newSViv(1), 0);
} else {
o = 1 - n;
if (!res[o])
hv_iterinit(res[n]);
while (key = hv_iternext(res[n])) {
sv_setiv(temp, SvUV(HeSVKEY_force(key)) + shift);
- val = newSVsv(HeVAL(key));
- if (!hv_store_ent(res[o], temp, val, 0))
- SvREFCNT_dec(val);
- }
- if (list1) {
- val = newSVsv(list1);
- if (!hv_store(res[o], "list", 4, val, sn_hash_list))
- SvREFCNT_dec(val);
+ sn_store_ent(res[o], temp, newSVsv(HeVAL(key)), 0);
}
+ if (list1)
+ sn_store(res[o], "list", 4, newSVsv(list1), sn_hash_list);
n = o;
}
} else if (!res[0] && !res[1])