続・遅延IO

少し前に遅延IOの話を書いたと思う。
そのときはgetContentsなどの遅延する関数は
実はモナドの法則(bind演算の結合法則)に従っておらず、
ちょっぴりunsafeで、でも入力を根こそぎ持っていくような
ケースだと大して問題にならないどころか有用にもなりえる…
のような結論に達したのであるが(そうだったっけ?)、
よくよく考えると遅延IOが遅延するが故に実現可能な
アルゴリズム(例としては、私が初期のころに書いた数当て
ゲームなどを参照されたし)などは設計にあたり細心の
注意が必要で、ある程度の複雑さになってくると
SICPでも指摘されている通りに人間には制御しきれなくなってしまう
のでは無かろうかとも思えてくる。そこで、
今回はそんなバリエーションの一つについて考察してみることにする。


ここで例として簡単なアキュームレータープログラムを考える。
インタラクティブなインターフェースを持ち、
最初にコマンドの入力を受け付ける。
コマンドは4つ、

  • add - さらに数値の入力を求め、その数値を加算する。
  • sub - 〃 、その数値を減算する。
  • view - 現在のアキュームレーターの値を表示する。
  • exit - プログラムを終了する。


まず、以下のようなプログラムを作成した。

main = getContents >>= loop 0 . lines

loop acc (s:ss) = case s of
  "add" -> do
    str <- getLine
    loop (acc+read str) ss
  "sub" -> do
    str <- getLine
    loop (acc-read str) ss
  "view" -> do
    print acc
    loop acc ss
  "exit" -> return ()

最初にaddなどと入力すると、
getContentsの処理がgetLineに割り込まれることを期待している。
その後getContentsは何事も無かったかのように数値が抜かれた
入力を吸い上げる。
getLineで引っ張ってこられる入力であるが、
最初のgetContentsの入力はまずlinesに掛けられ、
それから、その先頭が"add"と比較され、この時点ではssについて
何も評価は行われないからadd\nと入力された、まさに次の文字から
になると予想している。
(このような予測が可能なのはプログラムが簡単なうちだけかもしれないが…)


しかし、プログラムを実行してみるとうまく動かなかった。

$ ghc test.hs
$ ./a.out
view
0
add

Fail: : hGetLine: illegal operation (handle is closed)

どうやら、getContentsは他の入力に割り込まれないように
先立ってハンドルをクローズしているようなのである。
(GHCの人もこのようなやり方は良くないとお考えなのか)


しかし、ここでは引き下がれない。
getContentsを自分で定義して再実行する。

import System.IO.Unsafe
import Control.Monad

getcon = unsafeInterleaveIO $ liftM2 (:) getChar getcon

main = getcon >>= loop 0 . lines

loop acc (s:ss) = case s of
  "add" -> do
    str <- getLine
    loop (acc+read str) ss
  "sub" -> do
    str <- getLine
    loop (acc-read str) ss
  "view" -> do
    print acc
    loop acc ss
  "exit" -> return ()

これでハンドルをクローズされる心配が無くなった。

$ ./a.out
add
123
add
456
view
579
sub
123
view
456
exit

想定した結果を出すことが出来た。


ということで入力を入力にinterleaveすることが出来たのであるが、
こういうのはシロなのだろうか?。


ちなみにこのプログラムは作為的に書いたので
(ちがうインタラクティブシステムの叩き台として)
もっと安全に簡単に

main = interact $ unlines . loop 0 . lines

loop acc (s:ss) = case s of
  "add"  -> loop (acc+read (head ss)) (tail ss)
  "sub"  -> loop (acc-read (head ss)) (tail ss)
  "view" -> show acc:loop acc ss
  "exit" -> []

こうとか、
普通にimperativeに

main = loop 0

loop acc = do
  cmd <- getLine
  case cmd of
    "add" -> do
      str <- getLine
      loop (acc+read str)
    "sub" -> do
      str <- getLine
      loop (acc-read str)
    "view" -> do
      print acc
      loop acc
    "exit" -> return ()

こう書けるとかいう苦情は受け付けませんのであしからず。