X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Futils%2FPanic.lhs;h=f79ffce7830473d8915db3bc1ff4c6ebaabda47c;hb=9f592bb0ae0dc76bd3ec7729474057d2069bb4db;hp=53d75b05a9541294e927dee87cfd15d900eab018;hpb=317fc69d18eda68fd65f5ba634feafbe4a3923da;p=ghc-hetmet.git diff --git a/compiler/utils/Panic.lhs b/compiler/utils/Panic.lhs index 53d75b0..f79ffce 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,11 +28,7 @@ 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 @@ -40,7 +36,7 @@ import GHC.ConsoleHandler #endif import Control.Exception -import Control.Concurrent ( myThreadId, MVar, ThreadId, withMVar, newMVar ) +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,12 +116,14 @@ 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 :: TyCon -> [TypeRep] -> TypeRep +#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 603 myMkTyConApp = mkAppTy #else myMkTyConApp = mkTyConApp #endif +ghcExceptionTc :: TyCon ghcExceptionTc = mkTyCon "GhcException" {-# NOINLINE ghcExceptionTc #-} instance Typeable GhcException where @@ -139,8 +141,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,11 +173,7 @@ 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 tc_errors e@(Exception.IOException ioe) | isUserError ioe = Just e -#else - tc_errors e@(Exception.IOException ioe) | isUserError e = Just e -#endif tc_errors _other = Nothing \end{code}