Commit f4eba96b authored by simonmar's avatar simonmar
Browse files

[project @ 2001-03-28 11:01:19 by simonmar]

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.
parent f65a77e8
......@@ -260,8 +260,7 @@ linkInterpretedCode (l@(LM _ m uls) : ls) ul_trees pls
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"
......
......@@ -149,7 +149,7 @@ cmSetContext cmstate str
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
......@@ -163,7 +163,7 @@ moduleNameToModule :: ModuleName -> IO Module
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
......@@ -955,7 +955,7 @@ downsweep rootNm old_summaries
| 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
......@@ -978,7 +978,7 @@ downsweep rootNm old_summaries
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) ++ "'"))
......@@ -1055,10 +1055,10 @@ summarise mod location old_summary
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))
......@@ -1067,11 +1067,10 @@ summarise mod location old_summary
| 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
--
......@@ -301,7 +301,7 @@ specialCommand str = do
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
......@@ -310,13 +310,13 @@ help :: String -> GHCi ()
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)
......@@ -333,10 +333,10 @@ defineMacro s = do
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
......@@ -363,11 +363,11 @@ undefineMacro :: String -> GHCi ()
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))
......@@ -472,7 +472,7 @@ setOptions str
writeIORef v_InitDynFlags dyn_flags
if (not (null leftovers))
then throwDyn (OtherError ("unrecognised flags: " ++
then throwDyn (UserError ("unrecognised flags: " ++
unwords leftovers))
else return ()
)
......@@ -492,7 +492,7 @@ unsetOptions str
-- 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
......@@ -620,7 +620,7 @@ linkPackages cmdline_lib_specs pkgs
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 ()
......@@ -653,7 +653,7 @@ loadClassified (Right dll_unadorned)
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
--
......@@ -352,7 +352,7 @@ setVerbosityAtLeast n =
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
......@@ -483,7 +483,7 @@ decodeSize str
| 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
--
......@@ -164,8 +164,8 @@ endMkDependHS = do
(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
......@@ -181,9 +181,8 @@ findDependency is_source mod imp = do
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
--
......@@ -94,7 +94,7 @@ getGhcMode flags
([] , 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")
-----------------------------------------------------------------------------
......@@ -199,13 +199,13 @@ genPipeline todo stop_flag persistent_output lang filename
-- 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
......@@ -256,7 +256,7 @@ genPipeline todo stop_flag persistent_output lang filename
-- 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
......@@ -366,8 +366,8 @@ run_phase MkDependHS basename suff input_fn _output_fn = 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
......@@ -762,7 +762,7 @@ mk_pvm_wrapper_script pvm_executable pvm_executable_base sysMan = unlines $
-- 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))
......@@ -838,7 +838,7 @@ doLink o_files = do
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
--
......@@ -336,7 +336,7 @@ addPackage :: String -> IO ()
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
......@@ -470,7 +470,7 @@ findBuildTag = 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
--
......@@ -139,7 +139,9 @@ main =
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
......@@ -157,7 +159,7 @@ main =
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
......@@ -183,7 +185,7 @@ main =
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.
......@@ -275,9 +277,12 @@ main =
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
......@@ -307,7 +312,7 @@ setTopDir :: [String] -> IO [String]
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
......@@ -326,7 +331,7 @@ beginMake fileish_args
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
......
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