在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

我的Python解释器挂起了，我无法再使用它了。但是，如果我再次按下Ctrl-C，REPL将解除阻塞。我已经搜索了很多，但找不到原因。有人能解释一下吗？

非常感谢！

- Rafael Barreto

---

我从未见到过 Ctrl-Z 被捕获。第一个 Ctrl-C 被捕获了，但第二个没有。这可能是相同的问题。您能否更改您的代码并创建一个完整的工作测试案例？例如，使用“return”代替“interpreter“stdin””，并添加适当的导入。 - Sjoerd Visscher

Answer 1

使用 catch 无法处理 Control-C：可能与 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上，就像Sjoerd提到的那样，Control-Z不能被捕获。也许你在Windows上，因为在Windows上Control-Z用于EOF。我们可以使用Control-D在Linux上发出EOF信号，这将复制你看到的行为：

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

EOF 由你的 handle/onAbort 函数处理，Control-C 由 catch/onUserInterrupt 函数处理。这里的问题在于你的 repl 函数只能捕获第一个 Control-C -- 如果移除 handle/onAbort 函数则可以简化测试用例。如上所述，catch 函数无法正确处理 Control-C 的问题可能与 GHC #2301: Proper handling of 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所述。

- Conrad Parker