%
+% (c) The University of Glasgow 2006
% (c) The GRASP Project, Glasgow University, 1992-2000
%
-\section{Panic error messages}
Defines basic funtions for printing error messages.
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
-# if __GLASGOW_HASKELL__ < 500
-import EXCEPTION ( raiseInThread )
-# else
-import EXCEPTION ( throwTo )
-# endif /* GHC < 500 */
-
-#if __GLASGOW_HASKELL__ > 408
-import EXCEPTION ( catchJust, tryJust, ioErrors )
-#endif
-
-import CONCURRENT ( myThreadId, MVar, ThreadId, withMVar, newEmptyMVar )
-import DYNAMIC
-import qualified EXCEPTION as Exception
-import TRACE ( trace )
-import UNSAFE_IO ( unsafePerformIO )
-import IO ( isUserError )
-
-import System
+import Control.Exception
+import Control.Concurrent ( MVar, ThreadId, withMVar, newMVar )
+import Data.Dynamic
+import qualified Control.Exception as Exception
+import Debug.Trace ( trace )
+import System.IO.Unsafe ( unsafePerformIO )
+import System.IO.Error ( isUserError )
+import System.Exit
+import System.Environment
\end{code}
GHC's own exception type.
| 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 #-}
interruptTargetThread :: MVar [ThreadId]
-interruptTargetThread = unsafePerformIO newEmptyMVar
+interruptTargetThread = unsafePerformIO (newMVar [])
\end{code}