diff options
Diffstat (limited to 'compiler/main/GhcMake.hs')
| -rw-r--r-- | compiler/main/GhcMake.hs | 39 |
1 files changed, 36 insertions, 3 deletions
diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs index 81311c1e0c..6e44a86f28 100644 --- a/compiler/main/GhcMake.hs +++ b/compiler/main/GhcMake.hs @@ -1357,6 +1357,25 @@ upsweep mHscMessage old_hpt stable_mods cleanup sccs = do where done_holes = emptyUniqSet + keep_going this_mods old_hpt done mods mod_index nmods uids_to_check done_holes = do + let sum_deps ms (AcyclicSCC mod) = + if any (flip elem . map (unLoc . snd) $ ms_imps mod) ms + then ms_mod_name mod:ms + else ms + sum_deps ms _ = ms + dep_closure = foldl' sum_deps this_mods mods + dropped_ms = drop (length this_mods) (reverse dep_closure) + prunable (AcyclicSCC mod) = elem (ms_mod_name mod) dep_closure + prunable _ = False + mods' = filter (not . prunable) mods + nmods' = nmods - length dropped_ms + + when (not $ null dropped_ms) $ do + dflags <- getSessionDynFlags + liftIO $ fatalErrorMsg dflags (keepGoingPruneErr dropped_ms) + (_, done') <- upsweep' old_hpt done mods' (mod_index+1) nmods' uids_to_check done_holes + return (Failed, done') + upsweep' :: GhcMonad m => HomePackageTable @@ -1374,10 +1393,13 @@ upsweep mHscMessage old_hpt stable_mods cleanup sccs = do return (Succeeded, done) upsweep' _old_hpt done - (CyclicSCC ms:_) _ _ _ _ + (CyclicSCC ms:mods) mod_index nmods uids_to_check done_holes = do dflags <- getSessionDynFlags liftIO $ fatalErrorMsg dflags (cyclicModuleErr ms) - return (Failed, done) + if gopt Opt_KeepGoing dflags + then keep_going (map ms_mod_name ms) old_hpt done mods mod_index nmods + uids_to_check done_holes + else return (Failed, done) upsweep' old_hpt done (AcyclicSCC mod:mods) mod_index nmods uids_to_check done_holes @@ -1426,7 +1448,12 @@ upsweep mHscMessage old_hpt stable_mods cleanup sccs = do return (Just mod_info) case mb_mod_info of - Nothing -> return (Failed, done) + Nothing -> do + dflags <- getSessionDynFlags + if gopt Opt_KeepGoing dflags + then keep_going [ms_mod_name mod] old_hpt done mods mod_index nmods + uids_to_check done_holes + else return (Failed, done) Just mod_info -> do let this_mod = ms_mod_name mod @@ -2652,6 +2679,12 @@ multiRootsErr dflags summs@(summ1:_) mod = ms_mod summ1 files = map (expectJust "checkDup" . ml_hs_file . ms_location) summs +keepGoingPruneErr :: [ModuleName] -> SDoc +keepGoingPruneErr ms + = vcat (( text "-fkeep-going in use, removing the following" <+> + text "dependencies and continuing:"): + map (nest 6 . ppr) ms ) + cyclicModuleErr :: [ModSummary] -> SDoc -- From a strongly connected component we find -- a single cycle to report |