[project @ 2001-03-28 16:51:02 by simonmar]

Cleaning up error reporting, 2nd attempt.

  - The UserError name is already bagged by Exception (for
    userErrors).  So we use ProgramError instead, which is
    more appropriate.

  - some previously UserErrors are now CmdLineErrors.  GHCi
    catches CmdLineErrors and prints them without the "ghc: "
    prefix.

diff --git a/ghc/compiler/compMan/CompManager.lhs b/ghc/compiler/compMan/CompManager.lhs
index bf8d0cf..001a44d 100644 (file)
--- 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 (UserError (showSDoc 
+                       then throwDyn (CmdLineError (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 (UserError ("can't find module `"
+       Nothing -> throwDyn (CmdLineError ("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 (UserError ("can't find file `" ++ file ++ "'"))       
+               throwDyn (CmdLineError ("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 (UserError 
+                  Nothing -> throwDyn (CmdLineError 
                                    ("can't find module `" 
                                      ++ showSDoc (ppr nm) ++ "'"))
 
@@ -1055,7 +1055,7 @@ summarise mod location old_summary
         let (srcimps,imps,mod_name) = getImports modsrc
 
        when (mod_name /= moduleName mod) $
-               throwDyn (UserError 
+               throwDyn (ProgramError 
                   (showSDoc (text modsrc
                              <>  text ": file name does not match module name"
                              <+> quotes (ppr (moduleName mod)))))
@@ -1070,7 +1070,7 @@ noHsFileErr mod
   = panic (showSDoc (text "no source file for module" <+> quotes (ppr mod)))
 
 packageModErr mod
-  = throwDyn (UserError (showSDoc (text "module" <+>
+  = throwDyn (CmdLineError (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 dc75318..cce4827 100644 (file)
--- a/ghc/compiler/ghci/InteractiveUI.hs
+++ b/ghc/compiler/ghci/InteractiveUI.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: InteractiveUI.hs,v 1.59 2001/03/28 11:01:19 simonmar Exp $
+-- $Id: InteractiveUI.hs,v 1.60 2001/03/28 16:51:03 simonmar Exp $
 --
 -- GHC Interactive User Interface
 --
@@ -232,6 +232,8 @@ runCommand c =
                        io ( putStrLn ("Phase " ++ phase ++ " failed (code "
                                        ++ show code ++ ")"))
                    Interrupted -> io (putStrLn "Interrupted.")
+                       -- omit the location for CmdLineError
+                   CmdLineError s -> io (putStrLn s)
                    other -> io (putStrLn (show (ghc_ex :: GhcException)))
 
           other -> io (putStrLn ("*** Exception: " ++ show exception))
@@ -301,7 +303,7 @@ specialCommand str = do
                                       foldr1 (\a b -> a ++ ',':b) (map fst cs)
                                         ++ ")") >> return False)
 
-noArgs c = throwDyn (UserError ("command `" ++ c ++ "' takes no arguments"))
+noArgs c = throwDyn (CmdLineError ("command `" ++ c ++ "' takes no arguments"))
 
 -----------------------------------------------------------------------------
 -- Commands
@@ -314,9 +316,9 @@ addModule _ = throwDyn (InstallationError ":add not implemented")
 
 setContext :: String -> GHCi ()
 setContext ""
-  = throwDyn (UserError "syntax: `:m <module>'")
+  = throwDyn (CmdLineError "syntax: `:m <module>'")
 setContext m | not (isUpper (head m)) || not (all isAlphaNum (tail m))
-  = throwDyn (UserError ("strange looking module name: `" ++ m ++ "'"))
+  = throwDyn (CmdLineError ("strange looking module name: `" ++ m ++ "'"))
 setContext str
   = do st <- getGHCiState
        new_cmstate <- io (cmSetContext (cmstate st) str)
@@ -333,10 +335,10 @@ defineMacro s = do
   let (macro_name, definition) = break isSpace s
   cmds <- io (readIORef commands)
   if (null macro_name) 
-       then throwDyn (UserError "invalid macro name") 
+       then throwDyn (CmdLineError "invalid macro name") 
        else do
   if (macro_name `elem` map fst cmds) 
-       then throwDyn (UserError 
+       then throwDyn (CmdLineError 
                ("command `" ++ macro_name ++ "' is already defined"))
        else do
 
@@ -363,11 +365,11 @@ undefineMacro :: String -> GHCi ()
 undefineMacro macro_name = do
   cmds <- io (readIORef commands)
   if (macro_name `elem` map fst builtin_commands) 
-       then throwDyn (UserError
+       then throwDyn (CmdLineError
                ("command `" ++ macro_name ++ "' cannot be undefined"))
        else do
   if (macro_name `notElem` map fst cmds) 
-       then throwDyn (UserError 
+       then throwDyn (CmdLineError 
                ("command `" ++ macro_name ++ "' not defined"))
        else do
   io (writeIORef commands (filter ((/= macro_name) . fst) cmds))
@@ -472,7 +474,7 @@ setOptions str
              writeIORef v_InitDynFlags dyn_flags
 
               if (not (null leftovers))
-                then throwDyn (UserError ("unrecognised flags: " ++ 
+                then throwDyn (CmdLineError ("unrecognised flags: " ++ 
                                                unwords leftovers))
                 else return ()
          )
@@ -492,7 +494,7 @@ unsetOptions str
  
        -- can't do GHC flags for now
        if (not (null minus_opts))
-         then throwDyn (UserError "can't unset GHC command-line flags")
+         then throwDyn (CmdLineError "can't unset GHC command-line flags")
          else return ()
 
 isMinus ('-':s) = True
@@ -620,7 +622,7 @@ linkPackages cmdline_lib_specs pkgs
                                      putStr ("failed (" ++ str ++ ")\n")
                                      croak
 
-        croak = throwDyn (UserError "user specified .o/.so/.DLL could not be loaded.")
+        croak = throwDyn (CmdLineError "user specified .o/.so/.DLL could not be loaded.")
 
 
 linkPackage :: PackageConfig -> IO ()
@@ -653,7 +655,7 @@ loadClassified (Right dll_unadorned)
         if    maybe_errmsg == nullPtr
          then return ()
          else do str <- peekCString maybe_errmsg
-                 throwDyn (UserError ("can't find .o or .so/.DLL for: " 
+                 throwDyn (CmdLineError ("can't find .o or .so/.DLL for: " 
                                        ++ dll_unadorned ++ " (" ++ str ++ ")" ))
 
 locateOneObj :: [FilePath] -> String -> IO LibrarySpec

diff --git a/ghc/compiler/main/DriverMkDepend.hs b/ghc/compiler/main/DriverMkDepend.hs
index 3e78934..f72ab56 100644 (file)
--- a/ghc/compiler/main/DriverMkDepend.hs
+++ b/ghc/compiler/main/DriverMkDepend.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: DriverMkDepend.hs,v 1.8 2001/03/28 11:01:19 simonmar Exp $
+-- $Id: DriverMkDepend.hs,v 1.9 2001/03/28 16:51:03 simonmar Exp $
 --
 -- GHC Driver
 --
@@ -181,7 +181,7 @@ findDependency is_source src imp = do
      deps | is_source = [ imp_hiboot_v, imp_hiboot, imp_hs, imp_lhs ]
          | otherwise = [ imp_hi, imp_hs, imp_lhs ]
 
-     search [] = throwDyn (UserError (src ++ ": " ++ "can't find one of the following: " ++
+     search [] = throwDyn (ProgramError (src ++ ": " ++ "can't find one of the following: " ++
                                      unwords (map (\d -> '`': d ++ "'") deps)))
      search ((dir, contents) : dirs)
           | null present = search dirs

diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs
index 1e4705f..f0e2db9 100644 (file)
--- a/ghc/compiler/main/DriverPipeline.hs
+++ b/ghc/compiler/main/DriverPipeline.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: DriverPipeline.hs,v 1.61 2001/03/28 11:01:19 simonmar Exp $
+-- $Id: DriverPipeline.hs,v 1.62 2001/03/28 16:51:03 simonmar Exp $
 --
 -- GHC Driver
 --
@@ -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 (UserError (
+  = do when (not (null flags)) (throwDyn (ProgramError (
            basename ++ "." ++ suff 
            ++ ": static flags are not allowed in {-# OPTIONS #-} pragmas:\n\t" 
            ++ unwords flags)) (ExitFailure 1))