X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Futils%2FPanic.lhs;h=b8ab86af6813bcf597b308f81471cb53e07e8d94;hb=e761a777f2440ca1b8d8b40848cc5aa30d889ff6;hp=42bf8b5220a06ecc817bbdef57e792b979514376;hpb=046ee54f048ddd721dcee41916d6a6f68db3b15b;p=ghc-hetmet.git diff --git a/compiler/utils/Panic.lhs b/compiler/utils/Panic.lhs index 42bf8b5..b8ab86a 100644 --- a/compiler/utils/Panic.lhs +++ b/compiler/utils/Panic.lhs @@ -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,19 +28,15 @@ 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 -import Control.Exception hiding (try) -import Control.Concurrent ( myThreadId, MVar, ThreadId, withMVar, newEmptyMVar ) +import Control.Exception +import Control.Concurrent ( MVar, ThreadId, withMVar, newMVar ) import Data.Dynamic import qualified Control.Exception as Exception import Debug.Trace ( trace ) @@ -76,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 @@ -89,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) @@ -116,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. @@ -139,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 = @@ -171,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 @@ -219,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 @@ -231,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}