在Haskell中處理UserInterrupt異常

Question

我正在為Haskell中的Scheme解釋器實現一個REPL，我想處理一些像UserInterrupt，StackOverflow，HeapOverflow等異步事件......基本上，我想在UserInterrupt發生時停止當前計算並打印一個StackOverflow和HeapOverflow發生時的合適消息等。我實現如下：

    repl evaluator = forever $ (do
        putStr ">>> " >> hFlush stdout
        out <- getLine >>= evaluator
        if null out
           then return ()
           else putStrLn out)
        `catch`
        onUserInterrupt

    onUserInterrupt UserInterrupt = putStrLn "\nUserInterruption"
    onUserInterrupt e = throw e

    main = do
        interpreter <- getMyLispInterpreter
        handle onAbort (repl $ interpreter "stdin")
        putStrLn "Exiting..."

    onAbort e = do
        let x = show (e :: SomeException)
        putStrLn $ "\nAborted: " ++ x

它按預期工作，但有一個例外。 如果我啟動解釋器並按Ctrl-Z + Enter，我會得到：

    >>> ^Z

    Aborted: <stdin>: hGetLine: end of file
    Exiting...

那是對的。 但是如果我啟動解釋器並按Ctrl-C然后按Ctrl-Z + Enter我得到：

    >>>
    UserInterruption
    >>> ^Z

它掛了，我不能再使用解釋器了。 但是，如果我再次按Ctrl-C，則REPL解除阻止。 我搜索了很多，我無法弄清楚它的原因。 有人能解釋一下嗎？

非常感謝！

Answer 1

Control-C處理不適用於catch ：可能與GHC＃2301有關：正確處理SIGINT / SIGQUIT

這是一個工作測試用例，刪除了evaluator ：

module Main where

import Prelude hiding (catch)

import Control.Exception ( SomeException(..),
                           AsyncException(..)
                         , catch, handle, throw)
import Control.Monad (forever)
import System.IO

repl :: IO ()
repl = forever $ (do
    putStr ">>> " >> hFlush stdout
    out <- getLine
    if null out
       then return ()
       else putStrLn out)
    `catch`
    onUserInterrupt

onUserInterrupt UserInterrupt = putStrLn "\nUserInterruption"
onUserInterrupt e = throw e

main = do
    handle onAbort repl
    putStrLn "Exiting..."

onAbort e = do
    let x = show (e :: SomeException)
    putStrLn $ "\nAborted: " ++ x

在Linux上，Control-Z沒有像Sjoerd所提到的那樣被捕獲。 也許你在Windows上，Control-Z用於EOF。 我們可以使用Control-D在Linux上發出EOF信號，它復制了您看到的行為：

>>> ^D
Aborted: <stdin>: hGetLine: end of file
Exiting...

EOF由handle/onAbort函數handle/onAbort ，Control-C由catch/onUserInterrupt處理。 這里的問題是你的repl函數只會捕獲第一個Control-C - 通過刪除handle/onAbort函數可以簡化測試用例。 如上所述，Control-C處理不適用於catch可能與GHC＃2301：正確處理SIGINT / SIGQUIT有關 。

以下版本使用Posix API為Control-C安裝持久性信號處理程序：

module Main where

import Prelude hiding (catch)

import Control.Exception ( SomeException(..),
                           AsyncException(..)
                         , catch, handle, throw)
import Control.Monad (forever)
import System.IO
import System.Posix.Signals

repl :: IO ()
repl = forever $ do
    putStr ">>> " >> hFlush stdout
    out <- getLine
    if null out
       then return ()
       else putStrLn out

reportSignal :: IO ()
reportSignal = putStrLn "\nkeyboardSignal"

main = do
    _ <- installHandler keyboardSignal (Catch reportSignal) Nothing
    handle onAbort repl
    putStrLn "Exiting..."

onAbort e = do
    let x = show (e :: SomeException)
    putStrLn $ "\nAborted: " ++ x

可以處理多次按下Control-C：

>>> ^C
keyboardSignal

>>> ^C
keyboardSignal

>>> ^C
keyboardSignal

如果不使用Posix API，則在Windows上安裝持久性信號處理程序需要在每次捕獲時重新引發異常，如http://suacommunity.com/dictionary/signals.php中所述。