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 void sn_store(pTHX_ HV *tb, const char *key, I32 klen, SV *val, U32 hash) {
19 #define sn_store(T, K, KL, V, H) sn_store(aTHX_ (T), (K), (KL), (V), (H))
20 if (!hv_store(tb, key, klen, val, hash))
24 STATIC void sn_store_ent(pTHX_ HV *tb, SV *key, SV *val, U32 hash) {
25 #define sn_store_ent(T, K, V, H) sn_store_ent(aTHX_ (T), (K), (V), (H))
26 if (!hv_store_ent(tb, key, val, hash))
31 STATIC U32 sn_hash_list = 0;
33 /* --- XS ------------------------------------------------------------------ */
35 MODULE = Sub::Nary PACKAGE = Sub::Nary
41 PERL_HASH(sn_hash_list, "list", 4);
48 ST(0) = sv_2mortal(newSVuv(SvUV(SvRV(op))));
57 o = INT2PTR(OP *, SvUV(SvRV(op)));
58 ST(0) = sv_2mortal(newSVuv(o == NULL));
71 res = SvNOK(sv) ? SvNV(sv) == 0.0 : SvUV(sv) == 0;
75 res = hv_iterinit(hv) == 1 && hv_exists(hv, "0", 1);
92 while (key = hv_iternext(hv)) {
93 c += SvNV(HeVAL(key));
109 sn_store_ent(res, sv, newSVuv(1), 0);
111 hv = (HV *) SvRV(sv);
112 if (!hv_iterinit(hv)) {
113 sn_store(res, "0", 1, newSVuv(1), 0);
115 while (key = hv_iternext(hv))
116 c += SvNV(HeVAL(key));
118 while (key = hv_iternext(hv)) {
119 SV *val = newSVnv(SvNV(HeVAL(key)) / c);
120 sn_store_ent(res, HeSVKEY_force(key), val, HeHASH(key));
124 ST(0) = sv_2mortal(newRV_noinc((SV *) res));
128 scale(SV *csv, SV *sv)
141 sn_store_ent(res, sv, newSVnv(c), 0);
143 hv = (HV *) SvRV(sv);
144 if (!hv_iterinit(hv)) {
145 sn_store(res, "0", 1, newSVnv(c), 0);
148 while (key = hv_iternext(hv)) {
149 SV *val = newSVnv(SvNV(HeVAL(key)) * c);
150 sn_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")) {
176 sn_store(res, "list", 4, newSVuv(1), sn_hash_list);
180 if ((old = hv_fetch_ent(res, cur, 1, 0)) && SvOK(val = HeVAL(old)))
182 sn_store_ent(res, cur, newSVnv(v), 0);
187 hv_iterinit((HV *) cur);
188 while (key = hv_iternext((HV *) cur)) {
189 SV *k = HeSVKEY_force(key);
190 NV v = SvNV(HeVAL(key));
191 if ((old = hv_fetch_ent(res, k, 1, 0)) && SvOK(val = HeVAL(old)))
193 sn_store_ent(res, k, newSVnv(v), 0);
196 if (!hv_iterinit(res)) {
200 ST(0) = sv_2mortal(newRV_noinc((SV *) res));
204 cumulate(SV *sv, SV *nsv, SV *csv)
217 ST(0) = sv_2mortal(newSVuv(0));
220 if (!SvROK(sv) || !c0) {
225 if (!hv_iterinit((HV *) sv))
229 for (; n > 0; n /= 2) {
234 c = (1 - c) / (1 - c0);
236 while (key = hv_iternext((HV *) sv)) {
237 SV *k = HeSVKEY_force(key);
238 SV *val = newSVnv(c * SvNV(HeVAL(key)));
239 sn_store_ent(res, k, val, 0);
241 ST(0) = sv_2mortal(newRV_noinc((SV *) res));
256 UV shift = 0, do_shift = 0;
257 sn_combcache *cache = NULL;
262 res[0] = res[1] = NULL;
263 for (i = 0; i < items; ++i) {
268 if (strEQ(SvPV_nolen(cur), "list")) {
271 sn_store(res[0], "list", 4, newSVuv(1), sn_hash_list);
284 while (key = hv_iternext((HV *) cur))
285 sn_store_ent(res[0], HeSVKEY_force(key), newSVsv(HeVAL(key)), 0);
291 temp = sv_2mortal(newSViv(0));
292 for (++i; i < items; ++i) {
297 if (strEQ(SvPV_nolen(cur), "list")) {
299 sn_store(res[n], "list", 4, newSVuv(1), sn_hash_list);
314 list1 = hv_delete((HV *) cur, "list", 4, 0);
315 n1 = hv_iterinit((HV *) cur);
316 list2 = hv_delete(res[n], "list", 4, 0);
317 n2 = hv_iterinit(res[n]);
318 if ((list1 && !n1) || (list2 && !n2)) {
319 sn_store(res[o], "list", 4, newSViv(1), sn_hash_list);
322 } else if (list1 || list2) {
323 NV l1 = list1 ? SvNV(list1) : 0;
324 NV l2 = list2 ? SvNV(list2) : 0;
325 val = newSVnv(l1 + l2 - l1 * l2);
326 sn_store(res[o], "list", 4, val, sn_hash_list);
329 Renew(cache, n2, sn_combcache);
333 while (key = hv_iternext(res[n])) {
334 cache[j].k = SvUV(HeSVKEY_force(key));
335 cache[j].v = SvNV(HeVAL(key));
338 while (key = hv_iternext((HV *) cur)) {
339 IV k = SvUV(HeSVKEY_force(key));
340 NV v = SvNV(HeVAL(key));
341 for (j = 0; j < n2; ++j) {
342 sv_setiv(temp, k + cache[j].k);
343 if ((old = hv_fetch_ent(res[o], temp, 1, 0)) && SvOK(val = HeVAL(old))) {
344 val = newSVnv(SvNV(val) + v * cache[j].v);
346 val = newSVnv(v * cache[j].v);
348 sn_store_ent(res[o], temp, val, 0);
354 if (shift || do_shift) {
357 sv_setiv(temp, shift);
358 sn_store_ent(res[n], temp, newSViv(1), 0);
365 list1 = hv_delete(res[n], "list", 4, 0);
367 while (key = hv_iternext(res[n])) {
368 sv_setiv(temp, SvUV(HeSVKEY_force(key)) + shift);
369 sn_store_ent(res[o], temp, newSVsv(HeVAL(key)), 0);
372 sn_store(res[o], "list", 4, newSVsv(list1), sn_hash_list);
375 } else if (!res[0] && !res[1])
378 SvREFCNT_dec(res[0]);
380 SvREFCNT_dec(res[1]);
381 ST(0) = sv_2mortal(newRV_noinc((SV *) res[n]));
392 if (cxt == G_SCALAR) {
393 for (i = 0; i < OP_max; ++i) {
394 count += (PL_opargs[i] & (OA_RETSCALAR | OA_RETINTEGER)) != 0;
399 } else if (cxt == G_ARRAY) {
400 for (i = 0; i < OP_max; ++i) {
401 if (PL_opargs[i] & (OA_RETSCALAR | OA_RETINTEGER)) {
402 const char *name = PL_op_name[i];
403 XPUSHs(sv_2mortal(newSVpvn_share(name, strlen(name), 0)));