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 mPUSHi(I) PUSHs(sv_2mortal(newSViv(I)))
18 STATIC U32 sn_hash_list = 0;
20 /* --- XS ------------------------------------------------------------------ */
22 MODULE = Sub::Nary PACKAGE = Sub::Nary
28 PERL_HASH(sn_hash_list, "list", 4);
35 ST(0) = sv_2mortal(newSVuv(SvUV(SvRV(op))));
44 o = INT2PTR(OP *, SvUV(SvRV(op)));
45 ST(0) = sv_2mortal(newSVuv(o == NULL));
58 res = SvNOK(sv) ? SvNV(sv) == 0.0 : SvUV(sv) == 0;
62 res = hv_iterinit(hv) == 1 && hv_exists(hv, "0", 1);
75 res = strEQ(SvPV_nolen(sv), "list");
79 res = hv_iterinit(hv) == 1 && hv_exists(hv, "list", 4);
96 while (key = hv_iternext(hv)) {
97 c += SvNV(HeVAL(key));
115 if (!hv_store_ent(res, sv, val, 0))
118 hv = (HV *) SvRV(sv);
119 if (!hv_iterinit(hv)) {
121 if (!hv_store(res, "0", 1, val, 0))
124 while (key = hv_iternext(hv)) {
125 c += SvNV(HeVAL(key));
128 while (key = hv_iternext(hv)) {
129 val = newSVnv(SvNV(HeVAL(key)) / c);
130 if (!hv_store_ent(res, HeSVKEY_force(key), val, HeHASH(key)))
135 ST(0) = sv_2mortal(newRV_noinc((SV *) res));
139 scale(SV *csv, SV *sv)
154 if (!hv_store_ent(res, sv, val, 0))
157 hv = (HV *) SvRV(sv);
158 if (!hv_iterinit(hv)) {
160 if (!hv_store(res, "0", 1, val, 0))
164 while (key = hv_iternext(hv)) {
165 val = newSVnv(SvNV(HeVAL(key)) * c);
166 if (!hv_store_ent(res, HeSVKEY_force(key), val, HeHASH(key)))
171 ST(0) = sv_2mortal(newRV_noinc((SV *) res));
186 for (i = 0; i < items; ++i) {
191 if (strEQ(SvPV_nolen(cur), "list")) {
194 if (!hv_store(res, "list", 4, val, sn_hash_list))
199 if ((old = hv_fetch_ent(res, cur, 1, 0)) && SvOK(val = HeVAL(old)))
202 if (!hv_store_ent(res, cur, val, 0))
208 hv_iterinit((HV *) cur);
209 while (key = hv_iternext((HV *) cur)) {
210 SV *k = HeSVKEY_force(key);
211 NV v = SvNV(HeVAL(key));
212 if ((old = hv_fetch_ent(res, k, 1, 0)) && SvOK(val = HeVAL(old)))
215 if (!hv_store_ent(res, k, val, 0))
219 if (!hv_iterinit(res)) {
223 ST(0) = sv_2mortal(newRV_noinc((SV *) res));
227 cumulate(SV *sv, SV *nsv, SV *csv)
241 ST(0) = sv_2mortal(newSVuv(0));
244 if (!SvROK(sv) || !c0) {
249 if (!hv_iterinit((HV *) sv))
253 for (; n > 0; n /= 2) {
258 c = (1 - c) / (1 - c0);
260 while (key = hv_iternext((HV *) sv)) {
261 SV *k = HeSVKEY_force(key);
262 val = newSVnv(c * SvNV(HeVAL(key)));
263 if (!hv_store_ent(res, k, val, 0))
266 ST(0) = sv_2mortal(newRV_noinc((SV *) res));
281 UV shift = 0, do_shift = 0;
282 sn_combcache *cache = NULL;
287 res[0] = res[1] = NULL;
288 for (i = 0; i < items; ++i) {
293 if (strEQ(SvPV_nolen(cur), "list")) {
297 if (!hv_store(res[0], "list", 4, val, sn_hash_list))
311 while (key = hv_iternext((HV *) cur)) {
312 val = newSVsv(HeVAL(key));
313 if (!hv_store_ent(res[0], HeSVKEY_force(key), val, 0))
321 temp = sv_2mortal(newSViv(0));
322 for (++i; i < items; ++i) {
327 if (strEQ(SvPV_nolen(cur), "list")) {
330 if (!hv_store(res[n], "list", 4, val, sn_hash_list))
346 list1 = hv_delete((HV *) cur, "list", 4, 0);
347 n1 = hv_iterinit((HV *) cur);
348 list2 = hv_delete(res[n], "list", 4, 0);
349 n2 = hv_iterinit(res[n]);
350 if ((list1 && !n1) || (list2 && !n2)) {
352 if (!hv_store(res[o], "list", 4, val, sn_hash_list))
356 } else if (list1 || list2) {
357 NV l1 = list1 ? SvNV(list1) : 0;
358 NV l2 = list2 ? SvNV(list2) : 0;
359 val = newSVnv(l1 + l2 - l1 * l2);
360 if (!hv_store(res[o], "list", 4, val, sn_hash_list))
364 Renew(cache, n2, sn_combcache);
368 while (key = hv_iternext(res[n])) {
369 cache[j].k = SvUV(HeSVKEY_force(key));
370 cache[j].v = SvNV(HeVAL(key));
373 while (key = hv_iternext((HV *) cur)) {
374 IV k = SvUV(HeSVKEY_force(key));
375 NV v = SvNV(HeVAL(key));
376 for (j = 0; j < n2; ++j) {
377 sv_setiv(temp, k + cache[j].k);
378 if ((old = hv_fetch_ent(res[o], temp, 1, 0)) && SvOK(val = HeVAL(old))) {
379 val = newSVnv(SvNV(val) + v * cache[j].v);
381 val = newSVnv(v * cache[j].v);
383 if (!hv_store_ent(res[o], temp, val, 0))
390 if (shift || do_shift) {
393 sv_setiv(temp, shift);
395 if (!hv_store_ent(res[n], temp, val, 0))
403 list1 = hv_delete(res[n], "list", 4, 0);
405 while (key = hv_iternext(res[n])) {
406 sv_setiv(temp, SvUV(HeSVKEY_force(key)) + shift);
407 val = newSVsv(HeVAL(key));
408 if (!hv_store_ent(res[o], temp, val, 0))
412 val = newSVsv(list1);
413 if (!hv_store(res[o], "list", 4, val, sn_hash_list))
418 } else if (!res[0] && !res[1])
421 SvREFCNT_dec(res[0]);
423 SvREFCNT_dec(res[1]);
424 ST(0) = sv_2mortal(newRV_noinc((SV *) res[n]));
435 if (cxt == G_SCALAR) {
436 for (i = 0; i < OP_max; ++i) {
437 count += (PL_opargs[i] & (OA_RETSCALAR | OA_RETINTEGER)) != 0;
442 } else if (cxt == G_ARRAY) {
443 for (i = 0; i < OP_max; ++i) {
444 if (PL_opargs[i] & (OA_RETSCALAR | OA_RETINTEGER)) {
445 const char *name = PL_op_name[i];
446 XPUSHs(sv_2mortal(newSVpvn_share(name, strlen(name), 0)));