Purely Functional Lazy IO

ほんもののプログラマや浮世プログラマ(Real World Programmer)には評判の悪い「純粋に関数的で怠惰な入出力」ですが,私のような浮世離れの怠惰プログラマにはこの上なく魅力的に見えます.リソースも実行順序も考えない世界に逃避するための仕組みをつくってみました.「オイ」というデータ構造を使ってトイ未満プログラムです.

 {-# LANGUAGE TypeOperators #-}
 module Main where

 import Data.OI
 import Data.Char
 import System.IO

 main :: IO ()
 main = do { [] <- run pmain'
           ; return () }

 pmain :: ([Int], [()]) :-> [()]
 pmain = puts <| gets

 gets :: [Int] :-> String
 gets = map chr . takeWhile (eof /=) . mapOI getc

 puts :: String -> [()] :-> [()]
 puts s = dropWhile (()==) . snd . zipWithOI' putc s

これは単純に標準入力からデータを読んで標準出力に出すだけの処理を書いたものです.Haskellではプログラムの型は IO () なので一番外側では IO になっていますが,pmain を構成するのは IO ではなく関数だけで構成してあることに注目してください.

run :: (a :-> b) -> IO b は対話関数をIOに変換します.
(<|) :: (b -> c :-> d) -> (a :-> b) -> (a,c) :-> d は2つの対話関数を接続する高階関数です.

上の pmain では

  • 一文字読み込む関数 getc を合成して文字列を読み込む関数 getsを合成
  • 一文字書き出す関数 putc を合成して文字列を書き出す関数 putsを合成
  • gets と putsを連結して pmain を構成

ということを純粋に関数のみでおこなっています.pmain は以下のようにすることもできます.
型が違うことに注意してください.

 pmain' :: [(Int, ())] :-> [()]
 pmain' = dropWhile (()==) . mapOI echo

 echo :: (Int, ()) :-> ()
 echo = (putc . chr) <| getc

この pmain は合成のしかたが違いますね.これも純粋に関数だけで構成されています.
もちろん.getc や putc といった入出力のプリミティブは Haskell で実装する以上,IO を使わざるを得ませんが,iooi :: IO a -> (a :-> a) という変換関数を使って簡単に関数に変換できます.

getc :: Int :-> Int
getc = iooi getchar

putc :: Char -> () :-> ()
putc = iooi . putChar

eof :: Int
eof = -1

choice :: a -> a -> Bool -> a
choice t f c = if c then t else f

getchar :: IO Int
getchar = choice (return (-1)) (return . ord =<< getChar) =<< isEOF 

肝心の OI がでてきてませんが,type a :-> b = OI a -> b です.もうひとつトイ未満な例(トイ未満な例しかまだない :p)を挙げましょう.再帰的にディレクトリ内のファイルをたどって列挙するという例です.ちょいとナイーブな実装ですが,Purely Functional に構成していますので,lazy な性質が保持されていることが期待できます.実際にやってみるとちゃんと lazy になっていることが確認できます.

{-# LANGUAGE TypeOperators #-}
module Main where

import Data.OI

import Data.List

import System.FilePath
import System.Directory
import System.Environment

main :: IO ()
main = do { args <- getArgs
          ; case args of
              []  -> print =<< run (pmain ".")
              a:_ -> print =<< run (pmain a)
          }

pmain :: FilePath -> [(Bool, [FilePath])] :-> [FilePath]
pmain = recDirectoryContents

isDirectory :: FilePath -> Bool :-> Bool
isDirectory = iooi . doesDirectoryExist

directoryContents :: FilePath -> [FilePath] :-> [FilePath]
directoryContents f = map (f </>) . filter (`notElem` [".",".."])
                    . iooi (getDirectoryContents f)

recDirectoryContents :: FilePath -> [(Bool,[FilePath])] :-> [FilePath]
recDirectoryContents root = fst . recdircs root

recdircs :: FilePath -> [(Bool,[FilePath])] :-> ([FilePath], OI [(Bool,[FilePath])])
recdircs t <<rbfps? : rbfpss?>> = case rbfps of
  <<rb?,rfps?>> -> case isDirectory t rb of
      False -> ([t],rbfpss)
      True  -> let { ts        = directoryContents t rfps
                   ; (rs,tss)  = mapAccumL acc rbfpss ts
                   ; acc r' fp = swap (recdircs fp r')
                   } in 
               (concat tss, rs)
recdircs t <<[]>> = error $ "recdircs: impossible!"

swap :: (a,b) -> (b,a)
swap (x,y) = (y,x)

<> や <> は OI 上の特殊なパターンマッチ表現で実際には使えません.実際のコードは以下のようになっています.

recdircs :: FilePath -> [(Bool,[FilePath])] :-> ([FilePath], OI [(Bool,[FilePath])])
recdircs t r = case deList r of
  Just (rbfps, rbfpss) -> case deTuple rbfps of
    (rb,rfps) -> case isDirectory t rb of
      False -> ([t],rbfpss)
      True  -> let { ts        = directoryContents t rfps
                   ; (rs,tss)  = mapAccumL acc rbfpss ts
                   ; acc r' fp = swap (recdircs fp r')
                   } in 
               (concat tss, rs)
  _ -> error $ "recdircs: impossible!"

ここで, deList と deTuple は以下のようになっています.

deList  :: OI [a]   -> Maybe (OI a, OI [a])
deTuple :: OI (a,b) -> (OI a, OI b)

型構成子 OI にはいろいろ性質があるだろうと思われます(歯切れば悪いのは形式的にまだ証明していないからです).Functor,Applicative,Monad,Comonad のインスタンスとして宣言してあります.(:->)は Category,Arrow のインスタンスを構成できるでしょう.

N.B. (:->)は型シノニムなので現在のGHCでは Category や Arrow のインスタンスとして宣言はできません.

容易に想像できるとおり, Data.OI モジュールのソースコードは伏魔殿です.トイ以上のプログラムを書けば隙間だらけであることも想像のとおりでしょうね.それでもどうしてもソース見たいとい方は Hackage からどうぞ

http://hackage.haskell.org/package/oi

当然無保証.上のトイ未満のプログラムでもすべての最適化を無効にしてコンパイルしないと上手く動きません.ソースコードを見て目が腐っても責任はもてません.もっとよい実装があるよと教えていただければ嬉しいです.