From: Vincent Pit Date: Fri, 8 Aug 2008 14:55:16 +0000 (+0200) Subject: Rewrite add in XS. List::Util is no longer a prerequisite X-Git-Tag: v0.03~12 X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=93afac3588786704db6d9549d3bf469ba1b5598d;p=perl%2Fmodules%2FSub-Nary.git Rewrite add in XS. List::Util is no longer a prerequisite --- diff --git a/META.yml b/META.yml index c84889a..755e66b 100644 --- a/META.yml +++ b/META.yml @@ -10,7 +10,6 @@ distribution_type: module requires: B: 0 Carp: 0 - List::Util: 0 XSLoader: 0 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.3.html diff --git a/Makefile.PL b/Makefile.PL index 9e010ce..9962c85 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -27,10 +27,9 @@ WriteMakefile( ABSTRACT_FROM => 'lib/Sub/Nary.pm', PL_FILES => {}, PREREQ_PM => { - 'B' => 0, - 'Carp' => 0, - 'List::Util' => 0, - 'XSLoader' => 0 + 'B' => 0, + 'Carp' => 0, + 'XSLoader' => 0 }, dist => { PREOP => 'pod2text lib/Sub/Nary.pm > $(DISTVNAME)/README; ' diff --git a/Nary.xs b/Nary.xs index cea5f95..dc5612b 100644 --- a/Nary.xs +++ b/Nary.xs @@ -171,6 +171,58 @@ CODE: ST(0) = sv_2mortal(newRV_noinc((SV *) res)); XSRETURN(1); +void +add(...) +PROTOTYPE: @ +PREINIT: + HV *res; + SV *cur, *val; + HE *key, *old; + I32 i; +CODE: + if (!items) + XSRETURN_UNDEF; + res = newHV(); + for (i = 0; i < items; ++i) { + cur = ST(i); + if (!SvOK(cur)) + continue; + if (!SvROK(cur)) { + if (strEQ(SvPV_nolen(cur), "list")) { + hv_clear(res); + val = newSVuv(1); + if (!hv_store(res, "list", 4, val, sn_hash_list)) + SvREFCNT_dec(val); + break; + } else { + NV v = 1; + if ((old = hv_fetch_ent(res, cur, 1, 0)) && SvOK(val = HeVAL(old))) + v += SvNV(val); + val = newSVnv(v); + if (!hv_store_ent(res, cur, val, 0)) + SvREFCNT_dec(val); + continue; + } + } + cur = SvRV(cur); + hv_iterinit((HV *) cur); + while (key = hv_iternext((HV *) cur)) { + SV *k = HeSVKEY_force(key); + NV v = SvNV(HeVAL(key)); + if ((old = hv_fetch_ent(res, k, 1, 0)) && SvOK(val = HeVAL(old))) + v += SvNV(val); + val = newSVnv(v); + if (!hv_store_ent(res, k, val, 0)) + SvREFCNT_dec(val); + } + } + if (!hv_iterinit(res)) { + SvREFCNT_dec(res); + XSRETURN_UNDEF; + } + ST(0) = sv_2mortal(newRV_noinc((SV *) res)); + XSRETURN(1); + void combine(...) PROTOTYPE: @ diff --git a/README b/README index 587b889..7300732 100644 --- a/README +++ b/README @@ -41,8 +41,7 @@ METHODS PROBABILITY OF RETURN The probability is computed as such : - * All the returning points in the same subroutine (i.e. all the explicit - "return" and the last computed value) are considered equally possible. + * When branching, each branch is considered equally possible. For example, the subroutine sub simple { @@ -65,10 +64,10 @@ PROBABILITY OF RETURN } } - it is considered to return 1 (when the two tests fail, the last - computed value is returned, which here is "$x > 0.9" evaluated in - the scalar context of the test), 2 or 3 arguments each with - probability "1/3". + it is considered to return 3 scalars with probability "1/2", 2 with + probability "1/2 * 1/2 = 1/4" and 1 (when the two tests fail, the + last computed value is returned, which here is "$x > 0.9" evaluated + in the scalar context of the test) with remaining probability "1/4". * The total probability law for a given returning point is the convolution product of the probabilities of its list elements. @@ -134,8 +133,8 @@ CAVEATS DEPENDENCIES perl 5.8.1. - Carp (standard since perl 5), B (since perl 5.005), XSLoader (since perl - 5.006) and List::Util (since perl 5.007003). + Carp (standard since perl 5), B (since perl 5.005) and XSLoader (since + perl 5.006). AUTHOR Vincent Pit, "", . diff --git a/lib/Sub/Nary.pm b/lib/Sub/Nary.pm index d5a9645..21f53b0 100644 --- a/lib/Sub/Nary.pm +++ b/lib/Sub/Nary.pm @@ -6,7 +6,6 @@ use strict; use warnings; use Carp qw/croak/; -use List::Util qw/reduce/; use B qw/class ppname svref_2object OPf_KIDS/; @@ -193,13 +192,6 @@ sub power { return $r; } -sub add { - reduce { - $a->{$_} += $b->{$_} for keys %$b; - $a - } map { (ref) ? $_ : { $_ => 1 } } grep defined, @_; -} - my %ops; $ops{$_} = 1 for scalops; @@ -596,7 +588,7 @@ C isn't specialized when encountered in the optree. L 5.8.1. -L (standard since perl 5), L (since perl 5.005), L (since perl 5.006) and L (since perl 5.007003). +L (standard since perl 5), L (since perl 5.005) and L (since perl 5.006). =head1 AUTHOR