List::Flatten::XS をリリースしました
先日 Okinawa.pm の Slack で複雑なリストのフラット化を行う話で盛り上がりました。(Okinawa.pm の Slack へはこちらから参加できます!)
その中で @yasuXS さんが考案したフラット化のコードがシンプルの上に、フラット化が高速でした。以下がそのコードになります。
use strict; use warnings; sub flatten { my @args = @_ > 1 ? @_ : @{$_[0]}; my @result; while (@args) { my $a = shift @args; if (ref $a eq 'ARRAY') { unshift @args, @{$a}; } else { push @result, $a; } } return @result; } my $arr = [[1,2,3],[4,5,[6,7,[8,9,[1,2,3]]]]]; print flatten($arr);
リストを shift
を使って取り出し、もし配列リファレンスなら、デリファレンスして元のリストへ unshift
をして、それ以外なら返り値ように用意した変数へ push
するといったシンプルなコードです。
これを XS で書き直そうと思い、List::Flatten::XS を作成し始めたんですが、メモリリークで悩んでいたところ、@tompng さんにRuby の flatten のコードを参考にしてはという助言をいただいて、「引数に渡されたレベルに合わせてフラット化する」機能も取り入れました。
以下は Pure Perl と List::Flatten::XS のベンチマークに使ったコードとその結果です。
use strict; use warnings; use v5.10; use Data::Dumper; use List::Flatten::XS 'flatten'; use Benchmark qw/cmpthese/; my $arr = [[[[[[[[[[[[1], 2], 3], 4], 5], 6], 7], 8], 9], 1], 2], 3]; cmpthese 0, { nonrecursive => sub { flat($arr) }, xs => sub { flatten($arr) } }; sub flat { my $list = shift; my @args = @{$list}; my @result; while (@args) { my $a = shift @args; if (ref $a eq 'ARRAY') { unshift @args, @{$a}; } else { push @result, $a; } } return @result; }
結果
Rate nonrecursive xs nonrecursive 117657/s -- -70% xs 394824/s 236% --
約 2 倍の速さは出てるっぽいです。
以下が SYNOPSIS を少し弄ったコードです。ぜひ試してみてください。
#!/usr/bin/env perl use strict; use warnings; use v5.10; use Data::Dumper; use List::Flatten::XS 'flatten'; my $ref_1 = +{a => 10, b => 20, c => 'Hello'}; my $ref_2 = bless +{a => 10, b => 20, c => 'Hello'}, 'Nyan'; my $ref_3 = bless $ref_2, 'Waon'; my $complex_list = [[["foo", "bar", 3], "baz", 5], $ref_1, "hoge", [$ref_2, ["huga", [1], "K"], $ref_3]]; # got: ["foo", "bar", 3, "baz", 5, $ref_1, "hoge", $ref_2, "huga", 1, "K", $ref_3]; my $flatted = flatten($complex_list); say Dumper $flatted; say "-"x20; # got: ("foo", "bar", 3, "baz", 5, $ref_1, "hoge", $ref_2, "huga", 1, "K", $ref_3); my @flatted_with_array = flatten($complex_list); say Dumper @flatted_with_array; say "-"x20; # got: [["foo", "bar", 3], "baz", 5, $ref_1, "hoge", $ref_2, ["huga", [1], "K"], $ref_3] my $flatted_level = flatten($complex_list, 1); say Dumper $flatted_level; say "-"x20; # got: (["foo", "bar", 3], "baz", 5, $ref_1, "hoge", $ref_2, ["huga", [1], "K"], $ref_3) my @flatted_level_with_array = flatten($complex_list, 1); say Dumper @flatted_level_with_array;
最後に
明日は Okinawa.pm #4 です。
そこで XS で得た苦労して知見を共有しようと思います。
MDR-1000X っていうヘッドホン買ったぞォォォォ!!
3 月入るまでクソ忙しい環境をよくぞ耐え抜いたということで自分へのご褒美としてヘッドホンを買うことにしました。
Premium reseller でアルバイトしていた頃によく SHURE か AKG を買った方が良いよ!とアドバイスもらっていたのですが、それらの意見を無視して、SONY の MDR-1000X というノイズキャンセリング搭載のヘッドホンを購入しました。
amzn.asia
ノイズキャンセリング機能が搭載されたヘッドホンを買った理由として、家や大学など騒音が激しい環境で作業に集中したかったからです。
箱
バーン!!
ケースがオシャレ!!しかも航空機内で使えるプラグまで入れることができる!!
しかし、このヘッドホンが凄いのはノイズキャンセリングで終わらないところです。
ノイズキャンセリング機能を使うと周囲の音をある程度抑えることができ、音楽に集中することができますが、その分重要なアナウンスを聞き逃してしまったり、会話をするためにノイズキャンセルの機能をオフにしなければならないということが起きてしまいますね!
MDR-1000X ならそれらの問題を解決してくれます。
例えば音楽を聴きながら、周囲の音を取り込む新機能「アンビエントサウンドモード」。
ボタン一つで簡単に「ゴー」というような低域のノイズをカットしつつ、人の声などの中域から高域くらいの音を拾ってくれます。
もっと凄いのが「クイックアテンション」機能。
とっさに外の音を聞きたい場合右側のハウジングを全面を触れると、音楽の音量を絞り、まるでヘッドホンをつけてない状態のように外の音を聞き取ることができます!!
詳しくは【本日よりご予約開始】SONY新製品MDR-1000XやXBA新シリーズも! -eイヤホンのブログでも読むと、どういう機能があるのかというのが分かりやすいと思います。
付けた感じ、重さは全く感じません。しかし若干圧迫感があるのかなという感じがします。
それ以外は本当に満足しているので最高です!!
これであと 10 年頑張れるぞ!!!
YAPC::Kansai 行ってきた感想
全体的に良かった。トークもしました。
特に
の3つが良かった。 moznion さんの「Webアプリケーションのキャッシュ戦略とそのパターン」のスライドで一番印象的だったのが引用。
- Web を支える技術 - HTML、URI、HTML、そして REST (WEB+DB PRESS plus)
- デザインパターン、改訂版
- ノンデザイナーズ・デザインブック
- Kazuho@Cybozu Labs: キャッシュシステムの Thundering Herd 問題
この辺時間があった時読んでいきたい。 パターンに名前をつける話の時に、設計段階でその部分部分に何かしら名前をつけておくことで、コミュニケーションがしやすいというのがあったのですが、これは真似していきたいと思いました。(キャッシュの話ももちろん良かった!!)
残りの二つの話が特に温故知新のテーマにぴったりな良い話でした。凄く面白かった!!!
xtetsuji さんの「Perl ウェブ開発の中世 〜CGI と Plack の間〜」、CGI については聞いたことがあるという程度だったので、リクエストが来た時にスクリプトが実行されてその結果を返していたという点は驚きました。まじかよ CGI となった瞬間です。あと、Common Gateway Interface という名前の割に全然 Common じゃねえ!という点、Plack の方が共通化できてたんですね!流石 PSGI。
motemen さんの「はてなシステムの考古学」。はてなの歴史(時代毎の開発体制、サービス)についての話でした。独自のWAFを持っていて、時代毎に求められているものをちゃんと見極めた上で、何回か作り直していたらしいです。メンテナンス性ってやっぱり大事なんだなとつくづく思いました。
今回のYAPCも前夜祭、懇親会を含めとても楽しい思い出になりました。Perlに対するモチベーションも上がってきたので何かやろうと思います。 運営スタッフの皆様本当にお疲れさまでした。そしてありがとうございました。
YAPC::Kansai で Perl と Go のトークをしてきました!!
20分喋ってきました。いやー緊張しますねやっぱり。
Go to Perl スライドアップしました。https://t.co/YsTUkJSxGw
— K (@CodeHex) 2017年3月4日
github ですhttps://t.co/3Zcvyw1TwS
#yapcjapan #yapcjapanC
20分ということもあって内容を少し省いて喋ったので、伝えたい部分が伝えられなかったような気もします。 まとめられてる記事も発見したのでよろしければどうぞ
言い足りなかった部分として
- Go では Perl でいう push は append に値する
- capacity を指定してスライスや map を作成すると realloc が走らないため高速
- 生成したプロセスを管理する時はスライスに
type Process
を追加する Process.Wait
でプロセスが死んだか確認する- 死んでいた場合, スライス内のそのプロセスの位置に
nil
を代入してあげる - 新たに生成した
type Process
をnil
の位置に置く - 全ての要素が nil ではない場合 append する
- 参考
この辺。
初めてのトークが YAPC だったということが凄い光栄だと思ってます。
見に来てくださった皆さんありがとうございました。
そしてこれはルートビアです。
全体の感想は後ほど👍
YAPC::Kansai で Perl と Go のトークをしてきます!!
14:00 ~ 14:20 の時間に C 会場で 「Perl to Go」というタイトルでお話しします。内容としては、ある Perl モジュールを Go で書き直すときに、Perl の書き方をそのまま Go に移植したところ、信じられないくらい不便なコードになってしまったので、その辺の戒めを含めアウトプットしていきたいと思いました。
ちなみに大きなイベントでトークするのは今回が初めてなので、皆さん心温かく見守っていただけると嬉しいです🙏
是非来てください!!
Perl の warn は何をしているの?
最近 Go ばっかだったので、久しぶりに Perl を書いてると色々疑問が出てきました。その中の一つが「$SIG{__WARN__}
に代入されたサブルーチンが実行されるタイミング」でした。
__WARN__
とあるので、 warn
を実行した時がトリガーになって実行されるものだろうというのは予想できていましたが、僕が warn
の処理内容を内部で caller
のようなものを実行し、package 名、warn
を実行した行番号を取得して stderr へ出力しているものだと思っていました。そのため「stderr を通じて出力された時がトリガーとなって $SIG{__WARN__}
が呼び出される」と考えたのですが、Okinawa.pm の Slack で
というようなアドバイスをもらったので以下のようなコードを書いて試してみました。
use strict; use warnings; use Carp; BEGIN { $SIG{__WARN__} = sub { print "CALLED!!\n" }; } warn "First\n"; carp "Second\n"; print STDERR "Third\n";
結果は
CALLED!! CALLED!! Third
というような結果を得ることができました。carp
も内部では warn
を呼び出しているようなので、結果から warn
を実行したタイミングがトリガーになるということが分かりました!
…が今度は warn
って実際に何やってるのだろうという疑問が出てきたので、コードを大まかに追ってみることにしました。
これが多分 warn
のソースコード。この関数の中で vwarn
という関数を呼んでいますが、実際は Perl_vwarn のマクロ みたいですね!
ということは warn
の本体である Perl_vwarn
を読んでみると stderr へ書き出す前に invoke_exception_hook
という S_invoke_exception_hook
のマクロが呼び出されていることが分かりますね!
S_invoke_exception_hook のコードです。
STATIC bool S_invoke_exception_hook(pTHX_ SV *ex, bool warn) { HV *stash; GV *gv; CV *cv; SV **const hook = warn ? &PL_warnhook : &PL_diehook; /* sv_2cv might call Perl_croak() or Perl_warner() */ SV * const oldhook = *hook; if (!oldhook) return FALSE; ENTER; SAVESPTR(*hook); *hook = NULL; cv = sv_2cv(oldhook, &stash, &gv, 0); LEAVE; if (cv && !CvDEPTH(cv) && (CvROOT(cv) || CvXSUB(cv))) { dSP; SV *exarg; ENTER; save_re_context(); if (warn) { SAVESPTR(*hook); *hook = NULL; } exarg = newSVsv(ex); SvREADONLY_on(exarg); SAVEFREESV(exarg); PUSHSTACKi(warn ? PERLSI_WARNHOOK : PERLSI_DIEHOOK); PUSHMARK(SP); XPUSHs(exarg); PUTBACK; call_sv(MUTABLE_SV(cv), G_DISCARD); POPSTACK; LEAVE; return TRUE; } return FALSE; }
分からない部分多すぎて泣けてくる…
きっと SV **const hook = warn ? &PL_warnhook : &PL_diehook;
の部分で hook
変数に $SIG{__WARN__}
へ代入されたサブルーチンを渡していて、SV * const oldhook = *hook;
して cv = sv_2cv(oldhook, &stash, &gv, 0);
を行って最終的に cv
変数の中にサブルーチンが代入されるのだろうと。 call_sv(MUTABLE_SV(cv), G_DISCARD);
でそのサブルーチンが実行されているんだろうなと考えました。間違っていたら教えてください。
ちなみに $SIG{__WARN__}
部分のコードは Perl_magic_setsig
だと思います。
結論
warn
は stderr へ出力するだけの関数ではない。warn
は$SIG{__WARN__}
に代入されたサブルーチンを実行して stderr へ出力する。
…多分!!!!