Something of a cautionary tale about mysterious memory leak that I think I should share with others, in case any one else makes the same mistake in future! This is a follow-up to another leak post. The simple code below causes space leak when another branch is added in loop2
by mistake:
{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -fno-full-laziness #-}
module Main where
import Control.Concurrent.Async (async,waitCatch,waitAnyCatchCancel,asyncThreadId)
import Control.Monad (when)
import Control.Concurrent.Chan
import GHC.Conc -- Thread status debugging when testing async exceptions
main :: IO ()
main = do
testChan <- newChan :: IO (Chan Int)
let loop1 !val = do
writeChan testChan val
threadDelay 10
loop1 (val + 1)
let loop2 = do
val <- readChan testChan
if (val > 100000000) then return () else loop2
loop2 -- Let us add this by mistake. This will cause memory leak
loop1Async <- async (loop1 0)
loop2Async <- async loop2
(_,res) <- waitAnyCatchCancel ([loop1Async,loop2Async])
return ()
Compiling with ghc Leak.hs -O2 -o Leak -rtsopts -threaded
(compiler version: ghc 8.8.4
), and then running with ./Leak +RTS -s -hT -N
will cause memory to climb linearly. Removing last line in loop2
above fixes this, and makes it run in constant space.
It took me a while before I could figure out what was causing a slow leak in a more complex program that was supposed to take constant space in loop. It was caused by extra branching statement at the end that was never taken logically, but was still there. Something like below:
loop = do case someStuff of something -> doSomething >> loop _ -> doSomethingElse >> loop loop -- This causes leak, plus is never taken because of case statement above