From: Vincent Pit <vince@profvince.com>
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/?p=perl%2Fmodules%2FSub-Nary.git;a=commitdiff_plain;h=93afac3588786704db6d9549d3bf469ba1b5598d

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, "<perl at profvince.com>", <http://www.profvince.com>.
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<wantarray> isn't specialized when encountered in the optree.
 
 L<perl> 5.8.1.
 
-L<Carp> (standard since perl 5), L<B> (since perl 5.005), L<XSLoader> (since perl 5.006) and L<List::Util> (since perl 5.007003).
+L<Carp> (standard since perl 5), L<B> (since perl 5.005) and L<XSLoader> (since perl 5.006).
 
 =head1 AUTHOR