在Haskell中處理“內存不足”異常/堆棧溢出時如何使用“跟蹤”？

Question

上下文：我正在為一種語言解釋器，該語言基本上是Haskell的一小部分。

Haskell的惰性評估是一種便便，並且由於（我懷疑）無限遞歸而導致“內存不足”異常，因此拒絕評估此trace命令。

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

我得到以下結果：

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 %

是否有一些簡單的方法可以強制trace進行評估，而不管例外情況如何？ 也許是一種快速強制進行嚴格評估的方法？ 我真的很想獲得一些有關它實際試圖評估的調試信息。

編輯：進一步的谷歌搜索顯示（$！）運算符，應該強制嚴格。 但是，我已將其添加到我的代碼中，並且沒有任何變化：

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

還有其他提示嗎？ 我真的想強制使用該痕跡來評估其副作用。

edit2：更多的谷歌搜索顯示了seq運算符，但是它的行為不如廣告中所示。

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

即使這樣也拒絕打印跟蹤。

我還想出了如何使BangPatterns擴展正常工作，但是也沒有打印出跟蹤信息：

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

（完整文件供參考。它是一個多文件程序）：

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

Answer 1

我認為@leftroundabout的意思是，如果對g或e的求值觸發了問題，那么在跟蹤任何輸出之前，跟蹤操作將生成異常。

trace其參數編組到C字符串以進行輸出。 因此，必須在trace打印單個輸出字符之前對show g和show e進行全面評估。

例如，以下程序：

import Debug.Trace

badsum = sum [1..1000000]

process g | trace ("processing " ++ show g) False = undefined
process _ = "whatever"

main = print (process badsum)

在不進行優化的情況下進行編譯並以較小的堆大小運行時：

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

在trace調用打印任何內容之前生成一個異常。 在評估trace的過程中， g的值被完全評估，在trace生成輸出之前觸發異常。

將trace調用替換為trace trace "processing" False ，程序將打印跟蹤並運行至完成（因為它從不嘗試評估g ）。