diff options
| -rw-r--r-- | compiler/deSugar/DsUsage.hs | 8 | ||||
| -rw-r--r-- | compiler/deSugar/TmOracle.hs | 14 | ||||
| -rw-r--r-- | compiler/main/GHC.hs | 3 | ||||
| -rw-r--r-- | compiler/main/HscMain.hs | 41 | ||||
| -rw-r--r-- | compiler/rename/RnNames.hs | 8 | ||||
| -rw-r--r-- | compiler/typecheck/TcRnDriver.hs | 5 | ||||
| -rw-r--r-- | compiler/typecheck/TcRnTypes.hs | 13 | ||||
| -rw-r--r-- | compiler/utils/ListSetOps.hs | 6 | ||||
| -rw-r--r-- | ghc/GHCi/UI.hs | 13 |
9 files changed, 58 insertions, 53 deletions
diff --git a/compiler/deSugar/DsUsage.hs b/compiler/deSugar/DsUsage.hs index 8c4cf1205f..ec6fe81035 100644 --- a/compiler/deSugar/DsUsage.hs +++ b/compiler/deSugar/DsUsage.hs @@ -17,7 +17,6 @@ import Outputable import Util import UniqSet import UniqDFM -import ListSetOps import Fingerprint import Maybes @@ -25,6 +24,7 @@ import Data.List import Data.IORef import Data.Map (Map) import qualified Data.Map as Map +import qualified Data.Set as Set -- | Extract information from the rename and typecheck phases to produce -- a dependencies information for the module being compiled. @@ -46,14 +46,14 @@ mkDependencies -- on M.hi-boot, and hence that we should do the hi-boot consistency -- check.) - pkgs | th_used = insertList (toInstalledUnitId thUnitId) (imp_dep_pkgs imports) + pkgs | th_used = Set.insert (toInstalledUnitId thUnitId) (imp_dep_pkgs imports) | otherwise = imp_dep_pkgs imports -- Set the packages required to be Safe according to Safe Haskell. -- See Note [RnNames . Tracking Trust Transitively] - sorted_pkgs = sort pkgs + sorted_pkgs = sort (Set.toList pkgs) trust_pkgs = imp_trust_pkgs imports - dep_pkgs' = map (\x -> (x, x `elem` trust_pkgs)) sorted_pkgs + dep_pkgs' = map (\x -> (x, x `Set.member` trust_pkgs)) sorted_pkgs return Deps { dep_mods = dep_mods, dep_pkgs = dep_pkgs', diff --git a/compiler/deSugar/TmOracle.hs b/compiler/deSugar/TmOracle.hs index 64f20e2121..115c0a882f 100644 --- a/compiler/deSugar/TmOracle.hs +++ b/compiler/deSugar/TmOracle.hs @@ -32,7 +32,7 @@ import TcHsSyn import MonadUtils import Util -import qualified Data.Map as Map +import NameEnv {- %************************************************************************ @@ -43,7 +43,7 @@ import qualified Data.Map as Map -} -- | The type of substitutions. -type PmVarEnv = Map.Map Name PmExpr +type PmVarEnv = NameEnv PmExpr -- | The environment of the oracle contains -- 1. A Bool (are there any constraints we cannot handle? (PmExprOther)). @@ -80,7 +80,7 @@ varIn x e = case e of -- | Flatten the DAG (Could be improved in terms of performance.). flattenPmVarEnv :: PmVarEnv -> PmVarEnv -flattenPmVarEnv env = Map.map (exprDeepLookup env) env +flattenPmVarEnv env = mapNameEnv (exprDeepLookup env) env -- | The state of the term oracle (includes complex constraints that cannot -- progress unless we get more information). @@ -88,7 +88,7 @@ type TmState = ([ComplexEq], TmOracleEnv) -- | Initial state of the oracle. initialTmState :: TmState -initialTmState = ([], (False, Map.empty)) +initialTmState = ([], (False, emptyNameEnv)) -- | Solve a complex equality (top-level). solveOneEq :: TmState -> ComplexEq -> Maybe TmState @@ -140,7 +140,7 @@ extendSubstAndSolve x e (standby, (unhandled, env)) -- had some progress. Careful about performance: -- See Note [Representation of Term Equalities] in deSugar/Check.hs (changed, unchanged) = partitionWith (substComplexEq x e) standby - new_incr_state = (unchanged, (unhandled, Map.insert x e env)) + new_incr_state = (unchanged, (unhandled, extendNameEnv env x e)) -- | When we know that a variable is fresh, we do not actually have to -- check whether anything changes, we know that nothing does. Hence, @@ -149,7 +149,7 @@ extendSubstAndSolve x e (standby, (unhandled, env)) extendSubst :: Id -> PmExpr -> TmState -> TmState extendSubst y e (standby, (unhandled, env)) | isNotPmExprOther simpl_e - = (standby, (unhandled, Map.insert x simpl_e env)) + = (standby, (unhandled, extendNameEnv env x simpl_e)) | otherwise = (standby, (True, env)) where x = idName y @@ -219,7 +219,7 @@ applySubstComplexEq env (e1,e2) = (exprDeepLookup env e1, exprDeepLookup env e2) -- | Apply an (un-flattened) substitution to a variable. varDeepLookup :: PmVarEnv -> Name -> PmExpr varDeepLookup env x - | Just e <- Map.lookup x env = exprDeepLookup env e -- go deeper + | Just e <- lookupNameEnv env x = exprDeepLookup env e -- go deeper | otherwise = PmExprVar x -- terminal {-# INLINE varDeepLookup #-} 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:" diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs index dc9cdd9063..87e041c659 100644 --- a/compiler/rename/RnNames.hs +++ b/compiler/rename/RnNames.hs @@ -55,8 +55,10 @@ import Data.Map ( Map ) import qualified Data.Map as Map import Data.Ord ( comparing ) import Data.List ( partition, (\\), find, sortBy ) +import qualified Data.Set as S -- import qualified Data.Set as Set import System.FilePath ((</>)) + import System.IO {- @@ -397,15 +399,15 @@ calculateAvails dflags iface mod_safe' want_boot = imp_orphs = orphans, imp_finsts = finsts, imp_dep_mods = mkModDeps dependent_mods, - imp_dep_pkgs = map fst $ dependent_pkgs, + imp_dep_pkgs = S.fromList . map fst $ dependent_pkgs, -- Add in the imported modules trusted package -- requirements. ONLY do this though if we import the -- module as a safe import. -- See Note [Tracking Trust Transitively] -- and Note [Trust Transitive Property] imp_trust_pkgs = if mod_safe' - then map fst $ filter snd dependent_pkgs - else [], + then S.fromList . map fst $ filter snd dependent_pkgs + else S.empty, -- Do we require our own pkg to be trusted? -- See Note [Trust Own Package] imp_trust_own_pkg = pkg_trust_req diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs index d4a83f13de..fe0e908c47 100644 --- a/compiler/typecheck/TcRnDriver.hs +++ b/compiler/typecheck/TcRnDriver.hs @@ -124,8 +124,9 @@ import Util import Bag import Inst (tcGetInsts) import qualified GHC.LanguageExtensions as LangExt -import HsDumpAst import Data.Data ( Data ) +import HsDumpAst +import qualified Data.Set as S import Control.Monad @@ -2489,7 +2490,7 @@ pprTcGblEnv (TcGblEnv { tcg_type_env = type_env, , text "Dependent modules:" <+> pprUDFM (imp_dep_mods imports) ppr , text "Dependent packages:" <+> - ppr (sortBy compare $ imp_dep_pkgs imports)] + ppr (S.toList $ imp_dep_pkgs imports)] where -- The use of sortBy is just to reduce unnecessary -- wobbling in testsuite output diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs index 67eb982b91..8e526bc5b3 100644 --- a/compiler/typecheck/TcRnTypes.hs +++ b/compiler/typecheck/TcRnTypes.hs @@ -181,6 +181,7 @@ import Control.Monad (ap, liftM, msum) import qualified Control.Monad.Fail as MonadFail #endif import Data.Set ( Set ) +import qualified Data.Set as S import Data.Map ( Map ) import Data.Dynamic ( Dynamic ) @@ -1229,12 +1230,12 @@ data ImportAvails -- compiling M might not need to consult X.hi, but X -- is still listed in M's dependencies. - imp_dep_pkgs :: [InstalledUnitId], + imp_dep_pkgs :: Set InstalledUnitId, -- ^ Packages needed by the module being compiled, whether directly, -- or via other modules in this package, or via modules imported -- from other packages. - imp_trust_pkgs :: [InstalledUnitId], + imp_trust_pkgs :: Set InstalledUnitId, -- ^ This is strictly a subset of imp_dep_pkgs and records the -- packages the current module needs to trust for Safe Haskell -- compilation to succeed. A package is required to be trusted if @@ -1269,8 +1270,8 @@ mkModDeps deps = foldl add emptyUDFM deps emptyImportAvails :: ImportAvails emptyImportAvails = ImportAvails { imp_mods = emptyModuleEnv, imp_dep_mods = emptyUDFM, - imp_dep_pkgs = [], - imp_trust_pkgs = [], + imp_dep_pkgs = S.empty, + imp_trust_pkgs = S.empty, imp_trust_own_pkg = False, imp_orphs = [], imp_finsts = [] } @@ -1292,8 +1293,8 @@ plusImportAvails imp_orphs = orphs2, imp_finsts = finsts2 }) = ImportAvails { imp_mods = plusModuleEnv_C (++) mods1 mods2, imp_dep_mods = plusUDFM_C plus_mod_dep dmods1 dmods2, - imp_dep_pkgs = dpkgs1 `unionLists` dpkgs2, - imp_trust_pkgs = tpkgs1 `unionLists` tpkgs2, + imp_dep_pkgs = dpkgs1 `S.union` dpkgs2, + imp_trust_pkgs = tpkgs1 `S.union` tpkgs2, imp_trust_own_pkg = tself1 || tself2, imp_orphs = orphs1 `unionLists` orphs2, imp_finsts = finsts1 `unionLists` finsts2 } diff --git a/compiler/utils/ListSetOps.hs b/compiler/utils/ListSetOps.hs index 4113566001..eaa79bd7fb 100644 --- a/compiler/utils/ListSetOps.hs +++ b/compiler/utils/ListSetOps.hs @@ -8,7 +8,7 @@ {-# LANGUAGE CPP #-} module ListSetOps ( - unionLists, minusList, insertList, + unionLists, minusList, -- Association lists Assoc, assoc, assocMaybe, assocUsing, assocDefault, assocDefaultUsing, @@ -41,10 +41,6 @@ getNth xs n = ASSERT2( xs `lengthExceeds` n, ppr n $$ ppr xs ) ************************************************************************ -} -insertList :: Eq a => a -> [a] -> [a] --- Assumes the arg list contains no dups; guarantees the result has no dups -insertList x xs | isIn "insert" x xs = xs - | otherwise = x : xs unionLists :: (Outputable a, Eq a) => [a] -> [a] -> [a] -- Assumes that the arguments contain no duplicates diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs index 97f47397fe..6310e3ce32 100644 --- a/ghc/GHCi/UI.hs +++ b/ghc/GHCi/UI.hs @@ -96,6 +96,7 @@ import Data.Function import Data.IORef ( IORef, modifyIORef, newIORef, readIORef, writeIORef ) import Data.List ( find, group, intercalate, intersperse, isPrefixOf, nub, partition, sort, sortBy ) +import qualified Data.Set as S import Data.Maybe import qualified Data.Map as M import Data.Time.LocalTime ( getZonedTime ) @@ -2042,15 +2043,15 @@ isSafeModule m = do -- print info to user... liftIO $ putStrLn $ "Trust type is (Module: " ++ trust ++ ", Package: " ++ pkg ++ ")" liftIO $ putStrLn $ "Package Trust: " ++ (if packageTrustOn dflags then "On" else "Off") - when (not $ null good) + when (not $ S.null good) (liftIO $ putStrLn $ "Trusted package dependencies (trusted): " ++ - (intercalate ", " $ map (showPpr dflags) good)) - case msafe && null bad of + (intercalate ", " $ map (showPpr dflags) (S.toList good))) + case msafe && S.null bad of True -> liftIO $ putStrLn $ mname ++ " is trusted!" False -> do when (not $ null bad) (liftIO $ putStrLn $ "Trusted package dependencies (untrusted): " - ++ (intercalate ", " $ map (showPpr dflags) bad)) + ++ (intercalate ", " $ map (showPpr dflags) (S.toList bad))) liftIO $ putStrLn $ mname ++ " is NOT trusted!" where @@ -2060,8 +2061,8 @@ isSafeModule m = do | thisPackage dflags == moduleUnitId md = True | otherwise = trusted $ getPackageDetails dflags (moduleUnitId md) - tallyPkgs dflags deps | not (packageTrustOn dflags) = ([], []) - | otherwise = partition part deps + tallyPkgs dflags deps | not (packageTrustOn dflags) = (S.empty, S.empty) + | otherwise = S.partition part deps where part pkg = trusted $ getInstalledPackageDetails dflags pkg ----------------------------------------------------------------------------- |