普通の言語ではどうやっても真似できない変態FizzBuzzをSqueak Smalltalkで

あるいは、いかにしてここ数年来の懸案だった n fizz buzz 形式のメソッドコールによる FizzBuzz をいわゆる“黒魔術”(―を通り越してもはや禁じ手の類)を用いて実現したか。


オーソドックスに―ということであれば n fizz, n buzz ifEmpty: [n] が Smalltalk での FizzBuzz のベストアンサーだと思っている私ではありますが、それとは別に、考え得るもっともシンプルな式である n fizz buzz と書くだけで同様のことを実現できないものかということも定期的に巡ってくるブームのたびに模索し続けていて、なんとか n fizz buzz value という似た形まではもってこれてはいたものの、最後の余計なメソッドコールをどうにも無くすことができなくて行き詰まっていた、というのがこれまでの流れです。で、今回はその最後のコールをかなり無理矢理ではありますが無くすることができる変態実装をふと思いついたので(特にブームじゃないけれど)実験してみた、というお話。


まずはこれまでのあらすじ。

n fizz buzz という逐次メッセージ送信で FizzBuzz を実現しようとするときに問題になるのは、仮に n が 3 の倍数である場合、n fizz が文字列 'Fizz' を返してしまうと、続く buzz というメッセージはこの 'Fizz' という文字列に送られることになり、その結果コールされるメソッド(#buzz)で元のレシーバーである n が 5 の倍数か否かの判断ができなくなるという事態に陥ることでした。

この事態を回避するために、n fizz にキー・バリューオブジェクト(Association のインスタンス。15 -> 'Fizz')や、文字列 'Fizz' の頭に 15 を付した '15Fizz' を返させ、続く buzz ではそこから必要な n (この場合 15 )を取り出し、必要であれば 'Buzz' を付加して値(15->'FizzBuzz' あるいは '15FizzBuzz' )を返させるというカラクリを使ってお茶を濁していました。多値を気持ちだけ模した感じ、とでも申しましょうか。

ただ残念ながらこのその場しのぎの対処法では、続く buzz でも前の fizz 同様、15->'FizzBuzz' や '15FizzBuzz' という値を返してきてしまいます。そこで最後に適当なメッセージ(仮に value )を送り、期待される 'FizzBuzz' だけ(あるいは 'Fizz' や 'Buzz' 。 空文字であれば n 自身)を返させる必要が生じていたわけです。

きっと多値が扱えたならこの手の心配はしなくてもいいような気もするので、そういう言語(たとえば Scheme )を想定した場合は、この話はおそらくここで終了となるはずです(ちゃんと確かめたわけではありませんが…)。


さて。多値を扱うことができない(つまり、複数の値を返し、かつ、不要なものは無視できる機構を持たない)Smalltalk で 15 fizz buzz という式に 15->'FizzBuzz' ではなく 'FizzBuzz' を返させるには、メソッドに少々細工をして、それが式の最後でコールされたか否かで振る舞いを変えさせる必要があります。具体的には、もしメソッド #buzz に自分が最後のメッセージによりコールされた(あるいは #fizz であれば自分は最後ではない)ということを認識させることができれば、そのメソッド自身に 15->'FizzBuzz' を返すべきか、'FizzBuzz' だけを返せばいいのかを判断させそのように振る舞わせることが可能になるわけです。

ではそんなアクロバティックなことが実際可能なのかというと、普通の言語ではコンパイル時に字句的にどうにかするのでもなければかなり難しそうですが Smalltalk でなら普通に可能っぽそうです。というのも Smalltalk には thisContext という擬変数を介して現在実行中のコンテキスト(スタックフレーム)にアクセスできる機能があるので、それを足がかりにしてさらに呼び出し元のコンテキスト(thisContext sender)やメソッド本体(thisContext sender method)を手繰ったり、その時点でのプログラムカウンタ(thisContext sender pc)の値から次に実行されるバイトコードに至るまで、あらゆることを“実行中”に知ることができるからです。じつに変態ですね。で、こうした情報が一通り揃えば、自分の後にも続けて fizz buzz の類のメッセージが送られるのか否かを機械的に判断できるはず、と考えたわけです。


イデアはまとまったので、まず n fizz buzz がどのようなバイトコード列にコンパイルされるのかを確認します。ブロックあるいはコンテキストに対して method symbolic というメッセージを送る式を print it (alt-p) すると、ブロック内に記述した式に加え、そのブロックに送った method symbolic というメッセージ式を含めた全体(つまり、今 print it した式。Smalltalk の do it や print it は実はメソッドを定義してそれを実行することで実現されている)がどのようにコンパイルされているかを見ることができます。

[15 fizz buzz] method symbolic
 '33 <8F 00 00 04> closureNumCopied: 0 numArgs: 0 bytes 37 to 40
37    <24> pushConstant: 15
38    <D3> send: fizz
39    <D2> send: buzz
40    <7D> blockReturn
41 <D1> send: method
42 <D0> send: symbolic
43 <7C> returnTop
'


余談ですが、Smalltalk 処理系の一部とはいえ、バイトコード処理系は Smalltalk それ自体とは考え方が違うので(たとえば jump と称した goto とかもある)、Smalltalk のコードと、それに対応するバイトコードプログラムを行き来して見比べる際にはちょっとだけ頭の切り替えが必要です。たとえば Smalltalk の世界では 3 + 4 であれば 3 に + 4 というメッセージを送ると解釈しますが、コンパイル後のバイトコードプログラムでの実際の動作は 3 と 4(をスタックに積んだ状態)に + を送るというような書き方がされていますので注意してください。

[3 + 4] method symbolic
 '29 <8F 00 00 04> closureNumCopied: 0 numArgs: 0 bytes 33 to 36
33    <22> pushConstant: 3
34    <23> pushConstant: 4
35    <B0> send: +
36    <7D> blockReturn
37 <D1> send: method
38 <D0> send: symbolic
39 <7C> returnTop
'


もっとも、fizz や buzz のような単項メッセージの場合は、Smalltalk でも送られるのは fizz や buzz だけなので、メッセージ送信に限って言えば、あまり両者の違いを意識する必要はなさそうですが。


閑話休題

あらためて send: hoge という通常のメッセージ送信がどのようにバイトコードで表現されているかを見てみると、D0、D1、…であることが分かります。おそらく 2r11010000 の上位4ビットは共通で、下位4ビットを使って送るメッセージ(つまりセレクタ。実体はシンボル。リテラルとしてメソッド自身が把握している)を決めているのでしょう。

念のため symbolic 送信時にバイトコード解釈文字列を生成する際に使っていると思われる 'send:' という文字列を含むメソッドを検索(send: を選択して alt+shift-e 。method strings with it )することで得られる #send:super:numArgs: というメソッドのさらに呼び出し元(senders of it)を何段階か遡ることで見つかる #interpretNextInstructionFor: というメソッドの内容から、この考え方で正しそうだということが分かります。

   type := byte // 16.  
   offset := byte \\ 16.  
   …
   "type = 13, 14 or 15"
   ^client
      send: (method literalAt: offset + 1)
      super: false
      numArgs: type - 13


type(つまり上位4ビット)がバイトコードの種類、offset(同、下位4ビット)がリテラルとして登録されている送るべきメッセージ(セレクタ)の位置ということで合っていそうです。したがって、type が 13 で method literalAt: offset+1 が #fizz か #buzz であるような場合は、まだ続きにメッセージがあるという判断ができるので 15->'FizzBuzz' を、そうでなければ結果の 'FizzBuzz' を返せばよいということになります。

   sender := thisContext sender.
   method := sender method.
   nextByte := method at: sender pc.
   type := nextByte // 16.
   ^(type = 13 and: [#(fizz buzz) includes: (method literalAt: nextByte \\ 16 + 1)])
      ifTrue: [self]
      ifFalse: [self value ifEmpty: [self key]]


ただこの処理をいちいち #fizz や #buzz といったメソッドの終わりに書くのはおっくうなので、独立したメソッド #fizzBuzzReturn としてまとめてしまいましょう。コールスタックはひとつ深くなるので #fizz や #buzz の呼び出し元である sender は thisContext sender sender にしないといけません。また #(fizz buzz) は、ハードコードするにしてもコンスタントメソッドにまとめておくのがよさそうなので、#fizzBuzzSels というメソッドを新しく切って、それをコールする式に差し替えます。

FizzBuzz >> fizzBuzzSels
   ^#(fizz buzz)

FizzBuzz >> fizzBuzzReturn
   | sender method nextByte type |
   sender := thisContext sender sender.
   method := sender method.
   nextByte := method at: sender pc.
   type := nextByte // 16.
   ^(type = 13 and: [self fizzBuzzSels includes: (method literalAt: nextByte \\ 16 + 1)])
      ifTrue: [self]
      ifFalse: [self value ifEmpty: [self key]]


あとこの方法では Integer だけではなく Association にも #fizz や #buzz を同時に定義しておかないといけないので、両者で共通して使えるコードにして(前後しますが)FizzBuzz というトレイト(ここのところ PHP 5.4 の新規機能としても話題ですね!)にまとめてしまいます。Integer と Association で共通するコードにするためには Integer に #key のコールを多態させるために新たにメソッドを定義したりする必要がありそうですが、面倒なので、毒を食らわば皿まで―とこれも黒魔術もとい禁じ手でさくっと解決してしまいましょう。などなど、もろもろ盛り込んだ最終版がこちらです。

Trait named: #FizzBuzz
   uses: #()
   category: 'FizzBuzz-Trait'

FizzBuzz >> buzz
   self fizzBuzzPrep.
   (self key isDivisibleBy: 5) ifTrue: [self value: self value, 'Buzz'].
   ^self fizzBuzzReturn

FizzBuzz >> fizz
   self fizzBuzzPrep.
   (self key isDivisibleBy: 3) ifTrue: [self value: self value, 'Fizz'].
   ^self fizzBuzzReturn

FizzBuzz >> fizzBuzzPrep
   self value isString ifFalse: [thisContext sender receiver: self -> ''].

FizzBuzz >> fizzBuzzReturn
   | sender method nextByte type |
   sender := thisContext sender sender.
   method := sender method.
   nextByte := method at: sender pc.
   type := nextByte // 16.
   ^(type = 13 and: [self fizzBuzzSels includes: (method literalAt: nextByte \\ 16 + 1)])
      ifTrue: [self]
      ifFalse: [self value ifEmpty: [self key]]

FizzBuzz >> fizzBuzzSels
   ^#(fizz buzz)


試してみます。

Integer uses: FizzBuzz.
Association uses: FizzBuzz.
(1 to: 15) collect: [:n | n fizz buzz]
=> #(1 2 'Fizz' 4 'Buzz' 'Fizz' 7 8 'Fizz' 'Buzz' 11 'Fizz' 13 14 'FizzBuzz')


すばらしい。

もちろん n buzz fizz であっても正常に動作します。

(1 to: 15) collect: [:n | n buzz fizz]
=> #(1 2 'Fizz' 4 'Buzz' 'Fizz' 7 8 'Fizz' 'Buzz' 11 'Fizz' 13 14 'BuzzFizz')


さらに 7 の倍数の場合の pezz を追加したければ、#fizzBuzzSels の配列 #pezz を加え、メソッド #pezz を #fizz や #buzz に倣って定義すればOKです。

FizzBuzz >> fizzBuzzSels
   ^#(fizz buzz pezz)

FizzBuzz >> pezz
   self fizzBuzzPrep.
   (self key isDivisibleBy: 7) ifTrue: [self value: self value, 'Pezz'].
   ^self fizzBuzzReturn
(1 to: 105) collect: [:n | n fizz buzz pezz]
=> #(1 2 'Fizz' 4 'Buzz' 'Fizz' 'Pezz' 8 'Fizz' 'Buzz' 11 'Fizz' 13 'Pezz' 'FizzBuzz' 16 17 'Fizz' 19 
'Buzz' 'FizzPezz' 22 23 'Fizz' 'Buzz' 26 'Fizz' 'Pezz' 29 'FizzBuzz' 31 32 'Fizz' 34 'BuzzPezz' 'Fizz' 37 
38 'Fizz' 'Buzz' 41 'FizzPezz' 43 44 'FizzBuzz' 46 47 'Fizz' 'Pezz' 'Buzz' 'Fizz' 52 53 'Fizz' 'Buzz' 'Pezz' 'Fizz' 58 
59 'FizzBuzz' 61 62 'FizzPezz' 64 'Buzz' 'Fizz' 67 68 'Fizz' 'BuzzPezz' 71 'Fizz' 73 74 'FizzBuzz' 76
 'Pezz' 'Fizz' 79 'Buzz' 'Fizz' 82 83 'FizzPezz' 'Buzz' 86 'Fizz' 88 89 'FizzBuzz' 'Pezz' 92 'Fizz' 94
 'Buzz' 'Fizz' 97 'Pezz' 'Fizz' 'Buzz' 101 'Fizz' 103 104 'FizzBuzzPezz')


まだいろいろと改良できそうですが、とりあえず今回はこのあたりで。