X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=Nary.xs;h=a64d6196ec7bbc66bc7c2d53fc367617e197c8ac;hb=refs%2Fheads%2Fexitdie;hp=7a78e938aaf92804a91840b40ca81b438617424c;hpb=622118ca9de1af186f318d89d9058399b589b4f4;p=perl%2Fmodules%2FSub-Nary.git

diff --git a/Nary.xs b/Nary.xs
index 7a78e93..a64d619 100644
--- a/Nary.xs
+++ b/Nary.xs
@@ -6,6 +6,10 @@
 #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 */
@@ -17,18 +21,17 @@ typedef struct {
 
 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 ------------------------------------------------------------------ */
 
@@ -39,6 +42,8 @@ PROTOTYPES: ENABLE
 BOOT:
 {
  PERL_HASH(sn_hash_list, "list", 4);
+ PERL_HASH(sn_hash_exit, "exit", 4);
+ PERL_HASH(sn_hash_die,  "die",  3);
 }
 
 void
@@ -142,7 +147,7 @@ CODE:
  } else {
   hv = (HV *) SvRV(sv);
   if (!hv_iterinit(hv)) {
-   sn_store(res, "0", 1, newSVnv(c), 0);
+   XSRETURN_UNDEF;
   } else {
    hv_iterinit(hv);
    while (key = hv_iternext(hv)) {
@@ -243,95 +248,96 @@ void
 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);
   }
-  if (n2 > cachelen) {
-   Renew(cache, n2, sn_combcache);
-   cachelen = n2;
+  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);
+  }
+  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));
@@ -349,35 +355,24 @@ CODE:
   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()