Make ASSERT2 mention msg even when debug is off (avoid warnings)

[ghc-hetmet.git] / ghc / Main.hs

diff --git a/ghc/Main.hs b/ghc/Main.hs
index a91df13..b75548b 100644 (file)
--- a/ghc/Main.hs
+++ b/ghc/Main.hs
@@ -35,16 +35,17 @@ import Packages             ( dumpPackages )
 import DriverPhases    ( Phase(..), isSourceFilename, anyHsc,
                          startPhase, isHaskellSrcFilename )
 import StaticFlags
+import StaticFlagParser
 import DynFlags
 import BasicTypes      ( failed )
 import ErrUtils
 import FastString
 import Outputable
+import SrcLoc
 import Util
 import Panic
 
 -- Standard Haskell libraries
-import Control.Exception ( throwDyn )
 import System.IO
 import System.Environment
 import System.Exit
@@ -77,7 +78,8 @@ main =
         mbMinusB | null minusB_args = Nothing
                  | otherwise = Just (drop 2 (last minusB_args))
 
-  (argv2, staticFlagWarnings) <- parseStaticFlags argv1
+  let argv1' = map (mkGeneralLocated "on the commandline") argv1
+  (argv2, staticFlagWarnings) <- parseStaticFlags argv1'
 
   -- 2. Parse the "mode" flags (--make, --interactive etc.)
   (cli_mode, argv3, modeFlagWarnings) <- parseModeFlags argv2
@@ -126,9 +128,16 @@ main =
                                         _other   -> 1
                        }
 
+      -- turn on -fimplicit-import-qualified for GHCi now, so that it
+      -- can be overriden from the command-line
+      dflags1a | DoInteractive <- cli_mode = imp_qual_enabled
+               | DoEval _      <- cli_mode = imp_qual_enabled
+               | otherwise                 = dflags1
+        where imp_qual_enabled = dflags1 `dopt_set` Opt_ImplicitImportQualified
+
        -- The rest of the arguments are "dynamic"
        -- Leftover ones are presumably files
-  (dflags2, fileish_args, dynamicFlagWarnings) <- GHC.parseDynamicFlags dflags1 argv3
+  (dflags2, fileish_args, dynamicFlagWarnings) <- GHC.parseDynamicFlags dflags1a argv3
 
   let flagWarnings = staticFlagWarnings
                   ++ modeFlagWarnings
@@ -149,7 +158,7 @@ main =
      -- To simplify the handling of filepaths, we normalise all filepaths right 
      -- away - e.g., for win32 platforms, backslashes are converted
      -- into forward slashes.
-    normal_fileish_paths = map normalise fileish_args
+    normal_fileish_paths = map (normalise . unLoc) fileish_args
     (srcs, objs)         = partition_args normal_fileish_paths [] []
 
   -- Note: have v_Ld_inputs maintain the order in which 'objs' occurred on 
@@ -188,7 +197,7 @@ main =
 #ifndef GHCI
 interactiveUI :: a -> b -> c -> IO ()
 interactiveUI _ _ _ = 
-  throwDyn (CmdLineError "not built for interactive use")
+  ghcError (CmdLineError "not built for interactive use")
 #endif
 
 -- -----------------------------------------------------------------------------
@@ -249,24 +258,24 @@ checkOptions cli_mode dflags srcs objs = do
        -- -prof and --interactive are not a good combination
    when (notNull (filter (not . isRTSWay) (wayNames dflags))
          && isInterpretiveMode cli_mode) $
-      do throwDyn (UsageError 
+      do ghcError (UsageError 
                    "--interactive can't be used with -prof or -unreg.")
        -- -ohi sanity check
    if (isJust (outputHi dflags) && 
       (isCompManagerMode cli_mode || srcs `lengthExceeds` 1))
-       then throwDyn (UsageError "-ohi can only be used when compiling a single source file")
+       then ghcError (UsageError "-ohi can only be used when compiling a single source file")
        else do
 
        -- -o sanity checking
    if (srcs `lengthExceeds` 1 && isJust (outputFile dflags)
         && not (isLinkMode cli_mode))
-       then throwDyn (UsageError "can't apply -o to multiple source files")
+       then ghcError (UsageError "can't apply -o to multiple source files")
        else do
 
        -- Check that there are some input files
        -- (except in the interactive case)
    if null srcs && null objs && needsInputsMode cli_mode
-       then throwDyn (UsageError "no input files")
+       then ghcError (UsageError "no input files")
        else do
 
      -- Verify that output files point somewhere sensible.
@@ -297,7 +306,7 @@ verifyOutputFiles dflags = do
      when (not flg) (nonExistentDir "-ohi" hi)
  where
    nonExistentDir flg dir = 
-     throwDyn (CmdLineError ("error: directory portion of " ++ 
+     ghcError (CmdLineError ("error: directory portion of " ++ 
                              show dir ++ " does not exist (used with " ++ 
                             show flg ++ " option.)"))
 
@@ -355,15 +364,15 @@ isCompManagerMode _             = False
 -- -----------------------------------------------------------------------------
 -- Parsing the mode flag
 
-parseModeFlags :: [String] -> IO (CmdLineMode, [String], [String])
+parseModeFlags :: [Located String]
+               -> IO (CmdLineMode, [Located String], [Located String])
 parseModeFlags args = do
   let ((leftover, errs, warns), (mode, _, flags')) =
         runCmdLine (processArgs mode_flags args) (StopBefore StopLn, "", []) 
-  when (not (null errs)) $ do
-    throwDyn (UsageError (unlines errs))
+  when (not (null errs)) $ ghcError $ errorsToGhcException errs
   return (mode, flags' ++ leftover, warns)
 
-type ModeM = CmdLineP (CmdLineMode, String, [String])
+type ModeM = CmdLineP (CmdLineMode, String, [Located String])
   -- mode flags sometimes give rise to new DynFlags (eg. -C, see below)
   -- so we collect the new ones and return them.
 
@@ -427,21 +436,22 @@ updateMode :: (CmdLineMode -> CmdLineMode) -> String -> ModeM ()
 updateMode f flag = do
   (old_mode, old_flag, flags') <- getCmdLineState
   if notNull old_flag && flag /= old_flag
-      then throwDyn (UsageError
+      then ghcError (UsageError
                ("cannot use `" ++ old_flag ++ "' with `" ++ flag ++ "'"))
       else putCmdLineState (f old_mode, flag, flags')
 
 addFlag :: String -> ModeM ()
 addFlag s = do
   (m, f, flags') <- getCmdLineState
-  putCmdLineState (m, f, s:flags')
+  -- XXX Can we get a useful Loc?
+  putCmdLineState (m, f, mkGeneralLocated "addFlag" s : flags')
 
 
 -- ----------------------------------------------------------------------------
 -- Run --make mode
 
 doMake :: Session -> [(String,Maybe Phase)] -> IO ()
-doMake _    []    = throwDyn (UsageError "no input files")
+doMake _    []    = ghcError (UsageError "no input files")
 doMake sess srcs  = do 
     let (hs_srcs, non_hs_srcs) = partition haskellish srcs
 
@@ -560,4 +570,4 @@ countFS entries longest is_z has_z (b:bs) =
 -- Util
 
 unknownFlagsErr :: [String] -> a
-unknownFlagsErr fs = throwDyn (UsageError ("unrecognised flags: " ++ unwords fs))
+unknownFlagsErr fs = ghcError (UsageError ("unrecognised flags: " ++ unwords fs))