Exception 在Haskell中处理UserInterrupt异常

我正在Haskell中为Scheme解释器实现一个REPL，我想处理一些异步事件，如UserInterrupt、StackOverflow、HeapOverflow等。。。基本上，我希望在发生UserInterrupt时停止当前的计算，并在发生StackOverflow和HeapoOverflow时打印适当的消息，等等。我实现了如下：

    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-C，REPL将取消阻止。我找了很多，但我找不出原因。谁能给我解释一下吗

非常感谢

Control-C处理不适用于

捕获

：可能与

下面是一个工作测试用例，删除了

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

可处理多次按下的控制Cs：

>>> ^C
keyboardSignal

>>> ^C
keyboardSignal

>>> ^C
keyboardSignal

---

如果不使用POSIXAPI，在Windows上安装持久信号处理程序需要在每次捕获异常时重新引发异常，如

中所述，我从未看到捕获到Ctrl-Z。第一个Ctrl-C被捕获，但第二个没有。这可能是同一个问题。您能在一个完整的工作测试用例中更改代码吗？F.e.“return”而不是“解释器”stdin“，并添加适当的导入。

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

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

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

>>> ^C
keyboardSignal

>>> ^C
keyboardSignal

>>> ^C
keyboardSignal