From: simonmar Date: Wed, 28 Mar 2001 16:51:03 +0000 (+0000) Subject: [project @ 2001-03-28 16:51:02 by simonmar] X-Git-Tag: Approximately_9120_patches~2265 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=da25d580440a2b6a30eabedff19e7a6970f35991;p=ghc-hetmet.git [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 --- 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 --- 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 '") + = throwDyn (CmdLineError "syntax: `:m '") 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 --- 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 --- 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))