#include "perl.h"
#include "XSUB.h"
+#ifndef Newx
+# define Newx(v, n, c) New(0, v, n, c)
+#endif
+
#ifndef mPUSHi
# define mPUSHi(I) PUSHs(sv_2mortal(newSViv(I)))
#endif /* !mPUSHi */
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);
+ 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);
+ if (!hv_store_ent(tb, key, val, hash)) SvREFCNT_dec(val);
}
-
STATIC U32 sn_hash_list = 0;
+STATIC U32 sn_hash_exit = 0;
+STATIC U32 sn_hash_die = 0;
/* --- XS ------------------------------------------------------------------ */
BOOT:
{
PERL_HASH(sn_hash_list, "list", 4);
+ PERL_HASH(sn_hash_exit, "exit", 4);
+ PERL_HASH(sn_hash_die, "die", 3);
}
void
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;
- }
+ 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);
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;
+ if (c0 == 1 || (SvIOK(csv) && SvIV(csv) == 1)) {
+ c = n;
+ } else {
+ c = 1;
+ a = c0;
+ for (; n > 0; n /= 2) {
+ if (n % 2)
+ c *= a;
+ a *= a;
+ }
+ c = (1 - c) / (1 - c0);
}
- c = (1 - c) / (1 - c0);
res = newHV();
while (key = hv_iternext((HV *) sv)) {
SV *k = HeSVKEY_force(key);
combine(...)
PROTOTYPE: @
PREINIT:
- HV *res[2];
- SV *cur, *val;
- SV *list1, *list2;
+ HV *res[3];
+ SV *val;
+ SV *kexit, *klist, *kdie;
SV *temp;
HE *key, *old;
I32 i;
I32 n = 0, o;
I32 j, n1, n2;
- UV shift = 0, do_shift = 0;
+ NV pe = 0, pd = 0, pl = 0;
sn_combcache *cache = NULL;
- I32 cachelen = 0;
+ I32 cachelen = 1;
CODE:
if (!items)
XSRETURN_UNDEF;
- res[0] = res[1] = NULL;
- for (i = 0; i < items; ++i) {
- cur = ST(i);
- if (!SvOK(cur))
- continue;
- if (!SvROK(cur)) {
- if (strEQ(SvPV_nolen(cur), "list")) {
- res[0] = newHV();
- n = 0;
- sn_store(res[0], "list", 4, newSVuv(1), sn_hash_list);
- i = items;
- if (!shift)
- do_shift = 0;
- break;
- } else {
- shift += SvUV(cur);
- do_shift = 1;
- continue;
- }
- }
- cur = SvRV(cur);
- res[0] = newHV();
- 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;
- break;
- }
+ res[0] = newHV();
+ res[1] = NULL;
+ res[2] = NULL;
+ Newx(cache, 1, sn_combcache);
+ n = 0;
temp = sv_2mortal(newSViv(0));
- for (++i; i < items; ++i) {
- cur = ST(i);
+ for (i = 0; i < items; ++i) {
+ SV *cur = ST(i);
+ NV pe1 = 0, pd1 = 0, pd2, pl1 = 0;
if (!SvOK(cur))
continue;
if (!SvROK(cur)) {
- if (strEQ(SvPV_nolen(cur), "list")) {
- hv_clear(res[n]);
- sn_store(res[n], "list", 4, newSVuv(1), sn_hash_list);
- shift = 0;
- do_shift = 0;
- break;
- } else {
- shift += SvUV(cur);
- continue;
- }
- }
- cur = SvRV(cur);
- o = 1 - n;
+ if (!res[2])
+ res[2] = newHV();
+ else
+ hv_clear(res[2]);
+ sn_store_ent(res[2], cur, newSVuv(1), 0);
+ cur = (SV *) res[2];
+ } else
+ cur = SvRV(cur);
+ o = 1 - n;
if (!res[o])
res[o] = newHV();
else
hv_clear(res[o]);
- list1 = hv_delete((HV *) cur, "list", 4, 0);
+ kexit = hv_delete((HV *) cur, "exit", 4, 0);
n1 = hv_iterinit((HV *) cur);
- list2 = hv_delete(res[n], "list", 4, 0);
- n2 = hv_iterinit(res[n]);
- if ((list1 && !n1) || (list2 && !n2)) {
- 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);
- sn_store(res[o], "list", 4, val, sn_hash_list);
+ if (kexit) {
+ if (!n1) {
+ pe = 1 - pd;
+ pl = 0;
+ n = o;
+ break;
+ }
+ pe1 = SvNV(kexit);
+ }
+ kdie = hv_delete((HV *) cur, "die", 3, 0);
+ if (kdie) {
+ if (n1 == 1) {
+ pd = 1 - pe;
+ pl = 0;
+ n = o;
+ break;
+ }
+ --n1;
+ pd1 = SvNV(kdie);
}
- if (n2 > cachelen) {
- Renew(cache, n2, sn_combcache);
- cachelen = n2;
+ klist = hv_delete((HV *) cur, "list", 4, 0);
+ if (klist) {
+ if (n1 == 1) {
+ pl = 1 - (pe + pd);
+ n = o;
+ break;
+ }
+ pl1 = SvNV(klist);
}
- j = 0;
- while (key = hv_iternext(res[n])) {
- cache[j].k = SvUV(HeSVKEY_force(key));
- cache[j].v = SvNV(HeVAL(key));
- ++j;
+ pl = pl1 * (1 - (pd + pe)) + pl * (1 - (pd1 + pe1)) - pl * pl1;
+ pd2 = pd1 * (1 - pe) + pd - pd * pd1;
+ pe = pe1 * (1 - pd) + pe - pe * pe1;
+ pd = pd2;
+ n2 = hv_iterinit(res[n]);
+ if (!n2) {
+ cache[0].k = 0;
+ cache[0].v = 1;
+ n2 = 1;
+ } else {
+ if (n2 > cachelen) {
+ Renew(cache, n2, sn_combcache);
+ cachelen = n2;
+ }
+ j = 0;
+ while (key = hv_iternext(res[n])) {
+ cache[j].k = SvUV(HeSVKEY_force(key));
+ cache[j].v = SvNV(HeVAL(key));
+ ++j;
+ }
}
while (key = hv_iternext((HV *) cur)) {
IV k = SvUV(HeSVKEY_force(key));
n = o;
}
Safefree(cache);
- if (shift || do_shift) {
- if (!res[n]) {
- res[n] = newHV();
- sv_setiv(temp, shift);
- sn_store_ent(res[n], temp, newSViv(1), 0);
- } else {
- o = 1 - n;
- if (!res[o])
- res[o] = newHV();
- else
- hv_clear(res[o]);
- list1 = hv_delete(res[n], "list", 4, 0);
- hv_iterinit(res[n]);
- while (key = hv_iternext(res[n])) {
- sv_setiv(temp, SvUV(HeSVKEY_force(key)) + shift);
- 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])
- XSRETURN_UNDEF;
+ SvREFCNT_dec(res[2]);
+ if (pe)
+ sn_store(res[n], "exit", 4, newSVnv(pe), sn_hash_exit);
+ if (pd)
+ sn_store(res[n], "die", 3, newSVnv(pd), sn_hash_die);
+ if (pl)
+ sn_store(res[n], "list", 4, newSVnv(pl), sn_hash_list);
if (n == 1)
SvREFCNT_dec(res[0]);
else if (res[1])
SvREFCNT_dec(res[1]);
- ST(0) = sv_2mortal(newRV_noinc((SV *) res[n]));
- XSRETURN(1);
+ if (!hv_iterinit(res[n])) {
+ SvREFCNT_dec(res[n]);
+ XSRETURN_UNDEF;
+ } else {
+ ST(0) = sv_2mortal(newRV_noinc((SV *) res[n]));
+ XSRETURN(1);
+ }
void
scalops()