criterion bug code

import Data.List
import qualified Data.Map as Map
import qualified Data.ByteString.Char8 as BS
import Control.Concurrent.Async
import Criterion.Main


compterMotDansFichier =
    Map.fromList . map (\x->(head x, length x)) . group . sort . filter (\x->BS.length x > 5) . BS.words
compterMots = Map.unionsWith (+) . map compterMotDansFichier

compterMotsLecture noms = do
    fmap (Map.unionsWith (+)) $ mapM (\x->fmap compterMotDansFichier $ BS.readFile x) noms

delegerTache _ [] = do return Map.empty
delegerTache n fichiers = do
    let (x,xs) = splitAt n fichiers
    th <- async(delegerTache n xs)
    donneesCourante <- compterMotsLecture x
    result <- wait th
    return $ Map.unionWith (+) donneesCourante result

delegerTache2 _ [] = do return Map.empty
delegerTache2 n fichiers = do
    let
        (x,xs) = splitAt n fichiers
        donneesCourante = (compterMots x)
    th <- async(delegerTache2 n xs)
    result <- wait th
    return $ Map.unionWith (+) donneesCourante result

arbre n fichiers = do
    if length fichiers > n then do
        let (xs1,xs2) = splitAt ((length fichiers) `quot` 2) fichiers
        th1 <- async (arbre n xs1)
        th2 <- async (arbre n xs2)
        r1 <- wait th1
        r2 <- wait th2
        return $ Map.unionWith (+) r1 r2
    else do
        compterMotsLecture fichiers

parMain n xs = do
    dict <- delegerTache n xs
    writeFile "rapport.par.txt" $ show dict

parMain2 n xs = do
    fichiers <- mapM BS.readFile xs
    dict <- delegerTache2 n fichiers
    writeFile "rapport.par2.txt" $ show $ dict

seqMain xs = do
    dict <- compterMotsLecture xs
    writeFile "rapport.txt" $ show dict


seqSimple xs = do
    writeFile "rapport.txt" $ show $ compterMots xs

parSimple n xs = do
    dict <- delegerTache2 n xs
    writeFile "rapport.par.txt" $ show $ dict

arbreMain n xs = do
    dict <- arbre n xs
    writeFile "rapport.arbre.txt" $ show dict

buildTest xs =
    let
        n = 1000
        chunkATenter = [2^i|i<-[1..(truncate  $ logBase 2 $ fromIntegral  n)]]
        benchSeq = [bench "sequentiel sans IO" $ whnfIO  $ seqSimple xs]
        benchPar = (map (\i-> bench ("par " ++ show i ) $ whnfIO $ parSimple i xs) chunkATenter)
    in benchSeq ++ benchPar


main = do
    xs <- mapM BS.readFile fichiers
    defaultMain [bgroup "main" $ buildTest xs ]
    where
        n = 1000
        fichiers = replicate n "test.txt"
        chunkATenter = [2^i|i<-[1..(truncate  $ logBase 2 $ fromIntegral  n)]]
        benchSeq = [bench "sequentiel" $ whnfIO  $ seqMain fichiers]
        benchPar = (map (\i-> bench ("par " ++ show i ) $ whnfIO $ parMain i fichiers) chunkATenter)
        benchPar2 = (map (\i-> bench ("par2 " ++ show i ) $ whnfIO $ parMain2 i fichiers) chunkATenter)
        benchArbre = (map (\i-> bench ("arbre " ++ show i ) $ whnfIO $ arbreMain i fichiers) chunkATenter)