Now that we require GHC >= 6.4.2, System.IO.Error is always available

[ghc-hetmet.git] / compiler / utils / Panic.lhs

diff --git a/compiler/utils/Panic.lhs b/compiler/utils/Panic.lhs
index eb3ce78..f79ffce 100644 (file)
--- a/compiler/utils/Panic.lhs
+++ b/compiler/utils/Panic.lhs
@@ -14,7 +14,7 @@ module Panic
      GhcException(..), showGhcException, ghcError, progName, 
      pgmError,
 
      GhcException(..), showGhcException, ghcError, progName, 
      pgmError,
 

-     panic, panic#, assertPanic, trace,
+     panic, panicFastInt, assertPanic, trace,

      
      Exception.Exception(..), showException, try, tryJust, tryMost, tryUser,
      catchJust, ioErrors, throwTo,
      
      Exception.Exception(..), showException, try, tryJust, tryMost, tryUser,
      catchJust, ioErrors, throwTo,

@@ -28,19 +28,15 @@ import Config
 import FastTypes
 
 #ifndef mingw32_HOST_OS
 import FastTypes
 
 #ifndef mingw32_HOST_OS

-# if __GLASGOW_HASKELL__ > 504

 import System.Posix.Signals
 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
 import GHC.ConsoleHandler
 #endif
 
 #endif /* mingw32_HOST_OS */
 
 #if defined(mingw32_HOST_OS) && __GLASGOW_HASKELL__ >= 603
 import GHC.ConsoleHandler
 #endif
 

-import Control.Exception hiding (try)
-import Control.Concurrent ( myThreadId, MVar, ThreadId, withMVar, newMVar )
+import Control.Exception
+import Control.Concurrent ( MVar, ThreadId, withMVar, newMVar )

 import Data.Dynamic
 import qualified Control.Exception as Exception
 import Debug.Trace     ( trace )
 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
 
   | ProgramError String                -- error in the user's code, probably
   deriving Eq
 

+progName :: String

 progName = unsafePerformIO (getProgName)
 {-# NOINLINE progName #-}
 
 progName = unsafePerformIO (getProgName)
 {-# NOINLINE progName #-}
 

+short_usage :: String

 short_usage = "Usage: For basic information, try the `--help' option."
    
 showException :: Exception.Exception -> 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
 
 instance Show GhcException where
   showsPrec _ e@(ProgramError _) = showGhcException e

+  showsPrec _ e@(CmdLineError _) = showString "<command line>: " . showGhcException e

   showsPrec _ e = showString progName . 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)
 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")
 
                 ++ 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
 
 myMkTyConApp = mkAppTy
 #else 
 myMkTyConApp = mkTyConApp
 #endif
 

+ghcExceptionTc :: TyCon

 ghcExceptionTc = mkTyCon "GhcException"
 {-# NOINLINE ghcExceptionTc #-}
 instance Typeable GhcException where
 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)
 
 -- 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 = 
 
 assertPanic :: String -> Int -> a
 assertPanic file line = 

@@ -171,33 +173,10 @@ tryMost action = do r <- try action; filter r
 tryUser :: IO a -> IO (Either Exception.Exception a)
 tryUser action = tryJust tc_errors action
   where 
 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
        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}     
 
        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
 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