GCがパフォーマンス低下を引き起こす？ ref: http://qiita.com/myuon_myon/items/1eb2dabc71ff33a8e572

file0.hs

{-# LANGUAGE TemplateHaskell #-}
import System.Environment
import Control.Monad.State
import Control.Lens

data Obj = Obj { _pos :: (Integer, Integer) } deriving Show
makeLenses ''Obj

benchmark1 :: [Obj] -> IO [Obj]
benchmark1 g = mapM (\e -> update `execStateT` e) g
  where
    update :: StateT Obj IO ()
    update = pos %= (\(x,y) -> (x+10, y+10))

benchmark2 :: [Obj] -> IO [Obj]
benchmark2 g = mapM update g
  where
    update :: Obj -> IO Obj
    update e = return $ pos %~ (\(x,y) -> (x+10, y+10)) $ e

benchmark3 :: [Obj] -> [Obj]
benchmark3 = map update
  where
    update :: Obj -> Obj
    update e = pos %~ (\(x,y) -> (x+10, y+10)) $ e

benchmark4 :: [Obj] -> IO [Obj]
benchmark4 = execStateT $ do
  g <- get
  let g' = map update g
  put g'
  where
    update :: Obj -> Obj
    update e = pos %~ (\(x,y) -> (x+10, y+10)) $ e

benchmark5 :: [Obj] -> IO [Obj]
benchmark5 = execStateT $ do
  g <- get
  g' <- mapM (\e -> lift $ update `execStateT` e) g
  put g'
  where
    update :: StateT Obj IO ()
    update = pos %= (\(x,y) -> (x+10, y+10))

benchmark6 :: [Obj] -> IO [Obj]
benchmark6 = execStateT $ do
  g <- get
  let g' = map (\e -> update `execState` e) g
  put g'
  where
    update :: State Obj ()
    update = pos %= (\(x,y) -> (x+10, y+10))

mainloop :: Integer -> IO [Obj] -> ([Obj] -> IO [Obj]) -> IO Integer
mainloop 0 g _ = (sum . map (\e -> snd $ e^.pos)) `fmap` g
mainloop n g update = mainloop (n-1) (update =<< g) update

mainloop' :: Integer -> [Obj] -> ([Obj] -> [Obj]) -> Integer
mainloop' 0 g _ = sum . map (\e -> snd $ e^.pos) $ g
mainloop' n g update = mainloop' (n-1) (update g) update

main = do
  u <- fmap (read . head) getArgs
  let loopN = 5000
  let objN = 10000
  let g = map (\i -> Obj (i,i^2)) [1..objN]

  print =<< case (u::Integer) of
    1 -> mainloop loopN (return g) benchmark1 
    2 -> mainloop loopN (return g) benchmark2 
    3 -> return $ mainloop' loopN g benchmark3
    4 -> mainloop loopN (return g) benchmark4
    5 -> mainloop loopN (return g) benchmark5
    6 -> mainloop loopN (return g) benchmark6