X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Futils%2FPanic.lhs;h=ffd3b6751d6068e4f3cd6ec1c174b1892dfa71f6;hb=db0591be8928dbe75e8b804f2ae95728a6074b7e;hp=7644b61be8da68bd3f736ae3d2607b7f883e37a3;hpb=17b297d97d327620ed6bfab942f8992b2446f1bf;p=ghc-hetmet.git diff --git a/compiler/utils/Panic.lhs b/compiler/utils/Panic.lhs index 7644b61..ffd3b67 100644 --- a/compiler/utils/Panic.lhs +++ b/compiler/utils/Panic.lhs @@ -9,19 +9,12 @@ It's hard to put these functions anywhere else without causing some unnecessary loops in the module dependency graph. \begin{code} -{-# OPTIONS_GHC -w #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and fix --- any warnings in the module. See --- http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings --- for details - 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, @@ -29,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 @@ -79,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 @@ -92,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) @@ -119,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 @@ -142,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 =