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);
79 while (key = hv_iternext(hv)) {
80 c += SvNV(HeVAL(key));
98 if (!hv_store_ent(res, sv, val, 0))
101 hv = (HV *) SvRV(sv);
102 if (!hv_iterinit(hv)) {
104 if (!hv_store(res, "0", 1, val, 0))
107 while (key = hv_iternext(hv)) {
108 c += SvNV(HeVAL(key));
111 while (key = hv_iternext(hv)) {
112 val = newSVnv(SvNV(HeVAL(key)) / c);
113 if (!hv_store_ent(res, HeSVKEY_force(key), val, HeHASH(key)))
118 ST(0) = sv_2mortal(newRV_noinc((SV *) res));
122 scale(SV *csv, SV *sv)
137 if (!hv_store_ent(res, sv, val, 0))
140 hv = (HV *) SvRV(sv);
141 if (!hv_iterinit(hv)) {
143 if (!hv_store(res, "0", 1, val, 0))
147 while (key = hv_iternext(hv)) {
148 val = newSVnv(SvNV(HeVAL(key)) * c);
149 if (!hv_store_ent(res, HeSVKEY_force(key), val, HeHASH(key)))
154 ST(0) = sv_2mortal(newRV_noinc((SV *) res));
169 for (i = 0; i < items; ++i) {
174 if (strEQ(SvPV_nolen(cur), "list")) {
177 if (!hv_store(res, "list", 4, val, sn_hash_list))
182 if ((old = hv_fetch_ent(res, cur, 1, 0)) && SvOK(val = HeVAL(old)))
185 if (!hv_store_ent(res, cur, val, 0))
191 hv_iterinit((HV *) cur);
192 while (key = hv_iternext((HV *) cur)) {
193 SV *k = HeSVKEY_force(key);
194 NV v = SvNV(HeVAL(key));
195 if ((old = hv_fetch_ent(res, k, 1, 0)) && SvOK(val = HeVAL(old)))
198 if (!hv_store_ent(res, k, val, 0))
202 if (!hv_iterinit(res)) {
206 ST(0) = sv_2mortal(newRV_noinc((SV *) res));
210 cumulate(SV *sv, SV *nsv, SV *csv)
224 ST(0) = sv_2mortal(newSVuv(0));
227 if (!SvROK(sv) || !c0) {
232 if (!hv_iterinit((HV *) sv))
236 for (; n > 0; n /= 2) {
241 c = (1 - c) / (1 - c0);
243 while (key = hv_iternext((HV *) sv)) {
244 SV *k = HeSVKEY_force(key);
245 val = newSVnv(c * SvNV(HeVAL(key)));
246 if (!hv_store_ent(res, k, val, 0))
249 ST(0) = sv_2mortal(newRV_noinc((SV *) res));
264 UV shift = 0, do_shift = 0;
265 sn_combcache *cache = NULL;
270 res[0] = res[1] = NULL;
271 for (i = 0; i < items; ++i) {
276 if (strEQ(SvPV_nolen(cur), "list")) {
280 if (!hv_store(res[0], "list", 4, val, sn_hash_list))
294 while (key = hv_iternext((HV *) cur)) {
295 val = newSVsv(HeVAL(key));
296 if (!hv_store_ent(res[0], HeSVKEY_force(key), val, 0))
304 temp = sv_2mortal(newSViv(0));
305 for (++i; i < items; ++i) {
310 if (strEQ(SvPV_nolen(cur), "list")) {
313 if (!hv_store(res[n], "list", 4, val, sn_hash_list))
329 list1 = hv_delete((HV *) cur, "list", 4, 0);
330 n1 = hv_iterinit((HV *) cur);
331 list2 = hv_delete(res[n], "list", 4, 0);
332 n2 = hv_iterinit(res[n]);
333 if ((list1 && !n1) || (list2 && !n2)) {
335 if (!hv_store(res[o], "list", 4, val, sn_hash_list))
339 } else if (list1 || list2) {
340 NV l1 = list1 ? SvNV(list1) : 0;
341 NV l2 = list2 ? SvNV(list2) : 0;
342 val = newSVnv(l1 + l2 - l1 * l2);
343 if (!hv_store(res[o], "list", 4, val, sn_hash_list))
347 Renew(cache, n2, sn_combcache);
351 while (key = hv_iternext(res[n])) {
352 cache[j].k = SvUV(HeSVKEY_force(key));
353 cache[j].v = SvNV(HeVAL(key));
356 while (key = hv_iternext((HV *) cur)) {
357 IV k = SvUV(HeSVKEY_force(key));
358 NV v = SvNV(HeVAL(key));
359 for (j = 0; j < n2; ++j) {
360 sv_setiv(temp, k + cache[j].k);
361 if ((old = hv_fetch_ent(res[o], temp, 1, 0)) && SvOK(val = HeVAL(old))) {
362 val = newSVnv(SvNV(val) + v * cache[j].v);
364 val = newSVnv(v * cache[j].v);
366 if (!hv_store_ent(res[o], temp, val, 0))
373 if (shift || do_shift) {
376 sv_setiv(temp, shift);
378 if (!hv_store_ent(res[n], temp, val, 0))
386 list1 = hv_delete(res[n], "list", 4, 0);
388 while (key = hv_iternext(res[n])) {
389 sv_setiv(temp, SvUV(HeSVKEY_force(key)) + shift);
390 val = newSVsv(HeVAL(key));
391 if (!hv_store_ent(res[o], temp, val, 0))
395 val = newSVsv(list1);
396 if (!hv_store(res[o], "list", 4, val, sn_hash_list))
401 } else if (!res[0] && !res[1])
404 SvREFCNT_dec(res[0]);
406 SvREFCNT_dec(res[1]);
407 ST(0) = sv_2mortal(newRV_noinc((SV *) res[n]));
418 if (cxt == G_SCALAR) {
419 for (i = 0; i < OP_max; ++i) {
420 count += (PL_opargs[i] & (OA_RETSCALAR | OA_RETINTEGER)) != 0;
425 } else if (cxt == G_ARRAY) {
426 for (i = 0; i < OP_max; ++i) {
427 if (PL_opargs[i] & (OA_RETSCALAR | OA_RETINTEGER)) {
428 const char *name = PL_op_name[i];
429 XPUSHs(sv_2mortal(newSVpvn_share(name, strlen(name), 0)));