在GHC中捕获Control-C异常(Haskell)

Question

我在Haskell中构建了一个非常简单的read-eval-print-loop,它捕获了Control-C(UserInterrupt).但是,每当我编译并运行这个程序时,它总是捕获第一个Control-C并且总是在第二个Control-C上以退出代码130中止.无论我在之前和之间给出了多少行输入Control-Cs,它总是以这种方式发生.我知道我一定会错过一些简单的事情......请帮忙,谢谢!

注意:这是基于4的异常,因此Control.Exception而不是Control.OldException.

import Control.Exception as E
import System.IO

main :: IO ()
main = do hSetBuffering stdout NoBuffering
          hSetBuffering stdin NoBuffering
          repLoop

repLoop :: IO ()
repLoop
  = do putStr "> "
       line <- interruptible "<interrupted>" getLine
       if line == "exit"
          then putStrLn "goodbye"
          else do putStrLn $ "input was: " ++ line
                  repLoop

interruptible :: a -> IO a -> IO a
interruptible a m
  = E.handleJust f return m
  where
    f UserInterrupt
      = Just a
    f _
      = Nothing

Answer 1

魏虎是正确的; 当按下第二个control-C时,Haskell运行时系统故意中止程序.为了获得人们可能期望的行为:

import Control.Exception as E
import Control.Concurrent
import System.Posix.Signals

main = do
  tid <- myThreadId
  installHandler keyboardSignal (Catch (throwTo tid UserInterrupt)) Nothing
  ... -- rest of program

Answer 2

免责声明:我不熟悉GHC内部,我的答案是基于对源代码的篡改,阅读评论和猜测.

main您定义的函数实际上是由runMainIO定义的包装GHC.TopHandler(通过查看TcRnDriver.lhs进一步确认):

-- | 'runMainIO' is wrapped around 'Main.main' (or whatever main is
-- called in the program).  It catches otherwise uncaught exceptions,
-- and also flushes stdout\/stderr before exiting.
runMainIO :: IO a -> IO a
runMainIO main = 
    do 
      main_thread_id <- myThreadId
      weak_tid <- mkWeakThreadId main_thread_id
      install_interrupt_handler $ do
           m <- deRefWeak weak_tid 
           case m of
               Nothing  -> return ()
               Just tid -> throwTo tid (toException UserInterrupt)
      a <- main
      cleanUp
      return a
    `catch`
      topHandler

并install_interrupt_handler定义为:

install_interrupt_handler :: IO () -> IO ()
#ifdef mingw32_HOST_OS
install_interrupt_handler handler = do
  _ <- GHC.ConsoleHandler.installHandler $
     Catch $ \event -> 
        case event of
           ControlC -> handler
           Break    -> handler
           Close    -> handler
           _ -> return ()
  return ()
#else
#include "rts/Signals.h"
-- specialised version of System.Posix.Signals.installHandler, which
-- isn't available here.
install_interrupt_handler handler = do
   let sig = CONST_SIGINT :: CInt
   _ <- setHandler sig (Just (const handler, toDyn handler))
   _ <- stg_sig_install sig STG_SIG_RST nullPtr
     -- STG_SIG_RST: the second ^C kills us for real, just in case the
     -- RTS or program is unresponsive.
   return ()

在Linux上,stg_sig_install是一个调用的C函数sigaction.该参数STG_SIG_RST被翻译为SA_RESETHAND.在Windows上,事情有所不同,这可能解释了ja的观察.