Commit 7752abc1 authored by simonmar's avatar simonmar

[project @ 2000-12-12 14:35:08 by simonmar]

Clean up the error handling a bit; the exception type is moved to
Panic, and a new exception for panics has been added.
parent bff0ca39
......@@ -36,12 +36,12 @@ import Unique ( Uniquable )
import Digraph ( SCC(..), stronglyConnComp, flattenSCC )
import DriverFlags ( getDynFlags )
import DriverPhases
import DriverUtil ( BarfKind(..), splitFilename3 )
import DriverUtil ( splitFilename3 )
import ErrUtils ( showPass )
import Util
import DriverUtil
import Outputable
import Panic ( panic )
import Panic
import CmdLineOpts ( DynFlags(..) )
#ifdef GHCI
......@@ -200,7 +200,7 @@ cmLoadModule cmstate1 rootname
showPass dflags "Chasing dependencies"
when (verb >= 1 && ghci_mode == Batch) $
hPutStrLn stderr (prog_name ++ ": chasing modules from: " ++ rootname)
hPutStrLn stderr (progName ++ ": chasing modules from: " ++ rootname)
(mg2unsorted, a_root_is_Main) <- downsweep [rootname]
let mg2unsorted_names = map name_of_summary mg2unsorted
......@@ -567,7 +567,7 @@ upsweep_mod ghci_mode dflags oldUI threaded1 summary1 reachable_from_here
when (verb == 1) $
if (ghci_mode == Batch)
then hPutStr stderr (prog_name ++ ": module "
then hPutStr stderr (progName ++ ": module "
++ moduleNameUserString mod_name
++ ": ")
else hPutStr stderr ("Compiling "
......
-----------------------------------------------------------------------------
-- $Id: DriverFlags.hs,v 1.33 2000/12/11 15:26:00 sewardj Exp $
-- $Id: DriverFlags.hs,v 1.34 2000/12/12 14:35:08 simonmar Exp $
--
-- Driver flags
--
......@@ -16,13 +16,15 @@ import DriverState
import DriverUtil
import TmpFiles ( v_TmpDir )
import CmdLineOpts
import TmpFiles ( newTempName )
import Config
import Util
import TmpFiles ( newTempName )
import Directory ( removeFile )
import Panic
import Exception
import IOExts
import Directory ( removeFile )
import IO
import Maybe
import Monad
......
-----------------------------------------------------------------------------
-- $Id: DriverMkDepend.hs,v 1.6 2000/11/21 14:34:47 simonmar Exp $
-- $Id: DriverMkDepend.hs,v 1.7 2000/12/12 14:35:08 simonmar Exp $
--
-- GHC Driver
--
......@@ -18,6 +18,7 @@ import TmpFiles
import Module
import Config
import Util
import Panic
import IOExts
import Exception
......
-----------------------------------------------------------------------------
-- $Id: DriverPipeline.hs,v 1.40 2000/12/07 16:39:40 simonmar Exp $
-- $Id: DriverPipeline.hs,v 1.41 2000/12/12 14:35:08 simonmar Exp $
--
-- GHC Driver
--
......@@ -38,6 +38,7 @@ import Module
import ErrUtils
import CmdLineOpts
import Config
import Panic
import Util
import Time ( getClockTime )
......
-----------------------------------------------------------------------------
-- $Id: DriverState.hs,v 1.19 2000/12/08 12:32:15 simonpj Exp $
-- $Id: DriverState.hs,v 1.20 2000/12/12 14:35:08 simonmar Exp $
--
-- Settings for the driver
--
......@@ -22,6 +22,7 @@ import IOExts
import TmpFiles ( newTempName )
import Directory ( removeFile )
#endif
import Panic
import List
import Char
......
-----------------------------------------------------------------------------
-- $Id: DriverUtil.hs,v 1.14 2000/12/12 12:10:08 simonmar Exp $
-- $Id: DriverUtil.hs,v 1.15 2000/12/12 14:35:08 simonmar Exp $
--
-- Utils for the driver
--
......@@ -13,6 +13,7 @@ module DriverUtil where
#include "HsVersions.h"
import Util
import Panic
import IOExts
import Exception
......@@ -29,8 +30,6 @@ import Monad
-----------------------------------------------------------------------------
-- Errors
short_usage = "Usage: For basic information, try the `--help' option."
GLOBAL_VAR(v_Path_usage, "", String)
long_usage = do
......@@ -40,38 +39,9 @@ long_usage = do
exitWith ExitSuccess
where
dump "" = return ()
dump ('$':'$':s) = hPutStr stderr prog_name >> dump s
dump ('$':'$':s) = hPutStr stderr progName >> dump s
dump (c:s) = hPutChar stderr c >> dump s
data BarfKind
= PhaseFailed String ExitCode
| Interrupted
| UsageError String -- prints the short usage msg after the error
| OtherError String -- just prints the error message
deriving Eq
prog_name = unsafePerformIO (getProgName)
{-# NOINLINE prog_name #-}
instance Show BarfKind where
showsPrec _ e = showString prog_name . showString ": " . showBarf e
showBarf (UsageError str)
= showString str . showChar '\n' . showString short_usage
showBarf (OtherError str)
= showString str
showBarf (PhaseFailed phase code)
= showString phase . showString " failed, code = " . shows code
showBarf (Interrupted)
= showString "interrupted"
unknownFlagErr f = throwDyn (UsageError ("unrecognised flag: " ++ f))
barfKindTc = mkTyCon "BarfKind"
{-# NOINLINE barfKindTc #-}
instance Typeable BarfKind where
typeOf _ = mkAppTy barfKindTc []
-----------------------------------------------------------------------------
-- Reading OPTIONS pragmas
......@@ -98,6 +68,9 @@ optionRegex = mkRegex "\\{-#[ \t]+OPTIONS[ \t]+(.*)#-\\}" -- -}
-----------------------------------------------------------------------------
-- Utils
unknownFlagErr :: String -> a
unknownFlagErr f = throwDyn (UsageError ("unrecognised flag: " ++ f))
my_partition :: (a -> Maybe b) -> [a] -> ([(a,b)],[a])
my_partition _ [] = ([],[])
my_partition p (a:as)
......
{-# OPTIONS -fno-warn-incomplete-patterns #-}
-----------------------------------------------------------------------------
-- $Id: Main.hs,v 1.37 2000/12/12 12:10:08 simonmar Exp $
-- $Id: Main.hs,v 1.38 2000/12/12 14:35:08 simonmar Exp $
--
-- GHC Driver program
--
......@@ -91,17 +91,17 @@ import Maybe
-- Main loop
main =
-- top-level exception handler: any unrecognised exception is a compiler bug.
handle (\exception -> panic (show exception)) $ do
-- all error messages are propagated as exceptions
handleDyn (\dyn -> case dyn of
PhaseFailed _phase code -> exitWith code
Interrupted -> exitWith (ExitFailure 1)
_ -> do hPutStrLn stderr (show (dyn :: BarfKind))
_ -> do hPutStrLn stderr (show (dyn :: GhcException))
exitWith (ExitFailure 1)
) $ do
-- top-level exception handler: any unrecognised exception is a compiler bug.
handle (\exception -> panic (show exception)) $ do
-- make sure we clean up after ourselves
later (do forget_it <- readIORef v_Keep_tmp_files
unless forget_it $ do
......
-----------------------------------------------------------------------------
-- $Id: PackageMaintenance.hs,v 1.4 2000/12/11 12:30:58 rrt Exp $
-- $Id: PackageMaintenance.hs,v 1.5 2000/12/12 14:35:08 simonmar Exp $
--
-- GHC Driver program
--
......@@ -7,11 +7,14 @@
--
-----------------------------------------------------------------------------
module PackageMaintenance where
module PackageMaintenance
( listPackages, newPackage, deletePackage
) where
import CmStaticInfo
import DriverState
import DriverUtil
import Panic
import Exception
import IOExts
......
%
% (c) The GRASP Project, Glasgow University, 1992-1998
% (c) The GRASP Project, Glasgow University, 1992-2000
%
\section{Panic error messages}
......@@ -9,20 +9,69 @@ It's hard to put these functions anywhere else without causing
some unnecessary loops in the module dependency graph.
\begin{code}
module Panic ( panic, panic#, assertPanic, trace ) where
module Panic
(
GhcException(..), ghcError, progName,
panic, panic#, assertPanic, trace
) where
import IOExts ( trace )
import FastTypes
import Dynamic
import IOExts
import Exception
import System
#include "HsVersions.h"
\end{code}
GHC's own exception type.
\begin{code}
ghcError :: GhcException -> a
ghcError e = throwDyn e
data GhcException
= PhaseFailed String ExitCode
| Interrupted
| UsageError String -- prints the short usage msg after the error
| Panic String -- the `impossible' happened
| OtherError String -- just prints the error message
deriving Eq
progName = unsafePerformIO (getProgName)
{-# NOINLINE progName #-}
short_usage = "Usage: For basic information, try the `--help' option."
instance Show GhcException where
showsPrec _ e = showString progName . showString ": " . showBarf e
showBarf (UsageError str)
= showString str . showChar '\n' . showString short_usage
showBarf (OtherError str)
= showString str
showBarf (PhaseFailed phase code)
= showString phase . showString " failed, code = " . shows code
showBarf (Interrupted)
= showString "interrupted"
showBarf (Panic s)
= showString ("panic! (the `impossible' happened):\n\t"
++ s ++ "\n\n"
++ "Please report it as a compiler bug "
++ "to glasgow-haskell-bugs@haskell.org.\n\n")
ghcExceptionTc = mkTyCon "GhcException"
{-# NOINLINE ghcExceptionTc #-}
instance Typeable GhcException where
typeOf _ = mkAppTy ghcExceptionTc []
\end{code}
Panics and asserts.
\begin{code}
panic :: String -> a
panic x = error ("panic! (the `impossible' happened):\n\t"
++ x ++ "\n\n"
++ "Please report it as a compiler bug "
++ "to glasgow-haskell-bugs@haskell.org.\n\n" )
panic x = throwDyn (Panic x)
-- #-versions because panic can't return an unboxed int, and that's
-- what TAG_ is with GHC at the moment. Ugh. (Simon)
......@@ -32,5 +81,7 @@ panic# :: String -> FastInt
panic# s = case (panic s) of () -> _ILIT 0
assertPanic :: String -> Int -> a
assertPanic file line = panic ("ASSERT failed! file " ++ file ++ ", line " ++ show line)
assertPanic file line =
throw (AssertionFailed
("ASSERT failed! file " ++ file ++ ", line " ++ show line))
\end{code}
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment