Add a WARNING pragma
[ghc-hetmet.git] / compiler / main / GHC.hs
index bf3bfd1..87d07de 100644 (file)
@@ -239,7 +239,7 @@ import CoreSyn
 import TidyPgm
 import DriverPipeline
 import DriverPhases    ( HscSource(..), Phase(..), isHaskellSrcFilename, startPhase )
-import HeaderInfo      ( getImports, getOptions )
+import HeaderInfo
 import Finder
 import HscMain
 import HscTypes
@@ -255,10 +255,7 @@ import FiniteMap
 import Panic
 import Digraph
 import Bag             ( unitBag, listToBag )
-import ErrUtils                ( Severity(..), showPass, fatalErrorMsg, debugTraceMsg,
-                         mkPlainErrMsg, printBagOfErrors, printBagOfWarnings,
-                         WarnMsg )
-import qualified ErrUtils
+import ErrUtils
 import Util
 import StringBuffer    ( StringBuffer, hGetStringBuffer )
 import Outputable
@@ -393,16 +390,25 @@ guessOutputFile :: Session -> IO ()
 guessOutputFile s = modifySession s $ \env ->
     let dflags = hsc_dflags env
         mod_graph = hsc_mod_graph env
-        mainModuleSrcPath, guessedName :: Maybe String
+        mainModuleSrcPath :: Maybe String
         mainModuleSrcPath = do
             let isMain = (== mainModIs dflags) . ms_mod
             [ms] <- return (filter isMain mod_graph)
             ml_hs_file (ms_location ms)
-        guessedName = fmap dropExtension mainModuleSrcPath
+        name = fmap dropExtension mainModuleSrcPath
+
+#if defined(mingw32_HOST_OS)
+        -- we must add the .exe extention unconditionally here, otherwise
+        -- when name has an extension of its own, the .exe extension will
+        -- not be added by DriverPipeline.exeFileName.  See #2248
+        name_exe = fmap (<.> "exe") name
+#else
+        name_exe = name
+#endif
     in
     case outputFile dflags of
         Just _ -> env
-        Nothing -> env { hsc_dflags = dflags { outputFile = guessedName } }
+        Nothing -> env { hsc_dflags = dflags { outputFile = name_exe } }
 
 -- -----------------------------------------------------------------------------
 -- Targets
@@ -545,7 +551,7 @@ data LoadHowMuch
 -- attempt to load up to this target.  If no Module is supplied,
 -- then try to load all targets.
 load :: Session -> LoadHowMuch -> IO SuccessFlag
-load s@(Session ref) how_much
+load s how_much
    = do 
        -- Dependency analysis first.  Note that this fixes the module graph:
        -- even if we don't get a fully successful upsweep, the full module
@@ -553,15 +559,8 @@ load s@(Session ref) how_much
        -- were successfully loaded by inspecting the Session's HPT.
        mb_graph <- depanal s [] False
        case mb_graph of
-          Just mod_graph -> catchingFailure $ load2 s how_much mod_graph
+          Just mod_graph -> load2 s how_much mod_graph
           Nothing        -> return Failed
-    where catchingFailure f = f `Exception.catch` \e -> do
-              hsc_env <- readIORef ref
-              -- trac #1565 / test ghci021:
-              -- let bindings may explode if we try to use them after
-              -- failing to reload
-              writeIORef ref $! hsc_env{ hsc_IC = emptyInteractiveContext }
-              throw e
 
 load2 :: Session -> LoadHowMuch -> [ModSummary] -> IO SuccessFlag
 load2 s@(Session ref) how_much mod_graph = do
@@ -581,6 +580,21 @@ load2 s@(Session ref) how_much mod_graph = do
                                        not (ms_mod_name s `elem` all_home_mods)]
        ASSERT( null bad_boot_mods ) return ()
 
+        -- check that the module given in HowMuch actually exists, otherwise
+        -- topSortModuleGraph will bomb later.
+        let checkHowMuch (LoadUpTo m)           = checkMod m
+            checkHowMuch (LoadDependenciesOf m) = checkMod m
+            checkHowMuch _ = id
+
+            checkMod m and_then
+                | m `elem` all_home_mods = and_then
+                | otherwise = do 
+                        errorMsg dflags (text "no such module:" <+> 
+                                         quotes (ppr m))
+                        return Failed
+
+        checkHowMuch how_much $ do
+
         -- mg2_with_srcimps drops the hi-boot nodes, returning a 
        -- graph with cycles.  Among other things, it is used for
         -- backing out partially complete cycles following a failed
@@ -606,6 +620,12 @@ load2 s@(Session ref) how_much mod_graph = do
 
        evaluate pruned_hpt
 
+        -- before we unload anything, make sure we don't leave an old
+        -- interactive context around pointing to dead bindings.  Also,
+        -- write the pruned HPT to allow the old HPT to be GC'd.
+        writeIORef ref $! hsc_env{ hsc_IC = emptyInteractiveContext,
+                                   hsc_HPT = pruned_hpt }
+
        debugTraceMsg dflags 2 (text "Stable obj:" <+> ppr stable_obj $$
                                text "Stable BCO:" <+> ppr stable_bco)
 
@@ -974,7 +994,7 @@ mkModGuts coreModule = ModGuts {
   mg_rules = [],
   mg_binds = cm_binds coreModule,
   mg_foreign = NoStubs,
-  mg_deprecs = NoDeprecs,
+  mg_warns = NoWarnings,
   mg_hpc_info = emptyHpcInfo False,
   mg_modBreaks = emptyModBreaks,
   mg_vect_info = noVectInfo,
@@ -1760,7 +1780,10 @@ summariseFile hsc_env old_summaries file mb_phase maybe_buf
 
        if ms_hs_date old_summary == src_timestamp 
           then do -- update the object-file timestamp
-                 obj_timestamp <- getObjTimestamp location False
+                 obj_timestamp <-
+                    if isObjectTarget (hscTarget (hsc_dflags hsc_env)) -- #1205
+                        then getObjTimestamp location False
+                        else return Nothing
                  return old_summary{ ms_obj_date = obj_timestamp }
           else
                new_summary
@@ -1788,7 +1811,12 @@ summariseFile hsc_env old_summaries file mb_phase maybe_buf
                           Nothing    -> getModificationTime file
                        -- getMofificationTime may fail
 
-       obj_timestamp <- modificationTimeIfExists (ml_obj_file location)
+        -- when the user asks to load a source file by name, we only
+        -- use an object file if -fobject-code is on.  See #1205.
+       obj_timestamp <-
+            if isObjectTarget (hscTarget (hsc_dflags hsc_env))
+                then modificationTimeIfExists (ml_obj_file location)
+                else return Nothing
 
         return (ModSummary { ms_mod = mod, ms_hsc_src = HsSrcFile,
                             ms_location = location,
@@ -1938,8 +1966,9 @@ preprocessFile hsc_env src_fn mb_phase (Just (buf, _time))
        let 
            local_opts = getOptions dflags buf src_fn
        --
-       (dflags', _errs) <- parseDynamicFlags dflags (map unLoc local_opts)
-        -- XXX: shouldn't we be reporting the errors?
+       (dflags', leftovers, warns) <- parseDynamicFlags dflags (map unLoc local_opts)
+        checkProcessArgsResult leftovers src_fn
+        handleFlagWarnings dflags' warns
 
        let
            needs_preprocessing
@@ -2215,7 +2244,7 @@ findModule s mod_name maybe_pkg = withSession s $ \hsc_env ->
          case res of
            Found _ m | modulePackageId m /= this_pkg -> return m
                      | otherwise -> throwDyn (CmdLineError (showSDoc $
-                                       text "module" <+> pprModule m <+>
+                                       text "module" <+> quotes (ppr (moduleName m)) <+>
                                        text "is not loaded"))
            err -> let msg = cannotFindModule dflags mod_name err in
                   throwDyn (CmdLineError (showSDoc msg))