X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Futils%2FPanic.lhs;h=b8ab86af6813bcf597b308f81471cb53e07e8d94;hb=e761a777f2440ca1b8d8b40848cc5aa30d889ff6;hp=1a74d5db3257326630e9dea57f1ee900a9f349e8;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1;p=ghc-hetmet.git diff --git a/compiler/utils/Panic.lhs b/compiler/utils/Panic.lhs index 1a74d5d..b8ab86a 100644 --- a/compiler/utils/Panic.lhs +++ b/compiler/utils/Panic.lhs @@ -1,7 +1,7 @@ % +% (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. @@ -14,7 +14,7 @@ module Panic GhcException(..), showGhcException, ghcError, progName, pgmError, - panic, panic#, assertPanic, trace, + panic, panicFastInt, assertPanic, trace, Exception.Exception(..), showException, try, tryJust, tryMost, tryUser, catchJust, ioErrors, throwTo, @@ -28,35 +28,22 @@ import Config 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. @@ -85,9 +72,11 @@ data GhcException | 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 @@ -98,8 +87,10 @@ showException other_exn = show other_exn instance Show GhcException where showsPrec _ e@(ProgramError _) = showGhcException e + showsPrec _ e@(CmdLineError _) = showString ": " . 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) @@ -125,16 +116,11 @@ showGhcException (Panic s) ++ 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. @@ -148,8 +134,8 @@ pgmError x = Exception.throwDyn (ProgramError x) -- 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 = @@ -180,33 +166,10 @@ tryMost action = do r <- try action; filter r 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 @@ -228,7 +191,7 @@ installSignalHandlers = do 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 @@ -240,11 +203,9 @@ installSignalHandlers = do installHandler (Catch sig_handler) return () -#else - return () -- nothing #endif {-# NOINLINE interruptTargetThread #-} interruptTargetThread :: MVar [ThreadId] -interruptTargetThread = unsafePerformIO newEmptyMVar +interruptTargetThread = unsafePerformIO (newMVar []) \end{code}