Ticket #452: Bug.2.hs

File Bug.2.hs, 668 bytes (added by fergus, 10 years ago)
Line 
1module Main(main) where
2
3import IO
4import Control.Exception(Exception(DynException))
5import Control.Concurrent(ThreadId,myThreadId,throwTo)
6import Data.Dynamic(toDyn)
7import System.Posix(Handler(Catch),installHandler,sigINT)
8
9main = do
10      archSpecificSetup
11      main'
12
13main' = putStrLn "run this program with '+RTS -xc', then hit control-C" >> main'
14
15archSpecificSetup :: IO ()
16archSpecificSetup = do
17      -- hSetBuffering stdout NoBuffering
18      tid <- myThreadId
19      installHandler sigINT (Catch (intHandler tid)) Nothing
20      return ()
21
22   where intHandler :: ThreadId -> IO ()
23         intHandler tid = throwTo tid (DynException (toDyn "{Interrupted!}"))