1 /* This file is part of the Sub::Nary Perl module.
2 * See http://search.cpan.org/dist/Sub::Nary/ */
4 #define PERL_NO_GET_CONTEXT
10 # define Newx(v, n, c) New(0, v, n, c)
14 # define mPUSHi(I) PUSHs(sv_2mortal(newSViv(I)))
22 STATIC void sn_store(pTHX_ HV *tb, const char *key, I32 klen, SV *val, U32 hash) {
23 #define sn_store(T, K, KL, V, H) sn_store(aTHX_ (T), (K), (KL), (V), (H))
24 if (!hv_store(tb, key, klen, val, hash)) SvREFCNT_dec(val);
27 STATIC void sn_store_ent(pTHX_ HV *tb, SV *key, SV *val, U32 hash) {
28 #define sn_store_ent(T, K, V, H) sn_store_ent(aTHX_ (T), (K), (V), (H))
29 if (!hv_store_ent(tb, key, val, hash)) SvREFCNT_dec(val);
32 STATIC U32 sn_hash_list = 0;
33 STATIC U32 sn_hash_exit = 0;
34 STATIC U32 sn_hash_die = 0;
36 /* --- XS ------------------------------------------------------------------ */
38 MODULE = Sub::Nary PACKAGE = Sub::Nary
44 PERL_HASH(sn_hash_list, "list", 4);
45 PERL_HASH(sn_hash_exit, "exit", 4);
46 PERL_HASH(sn_hash_die, "die", 3);
53 ST(0) = sv_2mortal(newSVuv(SvUV(SvRV(op))));
62 o = INT2PTR(OP *, SvUV(SvRV(op)));
63 ST(0) = sv_2mortal(newSVuv(o == NULL));
76 res = SvNOK(sv) ? SvNV(sv) == 0.0 : SvUV(sv) == 0;
80 res = hv_iterinit(hv) == 1 && hv_exists(hv, "0", 1);
97 while (key = hv_iternext(hv)) {
98 c += SvNV(HeVAL(key));
114 sn_store_ent(res, sv, newSVuv(1), 0);
116 hv = (HV *) SvRV(sv);
117 if (!hv_iterinit(hv)) {
118 sn_store(res, "0", 1, newSVuv(1), 0);
120 while (key = hv_iternext(hv))
121 c += SvNV(HeVAL(key));
123 while (key = hv_iternext(hv)) {
124 SV *val = newSVnv(SvNV(HeVAL(key)) / c);
125 sn_store_ent(res, HeSVKEY_force(key), val, HeHASH(key));
129 ST(0) = sv_2mortal(newRV_noinc((SV *) res));
133 scale(SV *csv, SV *sv)
146 sn_store_ent(res, sv, newSVnv(c), 0);
148 hv = (HV *) SvRV(sv);
149 if (!hv_iterinit(hv)) {
150 sn_store(res, "0", 1, newSVnv(c), 0);
153 while (key = hv_iternext(hv)) {
154 SV *val = newSVnv(SvNV(HeVAL(key)) * c);
155 sn_store_ent(res, HeSVKEY_force(key), val, HeHASH(key));
159 ST(0) = sv_2mortal(newRV_noinc((SV *) res));
174 for (i = 0; i < items; ++i) {
180 if ((old = hv_fetch_ent(res, cur, 1, 0)) && SvOK(val = HeVAL(old)))
182 sn_store_ent(res, cur, newSVnv(v), 0);
186 hv_iterinit((HV *) cur);
187 while (key = hv_iternext((HV *) cur)) {
188 SV *k = HeSVKEY_force(key);
189 NV v = SvNV(HeVAL(key));
190 if ((old = hv_fetch_ent(res, k, 1, 0)) && SvOK(val = HeVAL(old)))
192 sn_store_ent(res, k, newSVnv(v), 0);
195 if (!hv_iterinit(res)) {
199 ST(0) = sv_2mortal(newRV_noinc((SV *) res));
203 cumulate(SV *sv, SV *nsv, SV *csv)
216 ST(0) = sv_2mortal(newSVuv(0));
219 if (!SvROK(sv) || !c0) {
224 if (!hv_iterinit((HV *) sv))
226 if (c0 == 1 || (SvIOK(csv) && SvIV(csv) == 1)) {
231 for (; n > 0; n /= 2) {
236 c = (1 - c) / (1 - c0);
239 while (key = hv_iternext((HV *) sv)) {
240 SV *k = HeSVKEY_force(key);
241 SV *val = newSVnv(c * SvNV(HeVAL(key)));
242 sn_store_ent(res, k, val, 0);
244 ST(0) = sv_2mortal(newRV_noinc((SV *) res));
253 SV *kexit, *klist, *kdie;
259 NV pe = 0, pd = 0, pl = 0;
260 sn_combcache *cache = NULL;
268 Newx(cache, 1, sn_combcache);
270 temp = sv_2mortal(newSViv(0));
271 for (i = 0; i < items; ++i) {
273 NV pe1 = 0, pd1 = 0, pd2, pl1 = 0;
281 sn_store_ent(res[2], cur, newSVuv(1), 0);
290 kexit = hv_delete((HV *) cur, "exit", 4, 0);
291 n1 = hv_iterinit((HV *) cur);
301 kdie = hv_delete((HV *) cur, "die", 3, 0);
312 klist = hv_delete((HV *) cur, "list", 4, 0);
321 pl = pl1 * (1 - (pd + pe)) + pl * (1 - (pd1 + pe1)) - pl * pl1;
322 pd2 = pd1 * (1 - pe) + pd - pd * pd1;
323 pe = pe1 * (1 - pd) + pe - pe * pe1;
325 n2 = hv_iterinit(res[n]);
332 Renew(cache, n2, sn_combcache);
336 while (key = hv_iternext(res[n])) {
337 cache[j].k = SvUV(HeSVKEY_force(key));
338 cache[j].v = SvNV(HeVAL(key));
342 while (key = hv_iternext((HV *) cur)) {
343 IV k = SvUV(HeSVKEY_force(key));
344 NV v = SvNV(HeVAL(key));
345 for (j = 0; j < n2; ++j) {
346 sv_setiv(temp, k + cache[j].k);
347 if ((old = hv_fetch_ent(res[o], temp, 1, 0)) && SvOK(val = HeVAL(old))) {
348 val = newSVnv(SvNV(val) + v * cache[j].v);
350 val = newSVnv(v * cache[j].v);
352 sn_store_ent(res[o], temp, val, 0);
358 SvREFCNT_dec(res[2]);
360 sn_store(res[n], "exit", 4, newSVnv(pe), sn_hash_exit);
362 sn_store(res[n], "die", 3, newSVnv(pd), sn_hash_die);
364 sn_store(res[n], "list", 4, newSVnv(pl), sn_hash_list);
366 SvREFCNT_dec(res[0]);
368 SvREFCNT_dec(res[1]);
369 if (!hv_iterinit(res[n])) {
370 SvREFCNT_dec(res[n]);
373 ST(0) = sv_2mortal(newRV_noinc((SV *) res[n]));
385 if (cxt == G_SCALAR) {
386 for (i = 0; i < OP_max; ++i) {
387 count += (PL_opargs[i] & (OA_RETSCALAR | OA_RETINTEGER)) != 0;
392 } else if (cxt == G_ARRAY) {
393 for (i = 0; i < OP_max; ++i) {
394 if (PL_opargs[i] & (OA_RETSCALAR | OA_RETINTEGER)) {
395 const char *name = PL_op_name[i];
396 XPUSHs(sv_2mortal(newSVpvn_share(name, strlen(name), 0)));