From: Vincent Pit Date: Fri, 8 Aug 2008 10:22:27 +0000 (+0200) Subject: Rewrite normalize in XS X-Git-Tag: v0.03~15 X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=ac0f3ea3b3aba67758f18170c2df60a7fc536bf2;p=perl%2Fmodules%2FSub-Nary.git Rewrite normalize in XS --- diff --git a/Nary.xs b/Nary.xs index 0165a66..116040c 100644 --- a/Nary.xs +++ b/Nary.xs @@ -86,6 +86,47 @@ CODE: } XSRETURN_NV(c); +void +normalize(SV *sv) +PROTOTYPE: $ +PREINIT: + HV *hv, *res; + HE *key; + SV *val; + NV c = 0; +CODE: + if (!SvOK(sv)) + XSRETURN_UNDEF; + res = newHV(); + if (!SvROK(sv)) { + val = newSVuv(1); + if (!hv_store_ent(res, sv, val, 0)) { + SvREFCNT_dec(val); + XSRETURN_UNDEF; + } + } else { + hv = (HV *) SvRV(sv); + if (!hv_iterinit(hv)) { + val = newSVuv(1); + if (!hv_store(res, "0", 1, val, 0)) { + SvREFCNT_dec(val); + XSRETURN_UNDEF; + } + } else { + while (key = hv_iternext(hv)) { + c += SvNV(HeVAL(key)); + } + hv_iterinit(hv); + while (key = hv_iternext(hv)) { + val = newSVnv(SvNV(HeVAL(key)) / c); + if (!hv_store_ent(res, HeSVKEY_force(key), val, HeHASH(key))) + SvREFCNT_dec(val); + } + } + } + ST(0) = sv_2mortal(newRV_noinc((SV *) res)); + XSRETURN(1); + void scalops() PROTOTYPE: diff --git a/lib/Sub/Nary.pm b/lib/Sub/Nary.pm index 6dc1820..bda8335 100644 --- a/lib/Sub/Nary.pm +++ b/lib/Sub/Nary.pm @@ -178,14 +178,6 @@ sub name ($) { $n eq 'null' ? substr(ppname($_[0]->targ), 3) : $n } -sub normalize ($) { - my $r = $_[0]; - return unless defined $r; - return { 0 => 1 } unless keys %$r; - my $total = count $r; - return { map { $_ => $r->{$_} / $total } keys %$r }; -} - sub scale { my ($c, $r) = @_; return unless defined $r;