Upgrade to Pro
— share decks privately, control downloads, hide ads and more …
Speaker Deck
Features
Speaker Deck
PRO
Sign in
Sign up for free
Search
Search
Perl5の静的解析入門 / The static analysis of Perl5
Search
mackee
January 26, 2019
Programming
2
14k
Perl5の静的解析入門 / The static analysis of Perl5
Perl5の静的解析入門
機械と人間双方の歩み寄りによる平和編
YAPC::Tokyo 2019 Room1 14:00 -
mackee
January 26, 2019
Tweet
Share
More Decks by mackee
See All by mackee
tanukistack ライブコーディング / tanukistack live-coding
mackee
0
80
range over funcの使い道と非同期N+1リゾルバーの夢 / about a range over func
mackee
0
560
perl for shell, awk and sed programmers
mackee
2
2.1k
今更GoのWebフレームワークを作ろうとしているワケ / Why am I trying to create a Go web framework now?
mackee
1
500
database/sqlでNullを扱う歴史とsql.Null[T]の登場 / sql.Null[T] history
mackee
0
410
マイクロサービス化を利用した Goへの移行事例
mackee
0
540
PerlでつくるフルスクラッチWebAuthn/パスキー認証 / Demonstration of full-scratch WebAuthn/Passkey Authentication written in Perl
mackee
3
4.2k
SRE定例やその辺の取り組みをアプリケーションエンジニア目線で語る / "Observe" about SRE Meeting by Application Engineer
mackee
0
1.9k
TinyGoで使えるORM sqllaの 紹介とTinyGoで使えるようにするための工夫
mackee
0
1.4k
Other Decks in Programming
See All in Programming
M5UnitUnified 最新動向 2025/05
gob
0
130
生成AIで知るお願いの仕方の難しさ
ohmori_yusuke
1
100
MySQL初心者が311個のカラムにNot NULL制約を追加していってALTER TABLEについて学んだ話
hatsu38
2
100
大LLM時代にこの先生きのこるには-ITエンジニア編
fumiyakume
8
3.3k
ComposeでWebアプリを作る技術
tbsten
0
130
プロダクト横断分析に役立つ、事前集計しないサマリーテーブル設計
hanon52_
3
540
Lambda(Python)の リファクタリングが好きなんです
komakichi
4
240
note の Elasticsearch 更新系を支える技術
tchov
9
3.5k
2ヶ月で生産性2倍、お買い物アプリ「カウシェ」4チーム同時改善の取り組み
ike002jp
1
110
ぽちぽち選択するだけでOSSを読めるVSCode拡張機能
ymbigo
8
3.5k
Rubyの!メソッドをちゃんと理解する
alstrocrack
1
120
ComposeでのPicture in Picture
takathemax
0
130
Featured
See All Featured
Dealing with People You Can't Stand - Big Design 2015
cassininazir
367
26k
Done Done
chrislema
184
16k
Building Applications with DynamoDB
mza
94
6.4k
What's in a price? How to price your products and services
michaelherold
245
12k
Designing for humans not robots
tammielis
253
25k
YesSQL, Process and Tooling at Scale
rocio
172
14k
4 Signs Your Business is Dying
shpigford
183
22k
Music & Morning Musume
bryan
47
6.5k
The Art of Delivering Value - GDevCon NA Keynote
reverentgeek
14
1.4k
Raft: Consensus for Rubyists
vanstee
137
6.9k
Automating Front-end Workflow
addyosmani
1370
200k
Fight the Zombie Pattern Library - RWD Summit 2016
marcelosomers
233
17k
Transcript
Perl5ͷ੩తղੳೖ ػցͱਓؒํͷาΈدΓʹΑΔฏฤ YAPC::Tokyo 2019 ໘ന๏ਓΧϠοΫ macopy a.k.a @mackee_w #yapcjapan #yapcjapanRoom1
1
͜ͷεϥΠυ 2
͜ͷτʔΫ ͷ༰ 3
ಘΒΕΔࣝɾମݧ (1) •ਖ਼نදݱͰPerlίʔυΛύʔε͢ΔPPR.pm ͷ͍ํ • ۀͰͷ۩ମతͳ༻ྫ •ਓؒͱػցʹ͔Γʹ͍͘ίʔυͱ͠ํ ͷఏҊ 4
ಘΒΕΔࣝɾମݧ (2) •PerlίʔυͷؔʹܕγάωνϟΛ͚Δ •ؔͷܕγάωνϟΛPPRͰൈ͖ग़͢ 5
ͷྲྀΕ 1. ੩తղੳͱ 2. PPIΛ͏ྫ 3. PPRͷઆ໌ͱྫ 4. ػցͱฏͷ 5.
੩తܕ͚ͷೖΓޱ 6
ࢲͱɾɾɾʁ • ໘ന๏ਓΧϠοΫ ιʔγϟ ϧήʔϜࣄۀ෦ • ࣄݴޠPerl5ͱGo • झຯ3DϓϦϯλ࡞Γ •
աڈͷτʔΫ: ήʔϜӡ༻ͷ ͱ͔Ϛελσʔλͷͱ͔ WebSocket 7
ΠϯλʔωοτͰ͜͏͍͏ΞΠ ίϯͰ͢ 8
[Ad]͜ͷτʔΫۀ࣌ؒʹॻ͖·ͨ͠ 9
੩తղੳͱҰ ମɾɾɾʁ 10
static analysis ੩తղੳ 11
ίʔυΛͨͩͷ จࣈྻͱͯ͠ѻ͏ 12
Γํ 1 ਖ਼نදݱͰҾֻ͚ͬͨΓී௨ͷςΩετͱͯ͠ѻ͏ use Path::Tiny; my $target_package = "Example"; my
$script = path("$target_package.pm")->slurp; my $is_valid_package = $script =~ /\Apackage $target_package;/; 13
͜͏͍͏ͷ͕ग़ͯ͘Δͱ؆୯ʹ٧Ή use Example; 14
ΑΓ࣮֬ͳΓํͳ͍ͷ͔ʂ 15
Γํ 2 perl͕Δ͜ͱΛ్த·ͰͬͯɺநߏจΛར༻͢Δ 16
ίϥϜ: ࠷ۙͷݴޠͩͱݴޠຊମͷASTΛར༻Ͱ͖Δ͜ͱ͕͋Δ •Goͷ go/parser go/token go/types go/ast • GoίϯύΠϥ͜ΕΒΛ͍ͬͯΔ •
ͦ͏Ͱͳ͍Β͍͠ •Rubyͷ RubyVM::AST • 2.6.0͔Βར༻Մೳ 17
੩తղੳͷϝϦοτ (1) •ίʔυͷݟͨ··Λѻ͑Δ • நߏจҎલͰ͋ΕίϝϯτͷதΛ ѻ͑Δ͜ͱ •ݴޠػೳΛ͑ͨදݱྗ • ޙ͔Β੩తܕ͚ͱ͔ 18
࣮ߦग़དྷΔঢ়ଶʹͳΔʹͭΕͯιʔείʔυ্ͷใൈ͚མ͍ͪͯ͘ 19
࣮ߦ࣌ղੳͰར༻Ͱ͖ͳ͍ใ •ۭന, վߦ, ίϝϯτ • ಛघͳॻ͖ํͰར༻Ͱ͖Δ߹͋Δ (ྫ: Pythonͷdocstring) 20
࣮ߦ࣌ղੳͰར༻Ͱ͖ͳ͍ใ •τʔΫϯͷҐஔલޙͷτʔΫϯ • ར༻͞Ε͍ͯΔม͕࣮ࡍʹͲ͜Ͱએ ݴ͞Ε͍ͯΔ͔ͱ͔ • ؔจͷҐஔͳͲελοΫτϨʔε Ͱར༻͢ΔͨΊʹ͍͍ͯΔ 21
੩తղੳͷϝϦοτ (2) •࣮ߦͤͣʹίʔυΛѻ͑Δ • BEGINͰϠόΠ͜ͱ͍ͯͯ͠େৎ • ٯʹݴ͏ͱBEGINͰେࣄͳ͜ͱ͍ͯͯ͠ ݕ͍͠(ޙड़) 22
੩తղੳͷϝϦοτ (3) •ͯ͢ͷ࣮ߦύεʹ͍ͭͯௐ্͛ΒΕΔ ߹͕͋Δ • ࣮ߦ࣌ʹܕόϦσʔγϣϯ͢Δ߹ɺ࣮ ߦ͢Δ·Ͱޭ͢Δ͔Ͳ͏͔͔Βͳ͍ 23
੩తղੳͷσϝϦοτ •PerlͷύʔεΛࣗલ(Ϟδϡʔϧ͏͕)Ͱ Βͳ͍ͱ͍͚ͳ͍͔Βେม •ͦͦߏΛಡΜͰ͍ͬͯͲ͏ʹ͔͢ Δͷେม •perlͷؾ࣋ͪʹͳΒͳ͍ͱ͍͚ͳͯ͘େม 24
ࢲ͕੩తղੳ͍ͨ͠ಈػ ػցͷྗΛआΓͯ ؒҧ͍ͷͳ͍ίʔυΛ ॻ͖͍ͨʂ 25
Perl5Ͱ੩తղੳ ͢ΔͨΊͷπʔϧ 26
Perl5੩తղੳքͷୈҰਓऀ PPI 27
PPI Parse, Analyze and Manipulate Perl (without perl) •Pure Perl͚ͩͰPerlίʔυΛύʔεͯ͠੩
తղੳͰར༻Ͱ͖Δܗʹ͢ΔϞδϡʔϧ 28
༻ྫ (1) use PPI; use PPI::Dumper; my $document = PPI::Document->new(\'my
$v1 = $v2;'); PPI::Dumper->new($document)->print; 29
༻ྫ (2) PPI::Document PPI::Statement::Variable PPI::Token::Word 'my' PPI::Token::Whitespace ' ' PPI::Token::Symbol
'$v1' PPI::Token::Whitespace ' ' PPI::Token::Operator '=' PPI::Token::Whitespace ' ' PPI::Token::Symbol '$v2' PPI::Token::Structure ';' 30
༻ྫ (3) my ($stmt) = $document->children; my $op = $stmt->find_first("PPI::Token::Operator");
$op->content; # => "=" 31
PPIͷಛ (1) •PDOM(ύʔεޙͷߏͷ͜ͱ)͔Βίʔυ ʹॻ͖͢͜ͱ͕ग़དྷΔ $document->prune("PPI::Token::Whitespace"); $document->serialize; # => "my$v1=$v2;" 32
PPIͷಛ (2) •ॻ͖ͨ͢ΊʹτʔΫϯεϖʔεɺ;ͳͲ อ࣋ͨ͠·· •͋͘·Ͱղੳ͢ΔͨΊͷߏͰ͋ͬͯɺ࣮ ߦ͢ΔͨΊͷߏͰͳ͍ 33
PPIͷσϝϦοτ •݁ߏ͍ • 1175ߦͷ࣮ࡍͷۀͷίʔυΛύʔε͠ ͨ݁Ռ • 6.80/s1 1 Macbook Pro
15inch mid 2015 Ͱܭଌ 34
ͦͷଞͷϞδϡʔϧ •Compiler::Lexer ಠࣗͷCݴޠͰॻ͔Εͨ τʔΧφΠβΛ༻ •Perl::Lexer perlຊମͷ෦APIΛୟ͍ͯτʔ ΫϯྻΛऔΓग़͢ 35
PPRͷհͱ ͍ํ 36
PPR Pattern-based Perl Recognizer •PerlίʔυͷύλʔϯΛఆٛͯ͠ݕͰ͖ Δਖ਼نදݱΛ࡞ΕΔϞδϡʔϧ 37
༻ྫ # my $hoge = "fuga"; ͷม໊ΛҾֻ͚ͬΔʹ my $matcher =
qr{ my (?&PerlOWS) ((?&PerlVariableScalar)) (?&PerlOWS) (?&PerlAssignmentOperator) (?&PerlOWS) (?&PerlString) (?&PerlOWS) ; $PPR::GRAMMAR }x 38
༻ྫ my ($var) = grep { defined } $script =~
$matcher; ͜ΕͰ $var ʹ "$hoge" ͕ೖΔ 39
ศརʂʂʂ 40
ʮΘʔʂ͍͖ͳΓ ϠόΠਖ਼نදݱ͕ ग़͖ͯͨͧʂʂʯ 41
͍ͬͯͩ͘͞ ղઆ͠·͢ 42
PPRPerlίʔυͷτʔΫϯʹϚον͢Δਖ਼نදݱͷύλʔϯू Perlίʔυྫ PPRͷύλʔϯ my (?&PerlBuiltinFunction) $var (?&PerlVariableScalar) = (?&PerlAssignmentOperator) "hogehoge"
(?&PerlString) 43
සग़ύλʔϯ •(?&PerlOWS) • θϩจࣈҎ্ͷPerl্ͷۭനจࣈ • ۭനվߦΛؚΉ 44
࣮༻ྫ 45
ฐࣾͩͱ͜͏͍͏όϦσʔγϣϯΛΑ͍ͬͯ͘Δ͚ΕͲ sub do_something { my $self = shift; state $rule
= Data::Validator->new( a1 => "Str", b1 => "UInt", ); my $args = $rule->validate(@_); my ($a1, $b1) = $args->{qw/a1 b1/}; # do something... } 46
ϓϥΠϕʔτϝιου ͡Όͳ͔ͬͨΒ ͪΌΜͱόϦσʔγϣϯ ͯ͠ΔΑͶνΣοΫ 47
εΫϦϓτ͔ΒؔఆٛΛൈ͖ग़͢ my $script = ...; my $sub_matcher = qr{ ((?&PerlSubroutineDeclaration))
$PPR::GRAMMAR }x; my @decls = grep { defined } $script =~ m{$sub_matcher}gx; 48
ؔఆ͔ٛΒ໊ؔͱϒϩοΫΛൈ͖ग़͢ my $subname_matcher = qr{ \Asub (?&PerlOWS) ((?&PerlQualifiedIdentifier)) (?&PerlOWS) ((?&PerlBlock))
$PPR::GRAMMAR }x; for my $decl (@decls) { my ($subname, $block) = grep { defined } $decl =~ $subname_matcher; 49
໊͕ؔΞϯμʔείΞ࢝·ΓͳΒεΩοϓ͢Δ for my $decl (@decls) { my ($subname, $block) =
grep { defined } $decl =~ $subname_matcher; next if $subname =~ /\A_/; 50
validatorͷఆٛ my $validator_matcher = qr{ ( (state) (?&PerlOWS) (?&PerlVariableScalar) (?&PerlOWS)
(?&PerlAssignmentOperator) (?&PerlOWS) Data::Validator->new (?&PerlOWS) (?&PerlParenthesesList) (?&PerlOWS) ) $PPR::GRAMMAR }x; 51
validatorͷఆ͕ٛ͋Δ͔ΛௐΔ for my $decl (@decls) { ... next if $subname
=~ /\A_/; my ($validator) = grep { defined } $block =~ $validator_matcher; 52
͋ͱࣽΔͳΓম͘ͳΓ # warningΛग़͢ͳΓ if (!defined $validator) { warn "$subname Ͱ
Data::Validator ͕ΘΕͯͳ͍Αʂ"; } # ςετͰ͚ͤ͜͞ΔͳΓ use Test::More; fail "$subname Ͱ Data::Validator ͕ΘΕͯͳ͍Αʂ"; 53
͜ͷνΣοΫͰൈ͚͍ͯΔͱ͜Ζ •ҾΛऔΒͳ͍ؔΛޡݕ •AttributeSubroutine signature •ҾόϦσʔγϣϯҎ֎ͷvalidator 54
ᘳΛࢦͣ͞ʹࣗͷ࣋ͭίʔυ͚ͩͰ௨Εྑ͍ ͋ΔఔαϘΔ 55
͞ΒʹԠ༻Ҋ •Smart::Args Λ͏Α͏ʹஔ͢Δ • όϦσʔλͷதͷݸʑͷఆٛ·Ͱόϥ͠ ͯൈ͖ग़ͤΔ •LSPͳͲͰҾϦετΛग़͢ 56
PPRਖ਼نදݱͰίʔυ ͷҰ෦Λൈ͖ग़ͯ͠ ݕࠪஔʹ͑Δ 57
ͦ͏͍͏తͷطଘͷϞδϡʔϧ •Perl::Critic • PPIΛͬͨνΣοΧʔ •Perl::Lint • Compiler::LexerΛͬͨνΣοΧʔ 58
੩తղੳͰ ίʔυͷ࣏҆Λ Α͍ͯ͘͘͠ʹʁ 59
ػցͱਓؒʹྑ͍ ίʔυͱ ཆΪϓεͱͯ͠ ͷ੩తղੳ 60
perlೲಘ͕Ͱ͖Δڍಈ͢Δ͠ ڻ͖MAXͷڍಈΛى͜͢͜ͱ͋Δ 61
Only perl can parse Perl (1) •Only perl can parse
Perl ͳ෦ •PPIͷυΩϡϝϯτΑΓ @result = (dothis $foo, $bar); # Which of the following is it equivalent to? @result = (dothis($foo), $bar); @result = dothis($foo, $bar); 62
Only perl can parse Perl (2) $ perl -MO=Deparse -e
'@result = (dothis $foo, $bar);' @result = ($foo->dothis, $bar); -e syntax OK $ perl -MO=Deparse -e 'sub dothis {} @result = (dothis $foo, $bar);' sub dothis { } @result = dothis($foo, $bar); -e syntax OK 63
Γ͍ͨํʹ໌ࣔ͢Δʂʂʂ @result = dothis($foo, $bar); •͍ΖΜͳॻ͖ํ͕Ͱ͖Δݴޠ͔ͩΒͦ͜ɺ Γ͍ͨ͜ͱΛओு͢Δ 64
Only perl can parse Perl (3) sub hoge { "hoge"
} sub f { { hoge() => "fuga" } } # hashref or list ? my @result = f(); 65
Only perl can parse Perl (4) use DDP; p @result;
# [ # [0] "hoge", # [1] "fuga" # ] ϦετʹͳΔͷ͕ਖ਼ղ 66
Only perl can parse Perl (5) hashrefʹ͢Δʹʁ •return Λ͚Δ •ϑΝοτΧϯϚͷࠨลΛจࣈྻʹ͢Δ
•+{} ʹ͢Δ 67
ͭ·ΓͪΌΜͱreturnॻ͚ղܾ͢Δ sub hoge { "hoge" } sub f { return
{ hoge() => "fuga" }; } # hashref desu!!! my @result = f(); 68
Only perl can parse Perl (6) •1ͭͷه߸͕ෳͷҙຯʹΘΕ͍ͯͯ ͍͠ • είʔϓͱϋογϡϦϑΝϨϯεͷ
{} • আࢉͱਖ਼نදݱͷ / 69
ʮ͜Ε͔ͩΒPerlʂʯ 70
! ͚ΕͲ ίʔυͷ໎͍ࢥߟͷ໎͍ Ұݺٵ͓͍ͯɺ͏গ͠ߟ͑Α͏ 71
άϨούϏϦςΟ greppability 72
greppability •ૂͬͨίʔυΛgrepͰݕͰ͖Δ͔Ͳ͏͔ • ΄͔ͷఆ͕ٛ͋ͬͨΒڭ͍͑ͯͩ͘͞ $ hw 'Greeter->say_hello' lib | \
xargs perl -pie 's/Greeter->say_hello/Greeter->send_hello' 73
greppability͕͍ίʔυ •ϝιου໊ΛಈతʹΈཱ͍ͯͯΔ my @params = qr/str vit dex int/; my
$total = sum( map { my $method = $_ . "_factor"; $person->$method; } @params ); 74
ϝιου໊ΛಈతʹΈཱͯͨͱ͖ͷฐ •ʮ͜ͷϝιουͲ͜Ͱ͍ͬͯΔʁʯ͕ ͘͠ͳΔ •ϝιουݺͼग़͠Λ੩తղੳͰநग़͢Δͱ ͖ʹఆͰ͖ͳ͘ͳΔ ͱʹ͔͘ػցʹ༏͘͠ͳ͍ʂʂʂ 75
ͤΊͯจࣈྻ࿈݁ΛΊΔ my @methods = qr/ str_factor vit_factor dex_factor int_factor /;
my $total = sum(map { $person->$_ } @methods); •ϝιου໊͕ϢχʔΫͰ͋ΕgrepʹҾͬ ͔͔ͬͯ͘Δ 76
ಈతܕ͚ݴޠͰ৺ʹ੩తܕ͚ίϯύΠϥΛ࣋ͭ •ίʔυΛॻ͍ͯܕ͕੩తʹܾఆ͢Δ͔Λߟ ͑Δ •ΠϛϡʔλϒϧมͳͲϞμϯݴޠʹ͋Δ ػೳ੍ݶΛಋೖ͢Δͱྑ͍ 77
ͦͷଞ੩తղੳͰࠔΔͷ •࣮ߦ࣌ʹuse͢Δͷ͕ܾ·Δͱ͔ BEGIN ಈ͔͞ͳ͍ͱ֬ఆ͠ͳ͍ͱ͔ •Mo+([uo]se)? ͷ has method ͦΕΛղऍ
͢ΔͷΛ࡞Ε·ͩܕͷ੩తղܾ͕Ͱ͖ Δ߹͕͋Δ 78
ػցʹ༏͚͠ΕಡΉਓؒʹ͍͍ͩͨ༏͍͠ •ॻ͘ਓؒʹݫ͘͠ͳΔ͜ͱ͕͋Δ • ॻ͘ͷҰճ͔ͭҰਓɺಡΉͷn(n>=1) ճ͔ͭmਓ •ػցʹ༏͚͠ΕػցͷࢧԉΛड͚Δ͜ͱ ͕ग़དྷΔ 79
ػցʹਓؒʹ༏͍͠PerlίʔυPerlͷαϒηοτʹͳΔ => ੩తղੳͰྑ͘ͳ͍ίʔυΛݕͰ͖Δ 80
ਓؒʹཉࡶ೦͕͋ΔͨΊɺࣗݾΛ͢Δͷ͍͠ •ʮλΠϓଟ͘ͳΔ͔ΒखΛൈ͜͏ʯͬͯ ͳΔ͜ͱ͕͋Δ •ػցʹҙͯ͠Β͏ • returnෆݕͷϙϦγʔ Perl::Critic ʹ͋Δ 81
ϋεϧʔϧ •Rubyͷࣄྫ Querly •ʮ͜͏͍͏ॻ͖ํ͏ͪͩͱڻ͖͕͍ͬͺ͍ ͔ͩΒνΣοΫ͍ͨ͠ΑͶʯ •PerlͰPPRͰݕՄೳ 82
ͦͷଞϋεϧʔϧͷྫ •Plack::RequestͰ $c->req->param(...)Θ ͳ͍ •DBIx::Class Ͱ ResultSet->search Λ arrayί ϯςΩετͰड͚ͳ͍
ͳͲͳͲ 83
Ұ୴࣭λΠϜ 84
͔͜͜Β͍࣌ؒͬͺ͍·Ͱ Γൈ͚·͢ 85
PPRΛ͍ͬͯͨ͘Ίʹ PPRΛͬͱਂ͘Ζ ͏ʂ 86
PPRͷυΩϡϝϯτʹ͑Δਖ਼نදݱͷϧʔϧ͕ྻڍ͞Ε͍ͯΔ͕... 87
υΩϡϝϯτಡΜͰ ۩ମతʹԿʹϚον ͢Δ͔Θ͔ΒΜͱ͜ΖΛ ίʔυͰಡΜͰΈΔ 88
$PPR::GRAMMAR ΛݟͯΈΔ my $stmt_matcher = qr{ \G (?&PerlOWS) ((?&PerlStatement)) $PPR::GRAMMAR
# <= ίϨ }x; my @stmts = grep { defined } $script =~ m{$stmt_matcher}gcx; 89
90
! 1761ߦ ͱʹμϝʔδ͕དྷΔߦͷਖ਼نදݱ 91
ਖ਼نදݱ͓͚ ! ʹཱ͔ͪ͏ 92
ಡΈํ (1) •(?<PerlDocument> ... ) ϧʔϧఆٛ •(?&PerlStatementSequence) ϧʔϧݺͼग़͠ 93
ಡΈํ (2) (?<PerlDocument> \x{FEFF}?+ # Optional BOM marker (?&PerlStatementSequence) )
# End of rule Ͷɺ؆୯Ͱ͠ΐʁ 94
ಡΈํ (3) ͱ͖Ͳ͖͜͏͍͏পʹग़͘Θ͚͢ΕͲ (?<PerlBuiltinFunction> # Optimized to match any Perl
builtin name, without backtracking... (?=[^\W\d]) # Skip if possible (?> s(?>e(?>t(?>(?>(?>(?>hos|ne)t|gr)en|s(?>erven|ockop))t|p(?>r(?>iority|otoent)|went|grp)) | g(?>et(?>p(?>r(?>oto(?>byn(?>umber|ame)|ent)|iority)|w(?>ent|nam|uid)|eername|grp|pid)| | r(?>e(?>ad(?>lin[ek]|pipe|dir)?|(?>quir|vers|nam)e|winddir|turn|set|cv|do|f)|index|mdir | c(?>h(?>o(?>m?p|wn)|r(?>oot)?|dir|mod)|o(?>n(?>tinue|nect)|s)|lose(?>dir)?|aller|rypt) | e(?>nd(?>(?>hos|ne)t|p(?>roto|w)|serv|gr)ent|x(?>i(?>sts|t)|ec|p)|ach|val(?>bytes)?+|of | l(?>o(?>c(?>al(?>time)?|k)|g)|i(?>sten|nk)|(?>sta|as)t|c(?>first)?|ength) | u(?>n(?>(?>lin|pac)k|shift|def|tie)|c(?>first)?|mask|time) | p(?>r(?>ototype|intf?)|ack(?>age)?|o[ps]|ipe|ush) | d(?>bm(?>close|open)|e(?>fined|lete)|ump|ie|o) | f(?>or(?>m(?>line|at)|k)|ileno|cntl|c|lock) | t(?>i(?>mes?|ed?)|ell(?>dir)?|runcate) 95
Regexp::OptimizerͰੜ͞ΕͯΔΈ͍͔ͨͩ Βେৎʂ 96
͍͍ײ͡ͷࢹ֮ԽΛ͢Δ •ఆ͕ٛผͷͲΕΛࢀর͍ͯ͠Δ͔ • (?&PerlVariable) • (?&PerlScalarAccess) ͱ • (?&PerlHashAccess)
ͱ • (?&PerlArrayAccess) ͷ OR ͩΑ Έ͍ͨͳ 97
͍͍ײ͡ͷՄࢹԽ (1) •PPRͷਖ਼نදݱͷจࣈྻΛൈ͖ग़͢ • ਖ਼نදݱϦϑΝϨϯεͩͱ͍Ζ͍Ζͬ͘ ͍ͭͯ͘ΔͷͰίʔυ্ͷςΩετͦͷ ··͕΄͍͠ • PPRͰൈ͖ग़͢ 98
our $GRAMMAR = qr{ ... }; # ίί ^^^^^^^^^ 99
͍͍ײ͡ͷՄࢹԽ (2) my $stmt_regexp = qr{ our (?&PerlOWS) \$GRAMMAR (?&PerlOWS)
= (?&PerlOWS) ((?&PerlRegex)) $PPR::GRAMMAR }x; my ($regexp) = grep { defined } $ppr_script =~ /$stmt_regexp/gcx; # => "qr{ ... }" 100
͍͍ײ͡ͷՄࢹԽ (3) •PPIx::Regexp Ͱ ਖ਼نදݱͷநߏจʹ͢ Δ use PPIx::Regexp; my $tree
= PPIx::Regexp->new($regexp); 101
͍͍ײ͡ͷՄࢹԽ (4) •͋ͱ࠶ؼͰτʔΫϯΛऩू͍ͯ͘͠ sub traverse { my ($tree, $bucket, $name)
= @_; my $literal = ""; for my $child ($tree->children) { if (ref $child eq "PPIx::Regexp::Token::Literal") { $literal .= $child->content; } elsif (ref $child eq "PPIx::Regexp::Token::Whitespace") { # skip } else { if (length($literal) > 1 && $literal ne '\n') { $bucket->{$name}->{'"' . $literal . '"'} = 1; } $literal = ""; } 102
͍͍ײ͡ͷՄࢹԽ (5) if (ref $child eq "PPIx::Regexp::Token::Recursion") { next if
$child->name eq "PerlOWS"; $bucket->{$name}->{$child->content} = 1; } if ($child->can("children")) { my $next_name = $name; if (ref $child eq "PPIx::Regexp::Structure::NamedCapture") { next if $child->name =~ /^PPR_/; $next_name = $name ? $name . " > (?&" . $child->name . ")" : "(?&" . $child->name . ")"; #PPIx::Regexp::Dumper->new($child)->print; } traverse($child, $bucket, $next_name); } } } 103
͍͍ײ͡ͷՄࢹԽ (6) (?&PerlPackageDeclaration) |-- "\}" |-- "package" |-- (?&PerlBlock) |--
(?&PerlNWS) |-- (?&PerlQualifiedIdentifier) `-- (?&PerlVersionNumber) (?&PerlParenthesesList) |-- "\(" `-- (?&PerlExpression) (?&PerlPod) `-- "=cut" 104
ࣗ༝ࣗࡏʹτʔΫϯΛൈ͖ग़ͤΔʂ PPRͷதΘ͔ͬͨʂ 105
͜͜·ͰདྷΔͱܕΛॻ͍ͯ ͍ͨ͘ͳΓ·ͤΜ͔ʁ 106
ਐత੩తܕ͚ •ಈతܕ͚ݴޠʹ෦తʹ੩తܕ͚Λಋ ೖ͢Δ • TypeScript(JavaScript) Hack(PHP) ͳ Ͳ 107
•ޙ͢ΔʹҎԼͷཁૉ͕ඞཁ • ܕ͕ॻ͚ΔΑ͏ʹͳΔ (PythonͷPEP 484 Type Hints) • ੩తղੳͰܕΛௐΔ͜ͱ͕ग़དྷΔ •
ܕγεςϜΛ࣮͢Δ 108
ܕ͢Ͱʹॻ͚Δ package Greeter { use Function::Parameters; use Function::Return; use Types::Standard
qw/Str Int Bool/; method say_hello(Str :$name, Int :$times) :Return(Bool) { say $self . ": Hello " . $name for 1..$times; return 1; } } Greeter->say_hello(name => "shinpei0213", times => 10); 109
͜ͷؔͷ γάωνϟΛ PPRͰղੳ͢Δ 110
ίʔυͱͯ͠ಡΜͰ͍Ε͜͏ग़དྷΔ͚ΕͲ my $pinfo = Function::Parameters::info \&Greeter::say_hello; my $rinfo = Function::Return::info
\&Greeter::say_hello; 111
ޙʑͷ͜ͱΛߟ͑Δͱ੩తղੳͰऔΓ͍ͨ 112
ͬͯΈΑ͏ͱ͢Δ͕ͦͦPerlͷίʔυͱͯ͠͏·͘ ೝࣝͯ͘͠Εͳ͍ my $doc_matcher = qr{ \A (?&PerlDocument) \Z $PPR::GRAMMAR
}x; say !!($script =~ $doc_matcher); # => ""(false) 113
keyword plugin method say_hello(Str :$name, Int :$times) :Return(Bool) {
say $self . ": Hello " . $name for 1..$times; return 1; } keyword plugin perl 5.12.0 ͔Β͑Δจ ๏֦ுػೳ 114
PPRͦ͏͍͏ͷߟྀग़དྷΔ࡞Γʹͳ͍ͬͯΔ •ͦͦkeyword pluginΛ؆୯ʹॻ͚Δ Keyword::Declare ͷͨΊʹ࡞ΒΕͨϞ δϡʔϧ •keywordͷϧʔϧΛ֦ுͰ͖Δ 115
Function::ParametersʹରԠ͢Δ (1) my $FP_GRAMMAR = qr{ (?(DEFINE) (?<PerlFunctionParametersMethod> method (?&PerlOWS)
(?&PerlIdentifier) (?&PerlOWS) # => say_hello (?&kw_balanced_parens) (?&PerlOWS) # => (Str :$name, Int :$times) (?: (?&PerlAttributes) (?&PerlOWS) # => :Return(Bool) )?+ (?&PerlBlock) # => { ... } ) (?<PerlKeyword> (?&PerlFunctionParametersMethod) ) (?<kw_balanced_parens> \( (?: [^()]++ | (?&kw_balanced_parens) )*+ \) ) ) $PPR::GRAMMAR }x; 116
Function::ParametersʹରԠ͢Δ (2) qr{ (?<PerlFunctionParametersMethod> method (?&PerlOWS) (?&PerlIdentifier) (?&PerlOWS) # =>
say_hello (?&kw_balanced_parens) (?&PerlOWS) # => (Str :$name, Int :$times) (?: (?&PerlAttributes) (?&PerlOWS) # => :Return(Bool) )?+ (?&PerlBlock) # => { ... } ) } 117
Function::ParametersʹରԠ͢Δ (3) qr{ (?<PerlKeyword> # <= keyword֦ுͱͯ͠ొ (?&PerlFunctionParametersMethod) ) (?<kw_balanced_parens>
\( (?: [^()]++ | (?&kw_balanced_parens) )*+ \) ) } 118
Function::ParametersʹରԠ͢Δ (4) my $doc_matcher = qr{ \A (?&PerlDocument) \Z $FP_GRAMMAR
}x; say !!($script =~ $doc_matcher); # => 1 Perlίʔυͱͯ͠ೝࣝͯ͘͠Εͨʂ ͜ΕͰউ ͭΔʂ 119
DEMO 120
ܕ͕ݟΕͨ͋ͱͷ͍Έͪ •ܕγεςϜΛ࣮ͯ͠ਐత੩తܕ͚ •Language Server Protocolʹར༻͢Δ • ΤσΟλ/IDEͰิϝιουใ͕ར ༻Ͱ͖ΔΑ͏ʹͳΔ 121
PPIͱPPRͷ͍͚ •ίʔυͷͯ͢Λར༻͢ΔͳΒPPI •ίʔυͷҰ෦Λൈ͖ग़ͨ͠Γ༗Δແ͠Λ ݟΔͳΒPPR • ਖ਼نදݱͳͷͰϦϑΝΫλϦϯάʹར ༻Մೳ 122
·ͱΊ •Perl5ेʹ੩తղੳ͕Ͱ͖Δ͜ͱΛࣔ͠ ·ͨ͠ •۩ମతͳΓํ͍ಓʹ͍ͭͯ͠·͠ ͨ •ػցͱਓؒͷڞଘʹ͍ͭͯ͠·ͨ͠ 123
Any Questions? 124
Q: ࣏҆Λྑ͘͢ΔͨΊͷίʔυ͕࣏͕҆ѱ͍ •A1: ਖ਼نදݱίʔυͷ࣏͕҆ѱ͘ͳΔҰ ͭͷཁૉͰ͕͢ɺίϝϯτϧʔϧΛ׆༻ ͠·͠ΐ͏ 125
Q: ࣏҆Λྑ͘͢ΔͨΊͷίʔυ͕࣏͕҆ѱ͍ my $matcher = qr{ # ͜͜ʹίϝϯτ͕ॻ͚·͢ (?(DEFINE) (?<MyCustomPattern>
# ͜͜ʹ͖ͳύλʔϯΛ࡞ͬͯύλʔϯʹ໊લΛ͚ͭΑ͏! ) ) }x; 126
Q: ͳΜͰͦ͜·Ͱͯ͠PerlΛ͏ΜͰ͔͢ (1) •A1: 10ສߦҎ্͋ΔPerlίʔυ͕͋Γɺࠓ ͪΌΜͱಈ͍͍ͯͯɺͪΌΜͱอक͞Ε ͍ͯΔ߹ʹଞͷݴޠʹஔ͖͑Δ͔Ͳ͏ ͔ • ଞͷݴޠͷਐతܕ͚ͷ࣮͢Δಈػ
127
Q: ͳΜͰͦ͜·Ͱͯ͠PerlΛ͏ΜͰ͔͢ (2) •A2: Perl5͔ͳΓջͷਂ͍ݴޠ • hackable • จ๏͕͔ͳΓࣗ༝ͰɺϞμϯͬΆ͍ॻ͖ ํ͕Ͱ͖Δ
• keyword plugin 128