X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Futils%2FPanic.lhs;h=ffd3b6751d6068e4f3cd6ec1c174b1892dfa71f6;hb=f555abffd676544cd13d022bf1eb829e63f7aebe;hp=ffc3c37247af71c079199a7c549d548b830d10f7;hpb=9f589efb688f22cb0637f9c1164dd9027b4378a3;p=ghc-hetmet.git diff --git a/compiler/utils/Panic.lhs b/compiler/utils/Panic.lhs index ffc3c37..ffd3b67 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, @@ -22,6 +22,8 @@ module Panic installSignalHandlers, interruptTargetThread ) where +-- XXX This define is a bit of a hack, and should be done more nicely +#define FAST_STRING_NOT_NEEDED 1 #include "HsVersions.h" import Config @@ -72,9 +74,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 @@ -85,8 +89,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) @@ -112,12 +118,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 @@ -135,8 +143,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 =