wc そのさん

id:ha-tan:20061113:1163420617の続き。
正格評価するようにしたら上手くいきました。うーん、遅延評価の辛さが…

module Main (main) where

import Data.Char (isSpace)
import System.IO (stdin, hSetBinaryMode)

getBinaryContents :: IO String
getBinaryContents = do
  hSetBinaryMode stdin True
  getContents

wc :: String -> (Int, Int, Int)
wc = wc' (0, 0, 0) False
  where
    wc' (l, w, b) sp []
      | sp        = (l, w,     b)
      | otherwise = (l, w + 1, b)
    wc' (l, w, b) sp (x : xs)
      | x == '\n'       = seq ln $ seq bn $ wc' (ln, w,  bn) True  xs -- この辺。
      | sp && isSpace x =          seq bn $ wc' (l,  w,  bn) True  xs
      | isSpace x       = seq wn $ seq bn $ wc' (l,  wn, bn) True  xs
      | otherwise       =          seq bn $ wc' (l,  w,  bn) False xs
      where
        (ln, wn, bn) = (l + 1, w + 1, b + 1)

main :: IO ()
main = print . wc =<< getBinaryContents

実行例:

$ ./a < c:/usr/cygwin/bin/cygcrypto-0.9.7.dll
(4944,43030,1134891)