- hs_file = file `joinFileExt` "hs"
- lhs_file = file `joinFileExt` "lhs"
-
--- -----------------------------------------------------------------------------
--- Extending the program scope
-
-extendGlobalRdrScope :: Session -> [GlobalRdrElt] -> IO ()
-extendGlobalRdrScope session rdrElts
- = modifySession session $ \hscEnv ->
- let global_rdr = hsc_global_rdr_env hscEnv
- in hscEnv{ hsc_global_rdr_env = foldl extendGlobalRdrEnv global_rdr rdrElts }
-
-setGlobalRdrScope :: Session -> [GlobalRdrElt] -> IO ()
-setGlobalRdrScope session rdrElts
- = modifySession session $ \hscEnv ->
- hscEnv{ hsc_global_rdr_env = foldl extendGlobalRdrEnv emptyGlobalRdrEnv rdrElts }
-
-extendGlobalTypeScope :: Session -> [Id] -> IO ()
-extendGlobalTypeScope session ids
- = modifySession session $ \hscEnv ->
- let global_type = hsc_global_type_env hscEnv
- in hscEnv{ hsc_global_type_env = extendTypeEnvWithIds global_type ids }
-
-setGlobalTypeScope :: Session -> [Id] -> IO ()
-setGlobalTypeScope session ids
- = modifySession session $ \hscEnv ->
- hscEnv{ hsc_global_type_env = extendTypeEnvWithIds emptyTypeEnv ids }
-
--- -----------------------------------------------------------------------------
--- Parsing Haddock comments
-
-parseHaddockComment :: String -> Either String (HsDoc RdrName)
-parseHaddockComment string = parseHaddockParagraphs (tokenise string)
-
--- -----------------------------------------------------------------------------
--- Loading the program
-
--- Perform a dependency analysis starting from the current targets
--- and update the session with the new module graph.
-depanal :: Session -> [ModuleName] -> Bool -> IO (Maybe ModuleGraph)
-depanal (Session ref) excluded_mods allow_dup_roots = do
- hsc_env <- readIORef ref
- let
- dflags = hsc_dflags hsc_env
- gmode = ghcMode (hsc_dflags hsc_env)
- targets = hsc_targets hsc_env
- old_graph = hsc_mod_graph hsc_env
-
- showPass dflags "Chasing dependencies"
- when (gmode == BatchCompile) $
- debugTraceMsg dflags 2 (hcat [
- text "Chasing modules from: ",
- hcat (punctuate comma (map pprTarget targets))])
-
- r <- downsweep hsc_env old_graph excluded_mods allow_dup_roots
- case r of
- Just mod_graph -> writeIORef ref hsc_env{ hsc_mod_graph = mod_graph }
- _ -> return ()
- return r
-
-{-
--- | The result of load.
-data LoadResult
- = LoadOk Errors -- ^ all specified targets were loaded successfully.
- | LoadFailed Errors -- ^ not all modules were loaded.
-
-type Errors = [String]
-
-data ErrMsg = ErrMsg {
- errMsgSeverity :: Severity, -- warning, error, etc.
- errMsgSpans :: [SrcSpan],
- errMsgShortDoc :: Doc,
- errMsgExtraInfo :: Doc
- }
--}
-
-data LoadHowMuch
- = LoadAllTargets
- | LoadUpTo ModuleName
- | LoadDependenciesOf ModuleName
-
--- | Try to load the program. If a Module is supplied, then just
--- 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
- = do
- -- Dependency analysis first. Note that this fixes the module graph:
- -- even if we don't get a fully successful upsweep, the full module
- -- graph is still retained in the Session. We can tell which modules
- -- were successfully loaded by inspecting the Session's HPT.
- mb_graph <- depanal s [] False
- case mb_graph of
- Just mod_graph -> load2 s how_much mod_graph
- Nothing -> return Failed
-
-load2 s@(Session ref) how_much mod_graph = do
- guessOutputFile s
- hsc_env <- readIORef ref
-
- let hpt1 = hsc_HPT hsc_env
- let dflags = hsc_dflags hsc_env
- let ghci_mode = ghcMode dflags -- this never changes
-
- -- The "bad" boot modules are the ones for which we have
- -- B.hs-boot in the module graph, but no B.hs
- -- The downsweep should have ensured this does not happen
- -- (see msDeps)
- let all_home_mods = [ms_mod_name s
- | s <- mod_graph, not (isBootSummary s)]
-#ifdef DEBUG
- bad_boot_mods = [s | s <- mod_graph, isBootSummary s,
- not (ms_mod_name s `elem` all_home_mods)]
-#endif
- ASSERT( null bad_boot_mods ) return ()
-
- -- 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
- -- upsweep, and for removing from hpt all the modules
- -- not in strict downwards closure, during calls to compile.
- let mg2_with_srcimps :: [SCC ModSummary]
- mg2_with_srcimps = topSortModuleGraph True mod_graph Nothing
-
- -- If we can determine that any of the {-# SOURCE #-} imports
- -- are definitely unnecessary, then emit a warning.
- warnUnnecessarySourceImports dflags mg2_with_srcimps
-
- let
- -- check the stability property for each module.
- stable_mods@(stable_obj,stable_bco)
- | BatchCompile <- ghci_mode = ([],[])
- | otherwise = checkStability hpt1 mg2_with_srcimps all_home_mods
-
- -- prune bits of the HPT which are definitely redundant now,
- -- to save space.
- pruned_hpt = pruneHomePackageTable hpt1
- (flattenSCCs mg2_with_srcimps)
- stable_mods
-
- evaluate pruned_hpt
-
- debugTraceMsg dflags 2 (text "Stable obj:" <+> ppr stable_obj $$
- text "Stable BCO:" <+> ppr stable_bco)
-
- -- Unload any modules which are going to be re-linked this time around.
- let stable_linkables = [ linkable
- | m <- stable_obj++stable_bco,
- Just hmi <- [lookupUFM pruned_hpt m],
- Just linkable <- [hm_linkable hmi] ]
- unload hsc_env stable_linkables
-
- -- We could at this point detect cycles which aren't broken by
- -- a source-import, and complain immediately, but it seems better
- -- to let upsweep_mods do this, so at least some useful work gets
- -- done before the upsweep is abandoned.
- --hPutStrLn stderr "after tsort:\n"
- --hPutStrLn stderr (showSDoc (vcat (map ppr mg2)))
-
- -- Now do the upsweep, calling compile for each module in
- -- turn. Final result is version 3 of everything.
-
- -- Topologically sort the module graph, this time including hi-boot
- -- nodes, and possibly just including the portion of the graph
- -- reachable from the module specified in the 2nd argument to load.
- -- This graph should be cycle-free.
- -- If we're restricting the upsweep to a portion of the graph, we
- -- also want to retain everything that is still stable.
- let full_mg :: [SCC ModSummary]
- full_mg = topSortModuleGraph False mod_graph Nothing
-
- maybe_top_mod = case how_much of
- LoadUpTo m -> Just m
- LoadDependenciesOf m -> Just m
- _ -> Nothing
-
- partial_mg0 :: [SCC ModSummary]
- partial_mg0 = topSortModuleGraph False mod_graph maybe_top_mod
-
- -- LoadDependenciesOf m: we want the upsweep to stop just
- -- short of the specified module (unless the specified module
- -- is stable).
- partial_mg
- | LoadDependenciesOf mod <- how_much
- = ASSERT( case last partial_mg0 of
- AcyclicSCC ms -> ms_mod_name ms == mod; _ -> False )
- List.init partial_mg0
- | otherwise
- = partial_mg0
-
- stable_mg =
- [ AcyclicSCC ms
- | AcyclicSCC ms <- full_mg,
- ms_mod_name ms `elem` stable_obj++stable_bco,
- ms_mod_name ms `notElem` [ ms_mod_name ms' |
- AcyclicSCC ms' <- partial_mg ] ]
-
- mg = stable_mg ++ partial_mg
-
- -- clean up between compilations
- let cleanup = cleanTempFilesExcept dflags
- (ppFilesFromSummaries (flattenSCCs mg2_with_srcimps))
-
- debugTraceMsg dflags 2 (hang (text "Ready for upsweep")
- 2 (ppr mg))
- (upsweep_ok, hsc_env1, modsUpswept)
- <- upsweep (hsc_env { hsc_HPT = emptyHomePackageTable })
- pruned_hpt stable_mods cleanup mg
-
- -- Make modsDone be the summaries for each home module now
- -- available; this should equal the domain of hpt3.
- -- Get in in a roughly top .. bottom order (hence reverse).
-
- let modsDone = reverse modsUpswept
-
- -- Try and do linking in some form, depending on whether the
- -- upsweep was completely or only partially successful.
-
- if succeeded upsweep_ok
-
- then
- -- Easy; just relink it all.
- do debugTraceMsg dflags 2 (text "Upsweep completely successful.")
-
- -- Clean up after ourselves
- cleanTempFilesExcept dflags (ppFilesFromSummaries modsDone)
-
- -- Issue a warning for the confusing case where the user
- -- said '-o foo' but we're not going to do any linking.
- -- We attempt linking if either (a) one of the modules is
- -- called Main, or (b) the user said -no-hs-main, indicating
- -- that main() is going to come from somewhere else.
- --
- let ofile = outputFile dflags
- let no_hs_main = dopt Opt_NoHsMain dflags
- let
- main_mod = mainModIs dflags
- a_root_is_Main = any ((==main_mod).ms_mod) mod_graph
- do_linking = a_root_is_Main || no_hs_main
-
- when (ghci_mode == BatchCompile && isJust ofile && not do_linking) $
- debugTraceMsg dflags 1 (text ("Warning: output was redirected with -o, " ++
- "but no output will be generated\n" ++
- "because there is no " ++ moduleNameString (moduleName main_mod) ++ " module."))
-
- -- link everything together
- linkresult <- link ghci_mode dflags do_linking (hsc_HPT hsc_env1)
-
- loadFinish Succeeded linkresult ref hsc_env1
-
- else
- -- Tricky. We need to back out the effects of compiling any
- -- half-done cycles, both so as to clean up the top level envs
- -- and to avoid telling the interactive linker to link them.
- do debugTraceMsg dflags 2 (text "Upsweep partially successful.")
-
- let modsDone_names
- = map ms_mod modsDone
- let mods_to_zap_names
- = findPartiallyCompletedCycles modsDone_names
- mg2_with_srcimps
- let mods_to_keep
- = filter ((`notElem` mods_to_zap_names).ms_mod)
- modsDone
-
- let hpt4 = retainInTopLevelEnvs (map ms_mod_name mods_to_keep)
- (hsc_HPT hsc_env1)
-
- -- Clean up after ourselves
- cleanTempFilesExcept dflags (ppFilesFromSummaries mods_to_keep)
-
- -- there should be no Nothings where linkables should be, now
- ASSERT(all (isJust.hm_linkable)
- (eltsUFM (hsc_HPT hsc_env))) do
-
- -- Link everything together
- linkresult <- link ghci_mode dflags False hpt4
-
- let hsc_env4 = hsc_env1{ hsc_HPT = hpt4 }
- loadFinish Failed linkresult ref hsc_env4