X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FGHC.hs;h=26f13d105e7ef404df8dfed2f3198628dee42133;hb=ca26fe60260f3e52e82ec27c18a8aa5169cdcc89;hp=7d3ef501e6c0cfc7890f384df50d7e9e2bdaefe7;hpb=59e7d08db602d243d3768ce6907e7bfe67a55e1a;p=ghc-hetmet.git diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index 7d3ef50..26f13d1 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -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 @@ -351,8 +348,8 @@ newSession mb_top_dir = do installSignalHandlers initStaticOpts - dflags0 <- initSysTools mb_top_dir defaultDynFlags - dflags <- initDynFlags dflags0 + dflags0 <- initDynFlags defaultDynFlags + dflags <- initSysTools mb_top_dir dflags0 env <- newHscEnv dflags ref <- newIORef env return (Session ref) @@ -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 @@ -448,6 +454,8 @@ guessTarget file (Just phase) guessTarget file Nothing | isHaskellSrcFilename file = return (Target (TargetFile file Nothing) Nothing) + | looksLikeModuleName file + = return (Target (TargetModule (mkModuleName file)) Nothing) | otherwise = do exists <- doesFileExist hs_file if exists @@ -457,7 +465,9 @@ guessTarget file Nothing if exists then return (Target (TargetFile lhs_file Nothing) Nothing) else do - return (Target (TargetModule (mkModuleName file)) Nothing) + throwDyn (ProgramError (showSDoc $ + text "target" <+> quotes (text file) <+> + text "is not a module name or a source file")) where hs_file = file <.> "hs" lhs_file = file <.> "lhs" @@ -545,7 +555,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 +563,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 +584,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 +624,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 +998,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 +1784,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)) -- bug #1205 + then getObjTimestamp location False + else return Nothing return old_summary{ ms_obj_date = obj_timestamp } else new_summary @@ -1788,7 +1815,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, @@ -1869,7 +1901,6 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) maybe_buf exc -- Drop external-pkg ASSERT(modulePackageId mod /= thisPackage dflags) return Nothing - where err -> noModError dflags loc wanted_mod err -- Not found @@ -1938,8 +1969,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 +2247,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))