How to use "trace" when dealing with an "out of memory" exception/stackoverflow in Haskell?

Question

Context: I'm writing an interpreter for a language which is basically a small subset of Haskell.

Haskell's lazy evaluation is being a poo and refusing to evaluate this trace command due to (I suspect) an infinite recursion which results in an "Out of memory" exception.

evalE :: VEnv -> Exp -> Value
evalE g e | trace ("VEnv: " ++ show g ++ "\nExp: " ++ show e ++ "\n\n") False = undefined
-- actual definition of evalE follows from here
-- ...

I'm getting the following result:

weber % ./run_tests.sh
Building minhs-0.1.0.0...
Preprocessing executable 'minhs-1' for minhs-0.1.0.0...
Check.hs: out of memory (requested 1048576 bytes)
weber %

Is there some easy way to force trace to evaluate, regardless of the exception? Perhaps a way to quickly force strict evaluation? I really would like to get some debugging info about what it's actually trying to evaluate.

edit: some further googling has revealed the ($!) operator, which is supposed to force strictness. However I've added it to my code and nothing has changed:

evalE g e | trace ("VEnv: " ++ show g ++ "\nExp: " ++ show e ++ "\n\n") $! False = undefined

Any other hints? I really want to force that trace to evaluate it's side effects.

edit2: yet more googling revealed the seq operator, however it is not behaving as advertised.

evalE g e | trace ("VEnv: " ++ show g ++ "\nExp: " ++ show e ++ "\n\n") False `seq` False = undefined

Even this refuses to print the trace.

I also worked out how to get the BangPatterns extension working, but that didn't print the trace either:

evalE !g !e | trace ("VEnv: " ++ show g ++ "\nExp: " ++ show e ++ "\n\n") False = undefined

(full file for reference. It's a multifile program though):

module MinHS.Evaluator where
import qualified MinHS.Env as E
import MinHS.Syntax
import MinHS.Pretty
import qualified Text.PrettyPrint.ANSI.Leijen as PP

import Debug.Trace

type VEnv = E.Env Value

data Value = I Integer
           | B Bool
           | Nil
           | Cons Integer Value
           | Fun VEnv [String] Exp
           deriving (Show)

instance PP.Pretty Value where
  pretty (I i) = numeric $ i
  pretty (B b) = datacon $ show b
  pretty (Nil) = datacon "Nil"
  pretty (Cons x v) = PP.parens (datacon "Cons" PP.<+> numeric x PP.<+> PP.pretty v)
  pretty _ = undefined -- should not ever be used

evaluate :: Program -> Value
evaluate [Bind _ _ _ e] = evalE E.empty e
evaluate bs = evalE E.empty (Let bs (Var "main"))

instance Num Value where
    I x + I y = I (x + y)
    I x * I y = I (x * y)
    I x - I y = I (x - y)
    abs (I x) = I (abs x)
    fromInteger x = I x

instance Integral Value where
    div _ (I 0) = error $ "Cannot divide by zero"
    div (I x) (I y) = I (div x y)
    mod (I x) (I y) = I (mod x y)

instance Real Value where

instance Enum Value where

instance Ord Value where
    I x > I y = x > y
    I x >= I y = x >= y
    I x <= I y = x <= y
    I x < I y = x < y

instance Eq Value where
    I x == I y = x == y
    I x /= I y = x /= y

evalE :: VEnv -> Exp -> Value
evalE g e | trace ("VEnv: " ++ show g ++ "\nExp: " ++ show e ++ "\n\n") False = undefined
evalE g (Num x) = I x
evalE g (App (Prim Neg) x) = (evalE g x) * (-1)
evalE g (Con "False") = B False
evalE g (Con "True") = B True
evalE g (Con "Nil") = Nil
evalE g (App (App (Prim Gt) x) y) = B ((evalE g x) > (evalE g y))
evalE g (App (App (Prim Ge) x) y) = B ((evalE g x) >= (evalE g y))
evalE g (App (App (Prim Lt) x) y) = B ((evalE g x) < (evalE g y))
evalE g (App (App (Prim Le) x) y) = B ((evalE g x) <= (evalE g y))
evalE g (App (App (Prim Eq) x) y) = B ((evalE g x) == (evalE g y))
evalE g (App (App (Prim Ne) x) y) = B ((evalE g x) /= (evalE g y))
evalE g (App (Prim Head) (Con "Nil")) = error $ "Cannot take head of empty list"
evalE g (App (Prim Tail) (Con "Nil")) = error $ "Cannot take tail of empty list"
evalE g (App (Prim Head) (App (App (Con "Cons") x) _)) = evalE g x
evalE g (App (Prim Tail) (App (App (Con "Cons") _) x)) = evalE g x
evalE g (App (Prim Null) list) = case evalE g list of
                                    Nil -> B True
                                    _ -> B False
evalE g (App (App (Con "Cons") (Num x)) y) = Cons x (evalE g y)
evalE g (App (App (Prim Add) x) y) = (evalE g x) + (evalE g y)
evalE g (App (App (Prim Mul) x) y) = (evalE g x) * (evalE g y)
evalE g (App (App (Prim Sub) x) y) = (evalE g x) - (evalE g y)
evalE g (App (App (Prim Quot) x) y) = div (evalE g x) (evalE g y)
evalE g (App (App (Prim Rem) x) y) = mod (evalE g x) (evalE g y)
evalE g (Let bindings exp) = evalE ((E.addAll g . (map (\(Bind str _ _ bexp) -> (str, evalE g bexp)))) bindings) exp
evalE g e@(Var x) = case E.lookup g x of
                    Just y -> y
                    Nothing -> error $ "Variable " ++ x ++ " not defined" ++ errz g e
evalE g (If exp t f) = case evalE g exp of
                        B True -> evalE g t
                        B False -> evalE g f
evalE g e@(Letfun (Bind name _ args exp)) = Fun (E.add g (name, evalE g e)) args exp
evalE g e@(App (Var x) exp) = case E.lookup g x of
                                Just (Fun env args f) -> evalE (E.addAll env [(head args, evalE g exp)]) f
                                Nothing -> error $ "Function " ++ x ++ " not defined" ++ errz g e
evalE g (App exp1 exp2) = case evalE g exp1 of
                            Fun env args f -> evalE (E.addAll env [(head args, evalE g exp2)]) f

evalE g e = error $ "No pattern" ++ errz g e
--evalE g e = error "Implement me!"

errz g e = "\nVEnv: \n" ++ show g ++ "\n\nExp: \n" ++ show e

Show source
| haskell   | debugging   | exception   | stack-overflow   | trace   2017-10-04 22:10 1 Answers

Answers to How to use &quot;trace&quot; when dealing with an &quot;out of memory&quot; exception/stackoverflow in Haskell? ( 1 )

  1. 2017-10-05 00:10

    I think what @leftroundabout is saying is that, if the evaluation of g or e triggers the problem, then the act of tracing will generate an exception before any output is traced.

    trace marshals its argument out to a C string for output. Therefore, show g and show e must be fully evaluated before trace prints a single character of output.

    As an example, the following program:

    import Debug.Trace
    
    badsum = sum [1..1000000]
    
    process g | trace ("processing " ++ show g) False = undefined
    process _ = "whatever"
    
    main = print (process badsum)
    

    when compiled without optimizations and run with a small heap size:

    $ stack ghc -- -fforce-recomp -rtsopts Trace
    [1 of 1] Compiling Main             ( Trace.hs, Trace.o )
    Linking Trace ...
    $ ./Trace +RTS -M10M
    Trace: Heap exhausted;
    Trace: Current maximum heap size is 10485760 bytes (10 MB).
    Trace: Use `+RTS -M<size>' to increase it.
    

    generates an exception before the trace call prints anything. In the process of evaluating trace, the value of g is fully evaluated, triggering an exception before trace generates output.

    Replace the trace call with trace "processing" False, and the program prints the trace and runs to completion (since it never tries to evaluate g).

Leave a reply to - How to use "trace" when dealing with an "out of memory" exception/stackoverflow in Haskell?

◀ Go back