在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函数处理,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中所述.