読者です 読者をやめる 読者になる 読者になる

Light weight callback APIを使う場合とそうでない場合の差

perl xs

List::UtilsBy::XSを書いてます。 - Life is very short


のようなことを今やっています。詳しく Perl APIを理解できている
わけではないので、List::Util、List::MoreUtilsを参考にしています。
それらのモジュールでは Light weight callback API(MULTICALL等)が
使われているのですが、'perldoc perlcall'を見ると zip_byとか
bundle_byはそれらを使って実装できなさそうです。


そこでリストの処理を XS化する場合のキーポイントと思われる
Light weight callback PAIを用いた場合とそうでない場合の比較を
行なってみました。

ソース

コールバック関数に配列要素を $_として与え、各結果を戻り値として
返すというものを実装しました。
(私の知識不足で問題のある実装かもしれないですが)素朴に実装すると
以下のようなるのではないかと思います。

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "ppport.h"

MODULE = LightWeight    PACKAGE = LightWeight

void
light_weight (code, ...)
    SV *code
PROTOTYPE: &@
CODE:
{
    dMULTICALL;
    GV *gv;
    HV *stash;
    I32 gimme = G_SCALAR;
    SV **args = &PL_stack_base[ax];
    IV i;
    AV *tmps;

    if (items <= 1) {
        XSRETURN_EMPTY;
    }

    tmps = (AV *)sv_2mortal((SV *)newAV());

    cv = sv_2cv(code, &stash, &gv, 0);
    if (cv == Nullcv) {
       croak("Not a subroutine reference");
    }

    PUSH_MULTICALL(cv);
    SAVESPTR(GvSV(PL_defgv));

    for (i = 1; i < items; i++) {
        GvSV(PL_defgv) = args[i];
        MULTICALL;

        av_push(tmps, newSVsv(*PL_stack_sp));
    }

    POP_MULTICALL;

    for (i = 1; i < items; i++) {
        ST(i-1) = sv_2mortal(newSVsv(*av_fetch(tmps, i-1, 0)));
    }

    XSRETURN(items - 1);
}

void
not_light_weight (code, ...)
    SV *code
PROTOTYPE: &@
CODE:
{
    dSP;
    SV **args = &PL_stack_base[ax];
    IV i, count;
    AV *tmps;

    if (items <= 1) {
        XSRETURN_EMPTY;
    }

    tmps = (AV *)sv_2mortal((SV *)newAV());

    SAVESPTR(GvSV(PL_defgv));

    for (i = 1; i < items; i++) {
        ENTER;
        SAVETMPS;

        PUSHMARK(sp);
        PUTBACK;

        GvSV(PL_defgv) = args[i];
        count = call_sv(code, G_ARRAY);
        SPAGAIN;

        av_push(tmps, newSVsv(POPs));
        PUTBACK;

        FREETMPS;
        LEAVE;
    }

    for (i = 1; i < items; i++) {
        ST(i-1) = sv_2mortal(newSVsv(*av_fetch(tmps, i-1, 0)));
    }

    XSRETURN(items - 1);
}

ベンチマーク

Pure Perlでの実装と mapを用いたものも比較対象として追加しました。

#!perl
use strict;
use warnings;

use blib;
use LightWeight;

use Benchmark qw(cmpthese);

sub pp_map (&@) {
   my $code = shift;

   map {
       local $_ = $_;
       $code->()
   } @_;
}

cmpthese(-1, {
    pp_map    => sub { pp_map { $_ + 1 } 1..10 },
    map       => sub { map { $_ + 1 } 1..10 },
    light     => sub { LightWeight::light_weight { $_ + 1 } 1..10 },
    not_light => sub { LightWeight::not_light_weight { $_ + 1 } 1..10 },
});

結果

               Rate    pp_map not_light     light       map
pp_map     295080/s        --       -0%      -41%      -82%
not_light  295821/s        0%        --      -41%      -82%
light      497371/s       69%       68%        --      -69%
map       1603093/s      443%      442%      222%        --

Light weight callback APIを使うとそうでない場合と比べて 7割近く早く
なっています。非 Light weight callback APIは PurePerl版と大差が
ありません。何度か試したら PP版の方が早くなることもあります。


mapとの差が大きすぎるというのは私の実装に問題があるからなのかも
しれないです。かなり最適化をされてそうだけど、ここまで差が開く
ものなのだろうか・・・?

おわりに

Light weight callback APIを用いた場合とそうでない場合の
比較を行いました。


私の理解が十分でないため、結論を出すのは早いかもしれないですが、
Light weight callback APIが使えるのであれば高速化は見込めるものと
思います。逆にいうとそうでないなら、PPで問題なしということです。


まあ mapか grepで事足りることが大半だと思うので、あまり使うことは
ないかもしれないですけどね。


理解が十分でないので, 問題があればガンガン指摘してください。