Light weight callback APIを使う場合とそうでない場合の差
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との差が大きすぎるというのは私の実装に問題があるからなのかも
しれないです。かなり最適化をされてそうだけど、ここまで差が開く
ものなのだろうか・・・？
