summaryrefslogtreecommitdiff
path: root/compiler/main
diff options
context:
space:
mode:
authorDavid Feuer <david.feuer@gmail.com>2017-03-02 13:45:27 -0500
committerBen Gamari <ben@smart-cactus.org>2017-03-02 14:57:30 -0500
commitae67619853d029ea8049a114f44e59f4ca10b990 (patch)
treefc4e241b74248f72ba5d9a9e438eb3bb2d84e734 /compiler/main
parent27a1b12f90b4b27763d22310215f0df34cbd702a (diff)
downloadhaskell-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.hs3
-rw-r--r--compiler/main/HscMain.hs41
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:"