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_exists(hv, "0", 1) && hv_iterinit(hv) == 1;
75 res = strEQ(SvPV_nolen(sv), "list");
79 res = hv_exists(hv, "list", 4) && hv_iterinit(hv) == 1;
96 while (key = hv_iternext(hv)) {
97 c += SvNV(HeVAL(key));
115 if (!hv_store_ent(res, sv, val, 0)) {
121 hv = (HV *) SvRV(sv);
122 if (!hv_iterinit(hv)) {
124 if (!hv_store(res, "0", 1, val, 0)) {
130 while (key = hv_iternext(hv)) {
131 c += SvNV(HeVAL(key));
134 while (key = hv_iternext(hv)) {
135 val = newSVnv(SvNV(HeVAL(key)) / c);
136 if (!hv_store_ent(res, HeSVKEY_force(key), val, HeHASH(key)))
141 ST(0) = sv_2mortal(newRV_noinc((SV *) res));
156 UV shift = 0, do_shift = 0;
157 sn_combcache *cache = NULL;
162 res[0] = res[1] = NULL;
163 for (i = 0; i < items; ++i) {
168 if (strEQ(SvPV_nolen(cur), "list")) {
172 if (!hv_store(res[0], "list", 4, val, sn_hash_list))
186 while (key = hv_iternext((HV *) cur)) {
187 val = newSVsv(HeVAL(key));
188 if (!hv_store_ent(res[0], HeSVKEY_force(key), val, 0))
196 temp = sv_2mortal(newSViv(0));
197 for (++i; i < items; ++i) {
202 if (strEQ(SvPV_nolen(cur), "list")) {
205 if (!hv_store(res[n], "list", 4, val, sn_hash_list))
221 list1 = hv_delete((HV *) cur, "list", 4, 0);
222 n1 = hv_iterinit((HV *) cur);
223 list2 = hv_delete(res[n], "list", 4, 0);
224 n2 = hv_iterinit(res[n]);
225 if ((list1 && !n1) || (list2 && !n2)) {
227 if (!hv_store(res[o], "list", 4, val, sn_hash_list))
231 } else if (list1 || list2) {
232 NV l1 = list1 ? SvNV(list1) : 0;
233 NV l2 = list2 ? SvNV(list2) : 0;
234 val = newSVnv(l1 + l2 - l1 * l2);
235 if (!hv_store(res[o], "list", 4, val, sn_hash_list))
239 Renew(cache, n2, sn_combcache);
243 while (key = hv_iternext(res[n])) {
244 cache[j].k = SvUV(HeSVKEY_force(key));
245 cache[j].v = SvNV(HeVAL(key));
248 while (key = hv_iternext((HV *) cur)) {
249 IV k = SvUV(HeSVKEY_force(key));
250 NV v = SvNV(HeVAL(key));
251 for (j = 0; j < n2; ++j) {
252 sv_setiv(temp, k + cache[j].k);
253 if ((old = hv_fetch_ent(res[o], temp, 1, 0)) && SvOK(val = HeVAL(old))) {
254 val = newSVnv(SvNV(val) + v * cache[j].v);
256 val = newSVnv(v * cache[j].v);
258 if (!hv_store_ent(res[o], temp, val, 0))
265 if (shift || do_shift) {
268 sv_setiv(temp, shift);
270 if (!hv_store_ent(res[n], temp, val, 0))
278 list1 = hv_delete(res[n], "list", 4, 0);
280 while (key = hv_iternext(res[n])) {
281 sv_setiv(temp, SvUV(HeSVKEY_force(key)) + shift);
282 val = newSVsv(HeVAL(key));
283 if (!hv_store_ent(res[o], temp, val, 0))
287 val = newSVsv(list1);
288 if (!hv_store(res[o], "list", 4, val, sn_hash_list))
293 } else if (!res[0] && !res[1])
296 SvREFCNT_dec(res[0]);
298 SvREFCNT_dec(res[1]);
299 ST(0) = sv_2mortal(newRV_noinc((SV *) res[n]));
310 if (cxt == G_SCALAR) {
311 for (i = 0; i < OP_max; ++i) {
312 count += (PL_opargs[i] & (OA_RETSCALAR | OA_RETINTEGER)) != 0;
317 } else if (cxt == G_ARRAY) {
318 for (i = 0; i < OP_max; ++i) {
319 if (PL_opargs[i] & (OA_RETSCALAR | OA_RETINTEGER)) {
320 const char *name = PL_op_name[i];
321 XPUSHs(sv_2mortal(newSVpvn_share(name, strlen(name), 0)));