[Haskell-cafe] problem with IO, strictness, and "let"

Michael Vanier mvanier at cs.caltech.edu
Fri Jul 13 00:22:09 EDT 2007


I stumbled across a problem with IO and strictness that I could fix, but I can't understand why the 
fix works.  I've compressed it down into a program which simply computes the number of lines in a 
file.  Here is a version that doesn't work:

module Main where

import System.IO
import System.Environment

process_file :: FilePath -> IO ()
process_file filename =
     do h <- openFile filename ReadMode
        c <- hGetContents h
        let cs = unlines $ lines c
        hClose h
        putStrLn $ show $ length cs

main :: IO ()
main = do args <- getArgs
           process_file (args !! 0)

This will return a length of 0 lines for any input file.  Obviously, the "let" is not being 
evaluated strictly (nor would we expect it to be), so that when the evaluation is requested, the 
file is already closed and the length of the list of lines is 0 (though I might have expected an 
error).  I then tried this:

process_file :: FilePath -> IO ()
process_file filename =
     do h <- openFile filename ReadMode
        c <- hGetContents h
        let cs = id $! lines c -- try to strictly evaluate the let binding
        hClose h
        putStrLn $ show $ length cs

which also failed exactly as the previous version did (i.e. always returning 0).  Then I gave up on 
"let" and did this:

process_file :: FilePath -> IO ()
process_file filename =
     do h <- openFile filename ReadMode
        c <- hGetContents h
        cs <- return $! lines c
        hClose h
        putStrLn $ show $ length cs

This works.  However, I don't understand why this version works and the previous version doesn't. 
Can anyone walk me through the evaluation?  Also, is there a way to make "let" strict?

TIA,

Mike




More information about the Haskell-Cafe mailing list