Catching Control-C exception dans GHC (Haskell)

Question

J'ai construit une boucle d'écriture-lecture-écriture très simple dans Haskell qui capture Control-C (UserInterrupt). Cependant, chaque fois que je compile et exécute ce programme, il attrape toujours le premier Control-C et abandonne toujours le second Control-C avec le code de sortie 130. Peu importe le nombre de lignes d'entrée que je lui donne avant et entre les deux Control-Cs, ça arrive toujours comme ça. Je sais que je dois manquer quelque chose de simple ... s'il vous plaît, aidez, merci!

Remarque: il s'agit d'exceptions de base 4, donc Control.Exception et non 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

Disclaimer: Je ne suis pas familier avec GHC et ma internals réponse est basée sur grepper le code source, la lecture des commentaires, et de faire des suppositions.

La fonction main vous définissez est en fait enveloppé par runMainIO défini dans GHC.TopHandler (ce qui est confirmé par la recherche à 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 

Et install_interrupt_handler est défini comme:

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() 

Sous Linux, stg_sig_install est une fonction C qui appelle sigaction. Le paramètre STG_SIG_RST est converti en SA_RESETHAND. Sur Windows, les choses sont faites différemment, ce qui explique probablement l'observation de ja.

Answer 2

La solution la plus fiable pour moi (au moins sur Linux), a été d'installer un gestionnaire de signal en utilisant System.Posix.Signals. J'espérais une solution qui n'exigerait pas cela, mais la vraie raison pour laquelle j'ai posté la question était que je voulais savoir pourquoi GHC se comportait comme il l'a fait. Comme expliqué sur #haskell, une explication probable est que GHC se comporte de telle sorte que l'utilisateur peut toujours contrôler une application C si elle se bloque. Pourtant, ce serait bien si GHC fournissait un moyen d'affecter ce comportement sans la méthode quelque peu inférieure que nous avons utilisée :).

Answer 3

Wei Hu est correct; le système d'exécution Haskell interrompt volontairement le programme lorsqu'un second contrôle-C est enfoncé. Pour obtenir le comportement que l'on pourrait attendre:

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