id:TAKESAKO に挑戦してみる

Perlで記号プログラミング - TAKESAKOのはてな出張所

脳内パーサはあまり役に立たなかったので、perl インタプリタ様の力を借りてみる。
!!まずはデバッガで
これを見ると、実行時はずいぶんと簡単に見えるようになっていることが分かった。

$ perl -d a.pl

Loading DB routines from perl5db.pl version 1.31
Editor support available.Enter h or `h h' for help, or `man perldebug' for more help.

main::(a.pl:6):

  DB<1> n
main::((reeval 4)[a.pl:6]:1):

  DB<1>
main::((reeval 4)[a.pl:6]:1):

  DB<1>
main::((eval 12)[(reeval 4)[a.pl:6]:1]:1):
1:      $@='';for$^(split/(.{8})/,$^){next if$^eq'';$^=~tr|!-/:-@[-`{-~|\0-\37|;$_=unpack'B*',$^;s/...(.{5})/$1/g;$^=length;$@.=pack'B*',$^&7?substr$_,0,$^&~7:$_}eval$@

  DB<1>
main::((eval 12)[(reeval 4)[a.pl:6]:1]:1):
1:      $@='';for$^(split/(.{8})/,$^){next if$^eq'';$^=~tr|!-/:-@[-`{-~|\0-\37|;$_=unpack'B*',$^;s/...(.{5})/$1/g;$^=length;$@.=pack'B*',$^&7?substr$_,0,$^&~7:$_}eval$@

### 長いので省略

  DB<1>
main::((eval 12)[(reeval 4)[a.pl:6]:1]:1):
1:      $@='';for$^(split/(.{8})/,$^){next if$^eq'';$^=~tr|!-/:-@[-`{-~|\0-\37|;$_=unpack'B*',$^;s/...(.{5})/$1/g;$^=length;$@.=pack'B*',$^&7?substr$_,0,$^&~7:$_}eval$@

  DB<1>
main::((eval 13)[(eval 12)[(reeval 4)[a.pl:6]:1]:1]:1):
1:      for(1..99){print"$_: 円周率は 約 3.14 です。\n"}

  DB<1>
main::((eval 13)[(eval 12)[(reeval 4)[a.pl:6]:1]:1]:1):
1:      for(1..99){print"$_: 円周率は 約 3.14 です。\n"}

  DB<1> n
1: 円周率は 約 3.14 です。
main::((eval 13)[(eval 12)[(reeval 4)[a.pl:6]:1]:1]:1):
1:      for(1..99){print"$_: 円周率は 約 3.14 です。\n"}

  DB<1>
2: 円周率は 約 3.14 です。
main::((eval 13)[(eval 12)[(reeval 4)[a.pl:6]:1]:1]:1):
1:      for(1..99){print"$_: 円周率は 約 3.14 です。\n"}

  DB<1>
3: 円周率は 約 3.14 です。
main::((eval 13)[(eval 12)[(reeval 4)[a.pl:6]:1]:1]:1):
1:      for(1..99){print"$_: 円周率は 約 3.14 です。\n"}

### 長いので省略

  DB<1> c
8: 円周率は 約 3.14 です。
9: 円周率は 約 3.14 です。
10: 円周率は 約 3.14 です。

### 長いので省略

99: 円周率は 約 3.14 です。
Debugged program terminated.  Use q to quit or R to restart,
  use o inhibit_exit to avoid stopping after program termination,
  h q, h R or h o to get additional info.

  DB<1>

!! Concise してみる
よく考えたら構文木なので、元の意味不明状態はあまり改善されるわけなかった...

$ perl -MO=Concise a.pl
g  <@> leave[1 ref] vKP/REFC ->(end)
1     <0> enter ->2
2     <;> nextstate(main 2 a.pl:6) v ->3
f     <@> list vK ->g
3        <0> pushmark v ->4
6        <2> sassign vKS/2 ->7
4           <$> const(PV "-^\\\\%+\"<&]\\$=/**:.](%_,//;<#)\\^_%$=].\"\\&='?/:$?({/!_})(([=##!-^/'%_#\"]{\"? <]$':$;#\"&]`<#:?") s ->5
-           <1> ex-rv2sv sKRM*/1 ->6
5              <$> gvsv(*^) s ->6
9        <2> sassign vKS/2 ->a
7           <$> const(PV "_ `||`]@^_`\"./,))<%?%<\"(?<_}+^.;#^^@@{`:,|[{_``__[]_;/@-< <;^.[^ ::<&\"\"[_`}*.[?]+[?!|-_`@[*);//(]?\",=_+?]{{#`,@@<*@[{|/`.@#@[\"\"[+_}[?__(?.+[_}<.?_\"{>|!{}@@^_,{<") s ->8
-           <1> ex-rv2sv sKRM*/1 ->9
8              <$> gvsv(*^_) s ->9
c        <2> bit_xor[t1] vKS ->d
-           <1> ex-rv2sv sKRM/1 ->b
a              <$> gvsv(*^_) s ->b
b           <$> const(PV "{>][[[;/,{>/]_@@]((,^!_&+-{#%%@^[* )&_>_][|@{>]!+)! );_?|%.[%<%\"\"/(`>>^`{?@_@+^>@|}.[<{>{(>:(<\";&%_\"){=+:@_}]@%.[^(`_<<]^!@+|`-|:{#}#`,]]]_){\"-;.{|]@`>_\"=%(>@_|") s ->c
e        </> match(/"(?{$^_= tr^\r-\037^(-:^;eval$^_})"/) vKS/RTIME ->f
-           <1> ex-rv2sv sK/1 ->e
d              <$> gvsv(*^_) s ->e

!! コードを少しは読む

$^='-^\\\\%+"<&]\\$=/**:.](%_,//;<#)\\^_%$=]."\\&=\'?/:$?({/!_})(([=##!-^/\'%_#"]{"?~<]$\':$;#"&]`<#:?',

$^ は予約変数だと思うので、perldoc perlvar してみるとこうだった。

$^ The name of the current top‐of‐page format for the currently
selected output channel. Default is the name of the filehandle
with _TOP appended. (Mnemonic: points to top of page.)

日本語でおk


その時点で選択されている出力チャネルの、その時点でのページ先頭フォーマット名。デフォルトでは、ファイルハンドル名に _TOP を続けたもの。 (記憶法: ページの先頭へのポインタ。)
??? こういうことみたい。

$ perl -e 'print $^'
STDOUT_TOP

concise の結果から、これは全部文字列扱いのような気がします。
ということはこれは代入するだけで使い捨て?
行末がカンマだから、次の式も見ないといけない。

$^_='_~`||`]@^_`"./,))<%?%<"(?<_}+^.;#^^@@{`:,|[{_``__[]_;/@-<~<;^.[^~::<&""[_`}*.[?]+[?!|-_`@[*);//(]?",=_+?]{{#`,@@<*@[{|/`.@#@[""[+_}[?__(?.+[_}<.?_"{>|!{}@@^_,{<',

"$^_" はさすがに変数だ。
そしてこれもただの代入、行末カンマで次の式へ。

というのが続くので、結局最後を見るしか。

$^_=~('(?{$^_=~'.('_^""'^'+,|/'."-".('$%'^';{'.'(-:^;'.('[)]@'^'>_<,').'$^_})')))

"$^_" に対する正規表現マッチかー。
どうやってばらすんだろう。
こう ?
"." が文字列連結で、"(" はリスト評価、"^" は排他的論理和だけど文字列の場合は upcase と lowcase を変換するっぽい。

$^_=~
( ### (4)
  '(?{$^_=~'
  .
  ( ### (3)
    '_^""'
    ^
    '+,|/'
    .
    "-"
    .
    ( ### (2)
      '$%'
      ^
      ';{'
      .
      '(-:^;'
      .
      ( ### (1)
        '[)]@'
        ^
        '>_<,'
      )
      .
      '$^_})'
    )
  )
)

ためしに内側のほうから評価してみよう。

### (1)
$ perl -d -e 1

Loading DB routines from perl5db.pl version 1.31
Editor support available.

Enter h or `h h' for help, or `man perldebug' for more help.

main::(-e:1):   1

  DB<1> p '[)]@' ^ '>_<,'
eval

ぬるりときたかもしれない。
これからは '[)]@' ^ '>_<,' ときたら "eval" と覚えよう。
続けてみる。

### (2)
  DB<2> p '$%' ^ ';{' . '(-:^;' . ("eval") . '$^_})'
^(-:^;eval$^_})

### (3)
  DB<3> p '_^""' ^ '+,|/' . "-" . ("^(-:^;eval$^_})")
-^(-:^;eval})

### (4)
  DB<4> p '(?{$^_=~' . ("-^(-:^;eval})")
(?{$^_=~-^(-:^;eval})

だいぶすっきりしてきた。
眠いので続きは明日にしよう。

続けよう。
>$^_=~('?{$^_=~-^(-:^;eval}')