0

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
TheIronKnuckle
  • 7,224
  • 4
  • 33
  • 56
  • 1
    I think you can add a run-time flag `-xc` I think - to get stack traces when programs crash - see https://neilmitchell.blogspot.co.at/2015/09/detecting-space-leaks.html for a great article about space leaks and how to find/fix them. – epsilonhalbe Oct 04 '17 at 20:33
  • @epsilonhalbe that's cool, but I don't actually want a stack trace. I want to force evaluate the 'trace' expression so as to print the variable values to the screen in a formatted debug string – TheIronKnuckle Oct 04 '17 at 20:37
  • Also I don't really need to hunt down the memory leak because I already know exactly where it is. I really just want to print some values so I can see exactly what the program is working on – TheIronKnuckle Oct 04 '17 at 20:39
  • 2
    This would benefit from a [MCVE]. I'm pretty sure the problem is _not_ that “Haskell is refusing to evaluate the `trace`”, rather it probably _is_ evaluating the `trace` and that's triggering the problem (which lies in `g` or `e`, themselves, so you get the same error regardless of whether `trace` triggers it or the following function). – leftaroundabout Oct 04 '17 at 21:07
  • it is *not* evaluating the trace, because the side effect of "printing to stdout" is not happening. Instead the program just craps out with a stackoverflow exception. I want to see the intermediate values. – TheIronKnuckle Oct 04 '17 at 21:20
  • have you taken a look at the compiler output with `-ddump-simpl` maybe the optimizer (correctly IMHO) optimizes the guard with False away. – epsilonhalbe Oct 04 '17 at 22:04
  • there is also a good idea to use ghci debugging see [here](https://stackoverflow.com/questions/6724434/how-to-debug-haskell-code) breaking on exceptions and [here](https://downloads.haskell.org/~ghc/master/users-guide/ghci.html#ghci-debugger) for general info - it is definitely no big fun to use, but not to bad once you've used it a bit. – epsilonhalbe Oct 04 '17 at 22:09
  • ps.: there is a lot of calling to `error` or `undefined` or partial functions (esp. take a look at your instance declarations, they are problematic in my opinion), I'd advise you to use hlint and compiling with `-Wall`. Btw. you are using `errz` in a lot of expressions - which is essentially the same as your `trace` expression - If you have a recursive data-structure in `g` or `e` you would experience the same behaviour whether you have the trace expression or not - if you run into an error - for example in the `case lookup` part. – epsilonhalbe Oct 04 '17 at 22:21

1 Answers1

4

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).

K. A. Buhr
  • 45,621
  • 3
  • 45
  • 71
  • You can also reproduce this more simply, I suspect, by making `show g` demand an infinite amount of heap memory, so that you don't have to futz with runtime settings. For example, `let g = 1:g in trace ("exp: " ++ show g) $ head g` – amalloy Oct 05 '17 at 02:24