Debugging a stack overflow in haskell

Question

I'm new to Haskell and functional programming and I have a program which works but overflows the stack after a few seconds. My question is, what should I do from here? How can I get at least a hint of where it occurs, print the stack or anything?

The program is very slow when running in ghci with :trace so the stack overflow does not occur. It does not occur also with runhaskell which will just eat more and more memory. I get the error only when compiling with ghc and executing.

Answer 1

In your case, it is a strictness problem that is causing the stack overflow. One really easy way to find such issues is using the deepseq library. This adds a few functions that allow you to fully evaluate a value (which is better than seq, which only goes one level down). The key function is force :: NFData a => a -> a. This takes a value, fully evaluates it, and the returns it.

It only works on types that implement the NFData type class though. Luckily, there is a template haskell macro in the deepseq-th library: deriveNFData. This is used with your own data types, eg deriveNFData ''BfMachine.

To use, you put force $ in front of your functions that may be having strictness problems (or liftM force $ for monadic functions). Eg with your code, I put it in front of step, since that was the key function in the file:

{-# LANGUAGE TemplateHaskell #-}
import Data.Char
import Debug.Trace
import Control.DeepSeq
import Control.DeepSeq.TH
import Control.Monad (liftM)

type Stack = [Int]

data BfMachine = BfMachine
    { program :: String
    , pc :: Int
    , stack :: Stack
    , sp :: Int
    } deriving Show
deriveNFData ''BfMachine

setElem :: [Int] -> Int -> Int -> [Int]
setElem list n value = map (\(i, v) -> if i == n then value else v) (zip [0..] list)

step :: BfMachine -> IO (BfMachine)
step m@(BfMachine { program = program, pc = pc, stack = stack, sp = sp }) = liftM force $
    case program !! pc of
    '-' -> return m { pc = pc + 1, stack = setElem stack sp ((stack !! sp) - 1) }
    '+' -> return m { pc = pc + 1, stack = setElem stack sp ((stack !! sp) + 1) }
    '<' -> return m { pc = pc + 1, sp = sp - 1 }
    '>' -> return m { pc = pc + 1, sp = sp + 1 }
    '[' -> return $ if stack !! sp /= 0 then m { pc = pc + 1 }
                    else m { pc = (findNextBracket program $ pc + 1) + 1 }
    ']' -> return m { pc = findPrevBracket program $ pc - 1 }
    '.' -> do putChar $ chr $ stack !! sp
              return m { pc = pc + 1 }
    ',' -> do c <- getChar
              let s' = setElem stack sp $ ord c
                 in return m { stack = s',  pc = pc + 1 }
    a -> return m { pc = pc + 1 }

findNextBracket :: String -> Int -> Int
findNextBracket program pos =
    case program !! pos of
    '[' -> findNextBracket program $ (findNextBracket program $ pos + 1) + 1
    ']' -> pos
    x -> findNextBracket program (pos + 1)

findPrevBracket :: String -> Int -> Int
findPrevBracket program pos =
    case program !! pos of
    ']' -> findPrevBracket program $ (findPrevBracket program $ pos - 1) - 1
    '[' -> pos
    x -> findPrevBracket program (pos - 1)

isFinished :: BfMachine -> Bool
isFinished m@(BfMachine { program = p, pc = pc })
    | pc == length p = True
    | otherwise = False

run :: BfMachine -> IO ()
run m = do
    if isFinished m then
        return ()
    else do
        m <- step m
        run m

fib = ">++++++++++>+>+[ [+++++[>++++++++<-]>.<++++++[>--------<-]+<<<]>.>>[ [-]<[>+<-]>>[<<+>+>-]<[>+<-[>+<-[>+<-[>+<-[>+<-[>+<- [>+<-[>+<-[>+<-[>[-]>+>+<<<-[>+<-]]]]]]]]]]]+>>> ]<<< ] This program doesn't terminate; you will have to kill it.  Daniel B Cristofani (cristofdathevanetdotcom) http://www.hevanet.com/cristofd/brainfuck/"
main = run BfMachine { program = fib , pc = 0, stack = replicate 1024 0, sp = 0 }

This actually solves the problem - even after a few minutes running, it hasn't crashed and memory usage is only 3.2MB.

You can stick with that solution, or try to find where the real strictness problem is (as that makes everything strict). You do this by removing the force from the step function, and trying it on the helper functions it uses (eg setElem, findPrevBacket, etc). It turns out that setElem is the culprit, putting force in front of that function also solves the strictness problem. I'm guessing it is because the if in the map lambda means most values never have to be evaluated in the list, and possibly build up huge thunks as the program continues.

Answer 2

See http://book.realworldhaskell.org/read/profiling-and-optimization.html for general guidelines on profiling