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
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
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
--
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
--
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
--
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
--
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
--
#include "HsVersions.h"
import Util
+import Panic
import IOExts
import Exception
-----------------------------------------------------------------------------
-- Errors
-short_usage = "Usage: For basic information, try the `--help' option."
-
GLOBAL_VAR(v_Path_usage, "", String)
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
-----------------------------------------------------------------------------
-- 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
--
-- 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
--
--
-----------------------------------------------------------------------------
-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}
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)
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}
projects / ghc-hetmet.git / commitdiff