Template Haskell のお勉強ちう - 日曜プログラマがダラダラ書く

ご注意

この記事で Template Haskell の解説はいたしません。それについては、@mr_konn さんによるチュートリアルが大変分かりやすいので、そちらをご参照ください。

私はまだ前半分しか読んでませんけどね!

前置き

Yesod なりなんなり、他人様のコードを読ませてもらって Haskell のお勉強をしようにも、Template Haskell が分からないとどれも読めない、という感じになってきましたので、ちょっくら自分で Template Haskell を使ったコードを何か書いてみようと思いました。

で、コンパイル時プログラミングと言えばレイトレーシングだよね!*1 ということで、まず、普通にレイトレーサを書いてみました (初手から脱線*2 )。書いたコードはこちら→ https://github.com/h-hirai/SimpleRayTracer

Paul Graham 著「ANSI Common Lisp (スタンダードテキスト)」にある例をベタに移植したもので、反射、透過、屈折などなどなにもなし、多分レイトレーサとしては一番簡単なやつです。そのままだと出来上がる画像があんまりさみしいので色を付けたのと、BMP を出力するようにしたくらいが変更点。*3

こんな画像を生成できます。オブジェクトの数にすごい依存しますが、2010年モデルの MacBook Air で1分くらい? *4

で、これをコンパイル時に計算させる

コンパイル時プログラミングの用途ってそうじゃないだろう、というツッコミが己のうちから聞こえてきます。無視しますが。

まず、ふつうのレイトレーサを書いた時、最終段階の trace 関数がこんなかんじでした。*5

trace :: World -> Vector3D -> Float -> Float -> Float -> Float -> Float -> BMP
trace w eyePos startx endx starty endy step =
  packRGBA32ToBMP width height $
  B.concat [packCol $ colorAt w eyePos col row |
          row <- [starty, starty + step .. endy],
          col <- [startx, startx + step .. endx]]
  where
    width = 1 + floor ((endx - startx) / step)
    height = 1 + floor ((endy - starty) / step)

これを、main では以下のように呼びます。もともとは RayTracer.hs のなかで main まで定義していたのですが、Template Haskell 版を作る際に、main は ray_tracer.hs に分けました。

main :: IO ()
main = writeBMP "result.bmp" $
       trace (world_b ++ world_c) eyePos (-96) 96 (-54) 54 0.2

んで、

コンパイル時に計算させるにあたって、RayTracer モジュールを wrap するかたちで RayTracerTH を定義しました。これで定義しなおされている trace を、main で以下のように呼びます。(ray_tracer_th.hs)

main :: IO ()
main =
  let startx = -96
      endx = 96
      starty = -54
      endy = 54
      step = 0.2
      width = 1 + floor ((endx - startx) / step)
      height = 1 + floor ((endy - starty) / step) in
  writeBMP "result.bmp" $
  packRGBA32ToBMP width height $
  pack $ $(trace (world_b ++ world_c) eyePos (-96) 96 (-54) 54 0.2)

RayTracerTH.trace は ExpQ を返して、それを main で接合します。もとの RayTracer.trace では BMP を返していましたが、こちらでは接合結果 (って言い方であってます?) がリストリテラルになるイメージ。なので、trace でやっていた pack, packRGBA32ToBMP が TH 版では main に来ています。BMP 型や ByteString 型の値の ExpQ が作れるのかどうかは分かりません。

あと、let で束縛されている変数は $() の中では参照できません。ので、trace には即値を渡したりしています。このへんあとで要整理。

さて、その RayTracerTH.trace は以下のように書き換えました。

trace :: World -> Vector3D ->
         Float -> Float -> Float -> Float -> Float ->
         ExpQ
trace w eyePos startx endx starty endy step = do
  let ws = concat [packCol $ colorAt w eyePos col row |
                   row <- [starty, starty + step .. endy],
                   col <- [startx, startx + step .. endx]]
  listE $ map (litE . integerL . fromIntegral) ws

出力画像の一画素ごとに colorAt を呼ぶところまでは、もとと同じです。packCol は、もとは Color -> ByteString 型の関数でしたが、RayTracerTH で Color -> [Word8] に書き直されています。最後の行で、計算されたリストを ExpQ に変換します。

たったこれだけの変更で、レイトレーシングがコンパイル時にできるようになります、すごい!

と、思いきや

ghc: sorry! (unimplemented feature or known bug)
  (GHC version 7.0.4 for i386-apple-darwin):
	Trying to allocate more than 1040384 bytes.

See: http://hackage.haskell.org/trac/ghc/ticket/4505
Suggestion: read data from a file instead of having large static data
structures in the code.

orz

しかたないので、小さい画像サイズでとにかく動かしてみます。trace の引数 step が小さいほど画像解像度が高くなりますので、これを逆に大きくします。2.0 まで大きくしてやっとコンパイルが通るようになりました。

実行して出力される画像がこちら。