[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.

8 files changed, 59 insertions, 57 deletions

diff --git a/ghc/compiler/compMan/CmLink.lhs b/ghc/compiler/compMan/CmLink.lhs
index a059ea7b29..297b0a6ff8 100644
--- a/ghc/compiler/compMan/CmLink.lhs
+++ b/ghc/compiler/compMan/CmLink.lhs
@@ -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"
diff --git a/ghc/compiler/compMan/CompManager.lhs b/ghc/compiler/compMan/CompManager.lhs
index 28630ecf35..bf8d0cf137 100644
--- a/ghc/compiler/compMan/CompManager.lhs
+++ b/ghc/compiler/compMan/CompManager.lhs
@@ -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}
diff --git a/ghc/compiler/ghci/InteractiveUI.hs b/ghc/compiler/ghci/InteractiveUI.hs
index cd531b29c5..dc753183fc 100644
--- a/ghc/compiler/ghci/InteractiveUI.hs
+++ b/ghc/compiler/ghci/InteractiveUI.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $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
diff --git a/ghc/compiler/main/DriverFlags.hs b/ghc/compiler/main/DriverFlags.hs
index b128364c38..dd099003ea 100644
--- a/ghc/compiler/main/DriverFlags.hs
+++ b/ghc/compiler/main/DriverFlags.hs
@@ -1,7 +1,7 @@
 {-# 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 == '.'
diff --git a/ghc/compiler/main/DriverMkDepend.hs b/ghc/compiler/main/DriverMkDepend.hs
index e22a1da246..3e78934bfb 100644
--- a/ghc/compiler/main/DriverMkDepend.hs
+++ b/ghc/compiler/main/DriverMkDepend.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $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 = 
diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs
index 04392a15a1..1e4705fbb3 100644
--- a/ghc/compiler/main/DriverPipeline.hs
+++ b/ghc/compiler/main/DriverPipeline.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $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
diff --git a/ghc/compiler/main/DriverState.hs b/ghc/compiler/main/DriverState.hs
index 8aadde53d4..522330e04f 100644
--- a/ghc/compiler/main/DriverState.hs
+++ b/ghc/compiler/main/DriverState.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $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))
diff --git a/ghc/compiler/main/Main.hs b/ghc/compiler/main/Main.hs
index 88ddba7d01..6bbded77b8 100644
--- a/ghc/compiler/main/Main.hs
+++ b/ghc/compiler/main/Main.hs
@@ -1,6 +1,6 @@
 {-# 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