diff options
author | David Feuer <david.feuer@gmail.com> | 2017-03-02 13:45:27 -0500 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2017-03-02 14:57:30 -0500 |
commit | ae67619853d029ea8049a114f44e59f4ca10b990 (patch) | |
tree | fc4e241b74248f72ba5d9a9e438eb3bb2d84e734 /compiler/main | |
parent | 27a1b12f90b4b27763d22310215f0df34cbd702a (diff) | |
download | haskell-ae67619853d029ea8049a114f44e59f4ca10b990.tar.gz |
Eliminate ListSetOps from imp_trust_pkgs
Eliminate ListSetOps from imp_trust_pkgs and imp_dep_pkgs
Replace Map with NameEnv in TmOracle
Reviewers: austin, dfeuer, bgamari
Reviewed By: bgamari
Subscribers: thomie
Differential Revision: https://phabricator.haskell.org/D3113
Diffstat (limited to 'compiler/main')
-rw-r--r-- | compiler/main/GHC.hs | 3 | ||||
-rw-r--r-- | compiler/main/HscMain.hs | 41 |
2 files changed, 24 insertions, 20 deletions
diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index f8f3ba9678..adec051596 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -333,6 +333,7 @@ import qualified Parser import Lexer import ApiAnnotation import qualified GHC.LanguageExtensions as LangExt +import Data.Set (Set) import System.Directory ( doesFileExist ) import Data.Maybe @@ -1412,7 +1413,7 @@ isModuleTrusted m = withSession $ \hsc_env -> liftIO $ hscCheckSafe hsc_env m noSrcSpan -- | Return if a module is trusted and the pkgs it depends on to be trusted. -moduleTrustReqs :: GhcMonad m => Module -> m (Bool, [InstalledUnitId]) +moduleTrustReqs :: GhcMonad m => Module -> m (Bool, Set InstalledUnitId) moduleTrustReqs m = withSession $ \hsc_env -> liftIO $ hscGetSafe hsc_env m noSrcSpan diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs index 6e6ac04e5e..839ecca8ee 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -137,7 +137,6 @@ import FamInstEnv import Fingerprint ( Fingerprint ) import Hooks import TcEnv -import Maybes import DynFlags import ErrUtils @@ -163,6 +162,8 @@ import System.FilePath as FilePath import System.Directory import System.IO (fixIO) import qualified Data.Map as Map +import qualified Data.Set as S +import Data.Set (Set) #include "HsVersions.h" @@ -906,15 +907,15 @@ checkSafeImports dflags tcg_env clearWarnings -- Check safe imports are correct - safePkgs <- mapM checkSafe safeImps + safePkgs <- S.fromList <$> mapMaybeM checkSafe safeImps safeErrs <- getWarnings clearWarnings -- Check non-safe imports are correct if inferring safety -- See the Note [Safe Haskell Inference] (infErrs, infPkgs) <- case (safeInferOn dflags) of - False -> return (emptyBag, []) - True -> do infPkgs <- mapM checkSafe regImps + False -> return (emptyBag, S.empty) + True -> do infPkgs <- S.fromList <$> mapMaybeM checkSafe regImps infErrs <- getWarnings clearWarnings return (infErrs, infPkgs) @@ -958,17 +959,19 @@ checkSafeImports dflags tcg_env = return v1 -- easier interface to work with + checkSafe :: (Module, SrcSpan, a) -> Hsc (Maybe InstalledUnitId) checkSafe (m, l, _) = fst `fmap` hscCheckSafe' dflags m l -- what pkg's to add to our trust requirements + pkgTrustReqs :: Set InstalledUnitId -> Set InstalledUnitId -> Bool -> ImportAvails pkgTrustReqs req inf infPassed | safeInferOn dflags && safeHaskell dflags == Sf_None && infPassed = emptyImportAvails { - imp_trust_pkgs = catMaybes req ++ catMaybes inf + imp_trust_pkgs = req `S.union` inf } pkgTrustReqs _ _ _ | safeHaskell dflags == Sf_Unsafe = emptyImportAvails - pkgTrustReqs req _ _ = emptyImportAvails { imp_trust_pkgs = catMaybes req } + pkgTrustReqs req _ _ = emptyImportAvails { imp_trust_pkgs = req } -- | Check that a module is safe to import. -- @@ -983,13 +986,13 @@ hscCheckSafe hsc_env m l = runHsc hsc_env $ do return $ isEmptyBag errs -- | Return if a module is trusted and the pkgs it depends on to be trusted. -hscGetSafe :: HscEnv -> Module -> SrcSpan -> IO (Bool, [InstalledUnitId]) +hscGetSafe :: HscEnv -> Module -> SrcSpan -> IO (Bool, Set InstalledUnitId) hscGetSafe hsc_env m l = runHsc hsc_env $ do dflags <- getDynFlags (self, pkgs) <- hscCheckSafe' dflags m l good <- isEmptyBag `fmap` getWarnings clearWarnings -- don't want them printed... - let pkgs' | Just p <- self = p:pkgs + let pkgs' | Just p <- self = S.insert p pkgs | otherwise = pkgs return (good, pkgs') @@ -997,7 +1000,7 @@ hscGetSafe hsc_env m l = runHsc hsc_env $ do -- Return (regardless of trusted or not) if the trust type requires the modules -- own package be trusted and a list of other packages required to be trusted -- (these later ones haven't been checked) but the own package trust has been. -hscCheckSafe' :: DynFlags -> Module -> SrcSpan -> Hsc (Maybe InstalledUnitId, [InstalledUnitId]) +hscCheckSafe' :: DynFlags -> Module -> SrcSpan -> Hsc (Maybe InstalledUnitId, Set InstalledUnitId) hscCheckSafe' dflags m l = do (tw, pkgs) <- isModSafe m l case tw of @@ -1007,7 +1010,7 @@ hscCheckSafe' dflags m l = do -- Not necessary if that is reflected in dependencies | otherwise -> return (Just $ toInstalledUnitId (moduleUnitId m), pkgs) where - isModSafe :: Module -> SrcSpan -> Hsc (Bool, [InstalledUnitId]) + isModSafe :: Module -> SrcSpan -> Hsc (Bool, Set InstalledUnitId) isModSafe m l = do iface <- lookup' m case iface of @@ -1025,7 +1028,7 @@ hscCheckSafe' dflags m l = do -- check package is trusted safeP = packageTrusted trust trust_own_pkg m -- pkg trust reqs - pkgRs = map fst $ filter snd $ dep_pkgs $ mi_deps iface' + pkgRs = S.fromList . map fst $ filter snd $ dep_pkgs $ mi_deps iface' -- General errors we throw but Safe errors we log errs = case (safeM, safeP) of (True, True ) -> emptyBag @@ -1083,20 +1086,20 @@ hscCheckSafe' dflags m l = do | otherwise = False -- | Check the list of packages are trusted. -checkPkgTrust :: DynFlags -> [InstalledUnitId] -> Hsc () +checkPkgTrust :: DynFlags -> Set InstalledUnitId -> Hsc () checkPkgTrust dflags pkgs = case errors of [] -> return () _ -> (liftIO . throwIO . mkSrcErr . listToBag) errors where - errors = catMaybes $ map go pkgs - go pkg + errors = S.foldr go [] pkgs + go pkg acc | trusted $ getInstalledPackageDetails dflags pkg - = Nothing + = acc | otherwise - = Just $ mkErrMsg dflags noSrcSpan (pkgQual dflags) - $ text "The package (" <> ppr pkg <> text ") is required" <> - text " to be trusted but it isn't!" + = (:acc) $ mkErrMsg dflags noSrcSpan (pkgQual dflags) + $ text "The package (" <> ppr pkg <> text ") is required" <> + text " to be trusted but it isn't!" -- | Set module to unsafe and (potentially) wipe trust information. -- @@ -1125,7 +1128,7 @@ markUnsafeInfer tcg_env whyUnsafe = do False -> return tcg_env where - wiped_trust = (tcg_imports tcg_env) { imp_trust_pkgs = [] } + wiped_trust = (tcg_imports tcg_env) { imp_trust_pkgs = S.empty } pprMod = ppr $ moduleName $ tcg_mod tcg_env whyUnsafe' df = vcat [ quotes pprMod <+> text "has been inferred as unsafe!" , text "Reason:" |