diff options
author | Sylvain Henry <sylvain@haskus.fr> | 2020-05-18 12:15:05 +0200 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-06-13 02:13:03 -0400 |
commit | 5226da37845ae82bff0e3e6b16be7453e3d9370d (patch) | |
tree | 7dc8862da38b190b010d06f826ed11cdd96f2b50 /compiler/GHC/Unit | |
parent | 36e1daf0a604d98a34d9a066a01dd4f5439b4aca (diff) | |
download | haskell-5226da37845ae82bff0e3e6b16be7453e3d9370d.tar.gz |
Refactor and document add_package
Diffstat (limited to 'compiler/GHC/Unit')
-rw-r--r-- | compiler/GHC/Unit/State.hs | 51 |
1 files changed, 26 insertions, 25 deletions
diff --git a/compiler/GHC/Unit/State.hs b/compiler/GHC/Unit/State.hs index a3a003aeda..ef2e6bc6ba 100644 --- a/compiler/GHC/Unit/State.hs +++ b/compiler/GHC/Unit/State.hs @@ -2021,7 +2021,7 @@ getPreloadUnitsAnd dflags pkgids0 = preload = preloadUnits state parents = zip pkgids (repeat Nothing) in do - all_pkgs <- throwErr dflags (foldM (add_package pkg_map) preload parents) + all_pkgs <- throwErr dflags (foldM (add_unit pkg_map) preload parents) return (map (unsafeLookupUnitId state) all_pkgs) -- Takes a list of packages, and returns the list with dependencies included, @@ -2042,34 +2042,35 @@ throwErr dflags m closeDepsErr :: UnitInfoMap -> [(UnitId,Maybe UnitId)] -> MaybeErr MsgDoc [UnitId] -closeDepsErr pkg_map ps = foldM (add_package pkg_map) [] ps +closeDepsErr pkg_map ps = foldM (add_unit pkg_map) [] ps --- internal helper -add_package :: UnitInfoMap +-- | Add a UnitId and those it depends on (recursively) to the given list of +-- UnitIds if they are not already in it. Return a list in reverse dependency +-- order (a unit appears before those it depends on). +-- +-- The UnitId is looked up in the given UnitInfoMap (to find its dependencies). +-- It it's not found, the optional parent unit is used to return a more precise +-- error message ("dependency of <PARENT>"). +add_unit :: UnitInfoMap -> [UnitId] -> (UnitId,Maybe UnitId) -> MaybeErr MsgDoc [UnitId] -add_package pkg_map ps (p, mb_parent) - | p `elem` ps = return ps -- Check if we've already added this package - | otherwise = - case lookupUnitId' pkg_map p of - Nothing -> Failed (missingPackageMsg p <> - missingDependencyMsg mb_parent) - Just pkg -> do - -- Add the package's dependents also - ps' <- foldM add_unit_key ps (unitDepends pkg) - return (p : ps') - where - add_unit_key ps key - = add_package pkg_map ps (key, Just p) - -missingPackageMsg :: Outputable pkgid => pkgid -> SDoc -missingPackageMsg p = text "unknown package:" <+> ppr p - -missingDependencyMsg :: Maybe UnitId -> SDoc -missingDependencyMsg Nothing = Outputable.empty -missingDependencyMsg (Just parent) - = space <> parens (text "dependency of" <+> ftext (unitIdFS parent)) +add_unit pkg_map ps (p, mb_parent) + | p `elem` ps = return ps -- Check if we've already added this unit + | otherwise = case lookupUnitId' pkg_map p of + Nothing -> Failed $ + (ftext (fsLit "unknown package:") <+> ppr p) + <> case mb_parent of + Nothing -> Outputable.empty + Just parent -> space <> parens (text "dependency of" + <+> ftext (unitIdFS parent)) + Just info -> do + -- Add the unit's dependents also + ps' <- foldM add_unit_key ps (unitDepends info) + return (p : ps') + where + add_unit_key ps key + = add_unit pkg_map ps (key, Just p) -- ----------------------------------------------------------------------------- |