Clean up GHC's error reporting.
- the GhcException type has some more constructors: CmdLineError,
UserError, and InstallationError. OtherError has gone.
- most error messages should begin with "<location>:". When the
error is on the command-line or in GHC itself, <location> is
"ghc", for consistency with std Unix semantics.
- GHCi no longer prints a superfluous "ghc: " before certain error
messages.
linkInterpretedCode ls (uls++ul_trees)
pls{objects_loaded = l : objects_loaded pls}
| any isObject uls
- = throwDyn (OtherError
- "can't link object code that depends on interpreted code")
+ = panic "linkInterpretedCode: trying to link object code to interpreted code")
| otherwise = invalidLinkable
invalidLinkable = panic "CmLink: linkable doesn't contain entirely objects or interpreted code"
Nothing -> do
mod <- moduleNameToModule mn
if isHomeModule mod
- then throwDyn (OtherError (showSDoc
+ then throwDyn (UserError (showSDoc
(quotes (ppr (moduleName mod))
<+> text "is not currently loaded")))
else return mod
moduleNameToModule mn
= do maybe_stuff <- findModule mn
case maybe_stuff of
- Nothing -> throwDyn (OtherError ("can't find module `"
+ Nothing -> throwDyn (UserError ("can't find module `"
++ moduleNameUserString mn ++ "'"))
Just (m,_) -> return m
| haskellish_file file
= do exists <- doesFileExist file
if exists then summariseFile file else do
- throwDyn (OtherError ("can't find file `" ++ file ++ "'"))
+ throwDyn (UserError ("can't find file `" ++ file ++ "'"))
| otherwise
= do exists <- doesFileExist hs_file
if exists then summariseFile hs_file else do
let old_summary = findModInSummaries old_summaries mod
summarise mod location old_summary
- Nothing -> throwDyn (OtherError
+ Nothing -> throwDyn (UserError
("can't find module `"
++ showSDoc (ppr nm) ++ "'"))
let (srcimps,imps,mod_name) = getImports modsrc
when (mod_name /= moduleName mod) $
- throwDyn (OtherError
- (showSDoc (text "file name does not match module name: "
- <+> ppr (moduleName mod) <+> text "vs"
- <+> ppr mod_name)))
+ throwDyn (UserError
+ (showSDoc (text modsrc
+ <> text ": file name does not match module name"
+ <+> quotes (ppr (moduleName mod)))))
return (Just (ModSummary mod location{ml_hspp_file=Just hspp_fn}
srcimps imps src_timestamp))
| otherwise = return Nothing
noHsFileErr mod
- = throwDyn (OtherError (showSDoc (text "no source file for module"
- <+> quotes (ppr mod))))
+ = panic (showSDoc (text "no source file for module" <+> quotes (ppr mod)))
packageModErr mod
- = throwDyn (OtherError (showSDoc (text "module" <+>
- quotes (ppr mod) <+>
- text "is a package module")))
+ = throwDyn (UserError (showSDoc (text "module" <+>
+ quotes (ppr mod) <+>
+ text "is a package module")))
\end{code}
-----------------------------------------------------------------------------
--- $Id: InteractiveUI.hs,v 1.58 2001/03/27 16:55:03 simonmar Exp $
+-- $Id: InteractiveUI.hs,v 1.59 2001/03/28 11:01:19 simonmar Exp $
--
-- GHC Interactive User Interface
--
foldr1 (\a b -> a ++ ',':b) (map fst cs)
++ ")") >> return False)
-noArgs c = throwDyn (OtherError ("command `" ++ c ++ "' takes no arguments"))
+noArgs c = throwDyn (UserError ("command `" ++ c ++ "' takes no arguments"))
-----------------------------------------------------------------------------
-- Commands
help _ = io (putStr helpText)
addModule :: String -> GHCi ()
-addModule _ = throwDyn (OtherError ":add not implemented")
+addModule _ = throwDyn (InstallationError ":add not implemented")
setContext :: String -> GHCi ()
setContext ""
- = throwDyn (OtherError "syntax: `:m <module>'")
+ = throwDyn (UserError "syntax: `:m <module>'")
setContext m | not (isUpper (head m)) || not (all isAlphaNum (tail m))
- = throwDyn (OtherError ("strange looking module name: `" ++ m ++ "'"))
+ = throwDyn (UserError ("strange looking module name: `" ++ m ++ "'"))
setContext str
= do st <- getGHCiState
new_cmstate <- io (cmSetContext (cmstate st) str)
let (macro_name, definition) = break isSpace s
cmds <- io (readIORef commands)
if (null macro_name)
- then throwDyn (OtherError "invalid macro name")
+ then throwDyn (UserError "invalid macro name")
else do
if (macro_name `elem` map fst cmds)
- then throwDyn (OtherError
+ then throwDyn (UserError
("command `" ++ macro_name ++ "' is already defined"))
else do
undefineMacro macro_name = do
cmds <- io (readIORef commands)
if (macro_name `elem` map fst builtin_commands)
- then throwDyn (OtherError
+ then throwDyn (UserError
("command `" ++ macro_name ++ "' cannot be undefined"))
else do
if (macro_name `notElem` map fst cmds)
- then throwDyn (OtherError
+ then throwDyn (UserError
("command `" ++ macro_name ++ "' not defined"))
else do
io (writeIORef commands (filter ((/= macro_name) . fst) cmds))
writeIORef v_InitDynFlags dyn_flags
if (not (null leftovers))
- then throwDyn (OtherError ("unrecognised flags: " ++
+ then throwDyn (UserError ("unrecognised flags: " ++
unwords leftovers))
else return ()
)
-- can't do GHC flags for now
if (not (null minus_opts))
- then throwDyn (OtherError "can't unset GHC command-line flags")
+ then throwDyn (UserError "can't unset GHC command-line flags")
else return ()
isMinus ('-':s) = True
putStr ("failed (" ++ str ++ ")\n")
croak
- croak = throwDyn (OtherError "user specified .o/.so/.DLL could not be loaded.")
+ croak = throwDyn (UserError "user specified .o/.so/.DLL could not be loaded.")
linkPackage :: PackageConfig -> IO ()
if maybe_errmsg == nullPtr
then return ()
else do str <- peekCString maybe_errmsg
- throwDyn (OtherError ("can't find .o or .so/.DLL for: "
+ throwDyn (UserError ("can't find .o or .so/.DLL for: "
++ dll_unadorned ++ " (" ++ str ++ ")" ))
locateOneObj :: [FilePath] -> String -> IO LibrarySpec
{-# OPTIONS -#include "hschooks.h" #-}
-----------------------------------------------------------------------------
--- $Id: DriverFlags.hs,v 1.50 2001/03/27 16:55:03 simonmar Exp $
+-- $Id: DriverFlags.hs,v 1.51 2001/03/28 11:01:19 simonmar Exp $
--
-- Driver flags
--
setVerbosity "" = updDynFlags (\dfs -> dfs{ verbosity = 3 })
setVerbosity n
| all isDigit n = updDynFlags (\dfs -> dfs{ verbosity = read n })
- | otherwise = throwDyn (OtherError "can't parse verbosity flag (-v<n>)")
+ | otherwise = throwDyn (UsageError "can't parse verbosity flag (-v<n>)")
getVerbFlag = do
verb <- dynFlag verbosity
| c == "K" || c == "k" = truncate (n * 1000)
| c == "M" || c == "m" = truncate (n * 1000 * 1000)
| c == "G" || c == "g" = truncate (n * 1000 * 1000 * 1000)
- | otherwise = throwDyn (OtherError ("can't decode size: " ++ str))
+ | otherwise = throwDyn (CmdLineError ("can't decode size: " ++ str))
where (m, c) = span pred str
n = read m :: Double
pred c = isDigit c || c == '.'
-----------------------------------------------------------------------------
--- $Id: DriverMkDepend.hs,v 1.7 2000/12/12 14:35:08 simonmar Exp $
+-- $Id: DriverMkDepend.hs,v 1.8 2001/03/28 11:01:19 simonmar Exp $
--
-- GHC Driver
--
(unwords [ "cp", tmp_file, makefile ])
-findDependency :: Bool -> String -> ModuleName -> IO (Maybe (String, Bool))
-findDependency is_source mod imp = do
+findDependency :: Bool -> FilePath -> ModuleName -> IO (Maybe (String, Bool))
+findDependency is_source src imp = do
dir_contents <- readIORef v_Dep_dir_contents
ignore_dirs <- readIORef v_Dep_ignore_dirs
hisuf <- readIORef v_Hi_suf
deps | is_source = [ imp_hiboot_v, imp_hiboot, imp_hs, imp_lhs ]
| otherwise = [ imp_hi, imp_hs, imp_lhs ]
- search [] = throwDyn (OtherError ("can't find one of the following: " ++
- unwords (map (\d -> '`': d ++ "'") deps) ++
- " (imported from `" ++ mod ++ "')"))
+ search [] = throwDyn (UserError (src ++ ": " ++ "can't find one of the following: " ++
+ unwords (map (\d -> '`': d ++ "'") deps)))
search ((dir, contents) : dirs)
| null present = search dirs
| otherwise =
-----------------------------------------------------------------------------
--- $Id: DriverPipeline.hs,v 1.60 2001/03/27 16:32:46 rrt Exp $
+-- $Id: DriverPipeline.hs,v 1.61 2001/03/28 11:01:19 simonmar Exp $
--
-- GHC Driver
--
([] , rest) -> return (rest, DoLink, "") -- default is to do linking
([(flag,one)], rest) -> return (rest, one, flag)
(_ , _ ) ->
- throwDyn (OtherError
+ throwDyn (UsageError
"only one of the flags -M, -E, -C, -S, -c, --make, --interactive, -mk-dll is allowed")
-----------------------------------------------------------------------------
-- ToDo: this is somewhat cryptic
- not_valid = throwDyn (OtherError ("invalid option combination"))
+ not_valid = throwDyn (UsageError ("invalid option combination"))
----------- ----- ---- --- -- -- - - -
-- this shouldn't happen.
if start_phase /= Ln && start_phase `notElem` pipeline
- then throwDyn (OtherError ("can't find starting phase for "
- ++ filename))
+ then throwDyn (CmdLineError ("can't find starting phase for "
+ ++ filename))
else do
let
-- is already in linkable form (for example).
if start_phase `elem` pipeline &&
(stop_phase /= Ln && stop_phase `notElem` pipeline)
- then throwDyn (OtherError
+ then throwDyn (UsageError
("flag " ++ stop_flag
++ " is incompatible with source file `" ++ filename ++ "'"))
else do
src <- readFile input_fn
let (import_sources, import_normals, module_name) = getImports src
- deps_sources <- mapM (findDependency True basename) import_sources
- deps_normals <- mapM (findDependency False basename) import_normals
+ deps_sources <- mapM (findDependency True src) import_sources
+ deps_normals <- mapM (findDependency False src) import_normals
let deps = deps_sources ++ deps_normals
osuf_opt <- readIORef v_Object_suf
-- Complain about non-dynamic flags in OPTIONS pragmas
checkProcessArgsResult flags basename suff
- = do when (not (null flags)) (throwDyn (OtherError (
+ = do when (not (null flags)) (throwDyn (UserError (
basename ++ "." ++ suff
++ ": static flags are not allowed in {-# OPTIONS #-} pragmas:\n\t"
++ unwords flags)) (ExitFailure 1))
when (WayPar `elem` ways_) (do
success <- run_phase_MoveBinary output_fn
if success then return ()
- else throwDyn (OtherError ("cannot move binary to PVM dir")))
+ else throwDyn (InstallationError ("cannot move binary to PVM dir")))
-----------------------------------------------------------------------------
-- Making a DLL
-----------------------------------------------------------------------------
--- $Id: DriverState.hs,v 1.36 2001/03/27 10:33:03 simonmar Exp $
+-- $Id: DriverState.hs,v 1.37 2001/03/28 11:01:19 simonmar Exp $
--
-- Settings for the driver
--
addPackage package
= do pkg_details <- readIORef v_Package_details
case lookupPkg package pkg_details of
- Nothing -> throwDyn (OtherError ("unknown package name: " ++ package))
+ Nothing -> throwDyn (CmdLineError ("unknown package name: " ++ package))
Just details -> do
ps <- readIORef v_Packages
unless (package `elem` ps) $ do
return (wayOpts details)
ws -> if not (allowed_combination ws)
- then throwDyn (OtherError $
+ then throwDyn (CmdLineError $
"combination not supported: " ++
foldr1 (\a b -> a ++ '/':b)
(map (wayName . lkupWay) ws))
{-# OPTIONS -fno-warn-incomplete-patterns #-}
-----------------------------------------------------------------------------
--- $Id: Main.hs,v 1.61 2001/03/27 10:33:24 simonmar Exp $
+-- $Id: Main.hs,v 1.62 2001/03/28 11:01:19 simonmar Exp $
--
-- GHC Driver program
--
else do am_inplace <- doesFileExist inplace_pkgconfig
if am_inplace
then writeIORef v_Path_package_config inplace_pkgconfig
- else throwDyn (OtherError ("Can't find package.conf in " ++ inplace_pkgconfig))
+ else throwDyn (InstallationError
+ ("Can't find package.conf in " ++
+ inplace_pkgconfig))
-- set the location of our various files
if am_installed
conf_file <- readIORef v_Path_package_config
r <- parsePkgConf conf_file
case r of {
- Left err -> throwDyn (OtherError (showSDoc err));
+ Left err -> throwDyn (InstallationError (showSDoc err));
Right pkg_details -> do
writeIORef v_Package_details pkg_details
writeIORef v_OptLevel 0
orig_ways <- readIORef v_Ways
when (not (null orig_ways) && mode == DoInteractive) $
- do throwDyn (OtherError
+ do throwDyn (UsageError
"--interactive can't be used with -prof, -ticky, -unreg or -smp.")
-- Find the build tag, and re-process the build-specific options.
let compileFile src = do
writeIORef v_DynFlags init_dyn_flags
+ exists <- doesFileExist src
+ when (not exists) $
+ throwDyn (CmdLineError ("file `" ++ src ++ "' does not exist"))
+
-- We compile in two stages, because the file may have an
-- OPTIONS pragma that affects the compilation pipeline (eg. -fvia-C)
-
let (basename, suffix) = splitFilename src
-- just preprocess
setTopDir args = do
let (minusbs, others) = partition (prefixMatch "-B") args
(case minusbs of
- [] -> throwDyn (OtherError ("missing -B<dir> option"))
+ [] -> throwDyn (InstallationError ("missing -B<dir> option"))
some -> writeIORef v_TopDir (drop 2 (last some)))
return others
beginInteractive :: [String] -> IO ()
#ifndef GHCI
-beginInteractive = throwDyn (OtherError "not built for interactive use")
+beginInteractive = throwDyn (CmdLineError "not built for interactive use")
#else
beginInteractive fileish_args
= do minus_ls <- readIORef v_Cmdline_libraries
projects / ghc-hetmet.git / commitdiff