Eliminate ListSetOps from imp_trust_pkgs
authorDavid Feuer <david.feuer@gmail.com>
Thu, 2 Mar 2017 18:45:27 +0000 (13:45 -0500)
committerBen Gamari <ben@smart-cactus.org>
Thu, 2 Mar 2017 19:57:30 +0000 (14:57 -0500)
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

compiler/deSugar/DsUsage.hs
compiler/deSugar/TmOracle.hs
compiler/main/GHC.hs
compiler/main/HscMain.hs
compiler/rename/RnNames.hs
compiler/typecheck/TcRnDriver.hs
compiler/typecheck/TcRnTypes.hs
compiler/utils/ListSetOps.hs
ghc/GHCi/UI.hs

index 8c4cf12..ec6fe81 100644 (file)
@@ -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',
index 64f20e2..115c0a8 100644 (file)
@@ -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 #-}
 
index f8f3ba9..adec051 100644 (file)
@@ -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
 
index 6e6ac04..839ecca 100644 (file)
@@ -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:"
index dc9cdd9..87e041c 100644 (file)
@@ -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
index d4a83f1..fe0e908 100644 (file)
@@ -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
 
index 67eb982..8e526bc 100644 (file)
@@ -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 }
index 4113566..eaa79bd 100644 (file)
@@ -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
index 97f4739..6310e3c 100644 (file)
@@ -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
 
 -----------------------------------------------------------------------------