GhcException(..), showGhcException, ghcError, progName,
pgmError,
- panic, panic#, assertPanic, trace,
+ panic, panicFastInt, assertPanic, trace,
Exception.Exception(..), showException, try, tryJust, tryMost, tryUser,
catchJust, ioErrors, throwTo,
import FastTypes
#ifndef mingw32_HOST_OS
-# if __GLASGOW_HASKELL__ > 504
import System.Posix.Signals
-# else
-import Posix ( Handler(Catch), installHandler, sigINT, sigQUIT )
-# endif /* GHC > 504 */
#endif /* mingw32_HOST_OS */
-#if defined(mingw32_HOST_OS) && __GLASGOW_HASKELL__ >= 603
+#if defined(mingw32_HOST_OS)
import GHC.ConsoleHandler
#endif
-import Control.Exception hiding (try)
-import Control.Concurrent ( myThreadId, MVar, ThreadId, withMVar, newMVar )
+import Control.Exception
+import Control.Concurrent ( MVar, ThreadId, withMVar, newMVar )
import Data.Dynamic
import qualified Control.Exception as Exception
import Debug.Trace ( trace )
| ProgramError String -- error in the user's code, probably
deriving Eq
+progName :: String
progName = unsafePerformIO (getProgName)
{-# NOINLINE progName #-}
+short_usage :: String
short_usage = "Usage: For basic information, try the `--help' option."
showException :: Exception.Exception -> String
instance Show GhcException where
showsPrec _ e@(ProgramError _) = showGhcException e
+ showsPrec _ e@(CmdLineError _) = showString "<command line>: " . showGhcException e
showsPrec _ e = showString progName . showString ": " . showGhcException e
+showGhcException :: GhcException -> String -> String
showGhcException (UsageError str)
= showString str . showChar '\n' . showString short_usage
showGhcException (PhaseFailed phase code)
++ s ++ "\n\n"
++ "Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug\n")
-#if __GLASGOW_HASKELL__ < 603
-myMkTyConApp = mkAppTy
-#else
-myMkTyConApp = mkTyConApp
-#endif
-
+ghcExceptionTc :: TyCon
ghcExceptionTc = mkTyCon "GhcException"
{-# NOINLINE ghcExceptionTc #-}
instance Typeable GhcException where
- typeOf _ = myMkTyConApp ghcExceptionTc []
+ typeOf _ = mkTyConApp ghcExceptionTc []
\end{code}
Panics and asserts.
-- what TAG_ is with GHC at the moment. Ugh. (Simon)
-- No, man -- Too Beautiful! (Will)
-panic# :: String -> FastInt
-panic# s = case (panic s) of () -> _ILIT 0
+panicFastInt :: String -> FastInt
+panicFastInt s = case (panic s) of () -> _ILIT(0)
assertPanic :: String -> Int -> a
assertPanic file line =
tryUser :: IO a -> IO (Either Exception.Exception a)
tryUser action = tryJust tc_errors action
where
-#if __GLASGOW_HASKELL__ > 504 || __GLASGOW_HASKELL__ < 500
tc_errors e@(Exception.IOException ioe) | isUserError ioe = Just e
-#elif __GLASGOW_HASKELL__ == 502
- tc_errors e@(UserError _) = Just e
-#else
- tc_errors e@(Exception.IOException ioe) | isUserError e = Just e
-#endif
tc_errors _other = Nothing
\end{code}
-Compatibility stuff:
-
-\begin{code}
-#if __GLASGOW_HASKELL__ <= 408
-try = Exception.tryAllIO
-#else
-try = Exception.try
-#endif
-
-#if __GLASGOW_HASKELL__ <= 408
-catchJust = Exception.catchIO
-tryJust = Exception.tryIO
-ioErrors = Exception.justIoErrors
-throwTo = Exception.raiseInThread
-#endif
-\end{code}
-
Standard signal handlers for catching ^C, which just throw an
exception in the target thread. The current target thread is
the thread at the head of the list in the MVar passed to
installHandler sigQUIT (Catch interrupt) Nothing
installHandler sigINT (Catch interrupt) Nothing
return ()
-#elif __GLASGOW_HASKELL__ >= 603
+#else
-- GHC 6.3+ has support for console events on Windows
-- NOTE: running GHCi under a bash shell for some reason requires
-- you to press Ctrl-Break rather than Ctrl-C to provoke
installHandler (Catch sig_handler)
return ()
-#else
- return () -- nothing
#endif
{-# NOINLINE interruptTargetThread #-}