diff options
| -rw-r--r-- | compiler/GHC.hs | 11 | ||||
| -rw-r--r-- | compiler/GHC/Driver/Backpack.hs | 7 | ||||
| -rw-r--r-- | compiler/GHC/Driver/CodeOutput.hs | 3 | ||||
| -rw-r--r-- | compiler/GHC/Driver/Config/Finder.hs | 26 | ||||
| -rw-r--r-- | compiler/GHC/Driver/Make.hs | 7 | ||||
| -rw-r--r-- | compiler/GHC/Driver/MakeFile.hs | 4 | ||||
| -rw-r--r-- | compiler/GHC/Driver/Pipeline/Monad.hs | 5 | ||||
| -rw-r--r-- | compiler/GHC/Iface/Load.hs | 7 | ||||
| -rw-r--r-- | compiler/GHC/Iface/Recomp.hs | 4 | ||||
| -rw-r--r-- | compiler/GHC/Linker/Loader.hs | 4 | ||||
| -rw-r--r-- | compiler/GHC/Runtime/Loader.hs | 4 | ||||
| -rw-r--r-- | compiler/GHC/Tc/Gen/Splice.hs | 4 | ||||
| -rw-r--r-- | compiler/GHC/Tc/Plugin.hs | 4 | ||||
| -rw-r--r-- | compiler/GHC/Tc/Utils/Backpack.hs | 8 | ||||
| -rw-r--r-- | compiler/GHC/Unit/Finder.hs | 190 | ||||
| -rw-r--r-- | compiler/ghc.cabal.in | 1 | ||||
| -rw-r--r-- | ghc/GHCi/UI.hs | 4 | ||||
| -rw-r--r-- | ghc/Main.hs | 4 | ||||
| -rw-r--r-- | testsuite/tests/count-deps/CountDepsAst.stdout | 3 | ||||
| -rw-r--r-- | testsuite/tests/count-deps/CountDepsParser.stdout | 3 |
20 files changed, 200 insertions, 103 deletions
diff --git a/compiler/GHC.hs b/compiler/GHC.hs index f419e21534..a95757b8fd 100644 --- a/compiler/GHC.hs +++ b/compiler/GHC.hs @@ -310,6 +310,7 @@ import GHC.Driver.Errors.Types import GHC.Driver.CmdLine import GHC.Driver.Session import GHC.Driver.Backend +import GHC.Driver.Config.Finder (initFinderOpts) import GHC.Driver.Config.Parser (initParserOpts) import GHC.Driver.Config.Logger (initLogFlags) import GHC.Driver.Config.Diagnostic @@ -1659,9 +1660,10 @@ findModule mod_name maybe_pkg = withSession $ \hsc_env -> do let home_unit = hsc_home_unit hsc_env let units = hsc_units hsc_env let dflags = hsc_dflags hsc_env + let fopts = initFinderOpts dflags case maybe_pkg of Just pkg | not (isHomeUnit home_unit (fsToUnit pkg)) && pkg /= fsLit "this" -> liftIO $ do - res <- findImportedModule fc units home_unit dflags mod_name maybe_pkg + res <- findImportedModule fc fopts units home_unit mod_name maybe_pkg case res of Found _ m -> return m err -> throwOneError $ noModError hsc_env noSrcSpan mod_name err @@ -1670,11 +1672,13 @@ findModule mod_name maybe_pkg = withSession $ \hsc_env -> do case home of Just m -> return m Nothing -> liftIO $ do - res <- findImportedModule fc units home_unit dflags mod_name maybe_pkg + res <- findImportedModule fc fopts units home_unit mod_name maybe_pkg case res of Found loc m | not (isHomeModule home_unit m) -> return m | otherwise -> modNotLoadedError dflags m loc err -> throwOneError $ noModError hsc_env noSrcSpan mod_name err + where + modNotLoadedError :: DynFlags -> Module -> ModLocation -> IO a modNotLoadedError dflags m loc = throwGhcExceptionIO $ CmdLineError $ showSDoc dflags $ @@ -1699,7 +1703,8 @@ lookupModule mod_name Nothing = withSession $ \hsc_env -> do let fc = hsc_FC hsc_env let units = hsc_units hsc_env let dflags = hsc_dflags hsc_env - res <- findExposedPackageModule fc units dflags mod_name Nothing + let fopts = initFinderOpts dflags + res <- findExposedPackageModule fc fopts units mod_name Nothing case res of Found _ m -> return m err -> throwOneError $ noModError hsc_env noSrcSpan mod_name err diff --git a/compiler/GHC/Driver/Backpack.hs b/compiler/GHC/Driver/Backpack.hs index 8581865dbf..8e7bbf49d5 100644 --- a/compiler/GHC/Driver/Backpack.hs +++ b/compiler/GHC/Driver/Backpack.hs @@ -21,6 +21,7 @@ import GHC.Prelude -- In a separate module because it hooks into the parser. import GHC.Driver.Backpack.Syntax +import GHC.Driver.Config.Finder (initFinderOpts) import GHC.Driver.Config.Parser (initParserOpts) import GHC.Driver.Config.Diagnostic import GHC.Driver.Monad @@ -742,9 +743,10 @@ summariseRequirement pn mod_name = do hsc_env <- getSession let dflags = hsc_dflags hsc_env let home_unit = hsc_home_unit hsc_env + let fopts = initFinderOpts dflags let PackageName pn_fs = pn - location <- liftIO $ mkHomeModLocation2 dflags mod_name + location <- liftIO $ mkHomeModLocation2 fopts mod_name (unpackFS pn_fs </> moduleNameSlashes mod_name) "hsig" env <- getBkpEnv @@ -828,13 +830,14 @@ hsModuleToModSummary pn hsc_src modname -- Use the PACKAGE NAME to find the location let PackageName unit_fs = pn dflags = hsc_dflags hsc_env + fopts = initFinderOpts dflags -- Unfortunately, we have to define a "fake" location in -- order to appease the various code which uses the file -- name to figure out where to put, e.g. object files. -- To add insult to injury, we don't even actually use -- these filenames to figure out where the hi files go. -- A travesty! - location0 <- liftIO $ mkHomeModLocation2 dflags modname + location0 <- liftIO $ mkHomeModLocation2 fopts modname (unpackFS unit_fs </> moduleNameSlashes modname) (case hsc_src of diff --git a/compiler/GHC/Driver/CodeOutput.hs b/compiler/GHC/Driver/CodeOutput.hs index 6108e529af..7382ec9a10 100644 --- a/compiler/GHC/Driver/CodeOutput.hs +++ b/compiler/GHC/Driver/CodeOutput.hs @@ -27,6 +27,7 @@ import GHC.Cmm ( RawCmmGroup ) import GHC.Cmm.CLabel import GHC.Driver.Session +import GHC.Driver.Config.Finder (initFinderOpts) import GHC.Driver.Config.CmmToAsm (initNCGConfig) import GHC.Driver.Ppr import GHC.Driver.Backend @@ -209,7 +210,7 @@ outputForeignStubs Maybe FilePath) -- C file created outputForeignStubs logger tmpfs dflags unit_state mod location stubs = do - let stub_h = mkStubPaths dflags (moduleName mod) location + let stub_h = mkStubPaths (initFinderOpts dflags) (moduleName mod) location stub_c <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "c" case stubs of diff --git a/compiler/GHC/Driver/Config/Finder.hs b/compiler/GHC/Driver/Config/Finder.hs new file mode 100644 index 0000000000..4fa4278c09 --- /dev/null +++ b/compiler/GHC/Driver/Config/Finder.hs @@ -0,0 +1,26 @@ +module GHC.Driver.Config.Finder ( + FinderOpts(..), + initFinderOpts + ) where + +import GHC.Prelude + +import GHC.Driver.Session +import GHC.Unit.Finder + +-- | Create a new 'FinderOpts' from DynFlags. +initFinderOpts :: DynFlags -> FinderOpts +initFinderOpts flags = FinderOpts + { finder_importPaths = importPaths flags + , finder_lookupHomeInterfaces = isOneShot (ghcMode flags) + , finder_bypassHiFileCheck = MkDepend == (ghcMode flags) + , finder_ways = ways flags + , finder_enableSuggestions = gopt Opt_HelpfulErrors flags + , finder_hieDir = hieDir flags + , finder_hieSuf = hieSuf flags + , finder_hiDir = hiDir flags + , finder_hiSuf = hiSuf flags + , finder_objectDir = objectDir flags + , finder_objectSuf = objectSuf flags + , finder_stubDir = stubDir flags + } diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs index 51fb469828..d40be12308 100644 --- a/compiler/GHC/Driver/Make.hs +++ b/compiler/GHC/Driver/Make.hs @@ -53,6 +53,7 @@ import GHC.Linker.Types import GHC.Runtime.Context +import GHC.Driver.Config.Finder (initFinderOpts) import GHC.Driver.Config.Logger (initLogFlags) import GHC.Driver.Config.Parser (initParserOpts) import GHC.Driver.Config.Diagnostic @@ -2311,9 +2312,10 @@ summariseFile hsc_env old_summaries src_fn mb_phase maybe_buf preimps@PreprocessedImports {..} <- getPreprocessedImports hsc_env src_fn mb_phase maybe_buf + let fopts = initFinderOpts (hsc_dflags hsc_env) -- Make a ModLocation for this file - location <- liftIO $ mkHomeModLocation (hsc_dflags hsc_env) pi_mod_name src_fn + location <- liftIO $ mkHomeModLocation fopts pi_mod_name src_fn -- Tell the Finder cache where it is, so that subsequent calls -- to findModule will find it, even if it's not on any search path @@ -2428,6 +2430,7 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) | otherwise = find_it where dflags = hsc_dflags hsc_env + fopts = initFinderOpts dflags home_unit = hsc_home_unit hsc_env fc = hsc_FC hsc_env units = hsc_units hsc_env @@ -2439,7 +2442,7 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) old_summary location find_it = do - found <- findImportedModule fc units home_unit dflags wanted_mod Nothing + found <- findImportedModule fc fopts units home_unit wanted_mod Nothing case found of Found location mod | isJust (ml_hs_file location) -> diff --git a/compiler/GHC/Driver/MakeFile.hs b/compiler/GHC/Driver/MakeFile.hs index 8207b37c7b..5719b7dc04 100644 --- a/compiler/GHC/Driver/MakeFile.hs +++ b/compiler/GHC/Driver/MakeFile.hs @@ -16,6 +16,7 @@ where import GHC.Prelude import qualified GHC +import GHC.Driver.Config.Finder import GHC.Driver.Monad import GHC.Driver.Session import GHC.Driver.Ppr @@ -291,9 +292,10 @@ findDependency hsc_env srcloc pkg imp is_boot include_pkg_deps = do let home_unit = hsc_home_unit hsc_env let units = hsc_units hsc_env let dflags = hsc_dflags hsc_env + let fopts = initFinderOpts dflags -- Find the module; this will be fast because -- we've done it once during downsweep - r <- findImportedModule fc units home_unit dflags imp pkg + r <- findImportedModule fc fopts units home_unit imp pkg case r of Found loc _ -- Home package: just depend on the .hi or hi-boot file diff --git a/compiler/GHC/Driver/Pipeline/Monad.hs b/compiler/GHC/Driver/Pipeline/Monad.hs index a760bb6022..f9067576ae 100644 --- a/compiler/GHC/Driver/Pipeline/Monad.hs +++ b/compiler/GHC/Driver/Pipeline/Monad.hs @@ -14,6 +14,7 @@ import GHC.Prelude import Control.Monad.IO.Class import qualified Data.Kind as K import GHC.Driver.Phases +import GHC.Driver.Config.Finder import GHC.Utils.TmpFs import GHC.Driver.Session import GHC.Types.SourceFile @@ -42,7 +43,7 @@ getLocation :: PipeEnv -> DynFlags -> HscSource -> ModuleName -> IO ModLocation getLocation pipe_env dflags src_flavour mod_name = do let PipeEnv{ src_basename=basename, src_suffix=suff } = pipe_env - location1 <- mkHomeModLocation2 dflags mod_name basename suff + location1 <- mkHomeModLocation2 fopts mod_name basename suff -- Boot-ify it if necessary let location2 @@ -69,6 +70,8 @@ getLocation pipe_env dflags src_flavour mod_name = do = location3 { ml_obj_file = ofile } | otherwise = location3 return location4 + where + fopts = initFinderOpts dflags data PipelineOutput = Temporary TempFileLifetime diff --git a/compiler/GHC/Iface/Load.hs b/compiler/GHC/Iface/Load.hs index f510e9bbda..157c26e49e 100644 --- a/compiler/GHC/Iface/Load.hs +++ b/compiler/GHC/Iface/Load.hs @@ -43,6 +43,7 @@ import {-# SOURCE #-} GHC.IfaceToCore ( tcIfaceDecls, tcIfaceRules, tcIfaceInst, tcIfaceFamInst , tcIfaceAnnotations, tcIfaceCompleteMatches ) +import GHC.Driver.Config.Finder import GHC.Driver.Env import GHC.Driver.Errors.Types import GHC.Driver.Session @@ -318,9 +319,10 @@ loadSrcInterface_maybe doc mod want_boot maybe_pkg = do hsc_env <- getTopEnv let fc = hsc_FC hsc_env let dflags = hsc_dflags hsc_env + let fopts = initFinderOpts dflags let units = hsc_units hsc_env let home_unit = hsc_home_unit hsc_env - res <- liftIO $ findImportedModule fc units home_unit dflags mod maybe_pkg + res <- liftIO $ findImportedModule fc fopts units home_unit mod maybe_pkg case res of Found _ mod -> initIfaceTcRn $ loadInterface doc mod (ImportByUser want_boot) -- TODO: Make sure this error message is good @@ -879,8 +881,9 @@ findAndReadIface logger name_cache fc hooks unit_state home_unit dflags doc_str Just h -> h return (Succeeded (iface, "<built in interface for GHC.Prim>")) else do + let fopts = initFinderOpts dflags -- Look for the file - mb_found <- liftIO (findExactModule fc dflags unit_state home_unit mod) + mb_found <- liftIO (findExactModule fc fopts unit_state home_unit mod) case mb_found of InstalledFound loc mod -> do -- Found file, so read it diff --git a/compiler/GHC/Iface/Recomp.hs b/compiler/GHC/Iface/Recomp.hs index 72341ba147..2e2824a7cb 100644 --- a/compiler/GHC/Iface/Recomp.hs +++ b/compiler/GHC/Iface/Recomp.hs @@ -13,6 +13,7 @@ where import GHC.Prelude import GHC.Driver.Backend +import GHC.Driver.Config.Finder import GHC.Driver.Env import GHC.Driver.Session import GHC.Driver.Ppr @@ -454,7 +455,7 @@ checkDependencies hsc_env summary iface = do res <- liftIO $ traverse (\(mb_pkg, L _ mod) -> let reason = moduleNameString mod ++ " changed" - in classify reason <$> findImportedModule fc units home_unit dflags mod (mb_pkg)) + in classify reason <$> findImportedModule fc fopts units home_unit mod (mb_pkg)) (ms_imps summary ++ ms_srcimps summary) case sequence (res ++ [Right (fake_ghc_prim_import)| ms_ghc_prim_import summary]) of Left recomp -> return recomp @@ -467,6 +468,7 @@ checkDependencies hsc_env summary iface return (res1 `mappend` res2) where dflags = hsc_dflags hsc_env + fopts = initFinderOpts dflags logger = hsc_logger hsc_env fc = hsc_FC hsc_env home_unit = hsc_home_unit hsc_env diff --git a/compiler/GHC/Linker/Loader.hs b/compiler/GHC/Linker/Loader.hs index c9617f1c28..2c2e724d68 100644 --- a/compiler/GHC/Linker/Loader.hs +++ b/compiler/GHC/Linker/Loader.hs @@ -46,6 +46,7 @@ import GHC.Driver.Session import GHC.Driver.Ppr import GHC.Driver.Config import GHC.Driver.Config.Diagnostic +import GHC.Driver.Config.Finder import GHC.Tc.Utils.Monad @@ -754,7 +755,8 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods let fc = hsc_FC hsc_env let home_unit = hsc_home_unit hsc_env let dflags = hsc_dflags hsc_env - mb_stuff <- findHomeModule fc home_unit dflags mod_name + let fopts = initFinderOpts dflags + mb_stuff <- findHomeModule fc fopts home_unit mod_name case mb_stuff of Found loc mod -> found loc mod _ -> no_obj mod_name diff --git a/compiler/GHC/Runtime/Loader.hs b/compiler/GHC/Runtime/Loader.hs index f64236350c..09f34b5e16 100644 --- a/compiler/GHC/Runtime/Loader.hs +++ b/compiler/GHC/Runtime/Loader.hs @@ -51,6 +51,7 @@ import GHC.Types.Name.Reader ( RdrName, ImportSpec(..), ImpDeclSpec(..) , greMangledName, mkRdrQual ) import GHC.Unit.Finder ( findPluginModule, FindResult(..) ) +import GHC.Driver.Config.Finder ( initFinderOpts ) import GHC.Unit.Module ( Module, ModuleName ) import GHC.Unit.Module.ModIface @@ -258,11 +259,12 @@ lookupRdrNameInModuleForPlugins :: HscEnv -> ModuleName -> RdrName -> IO (Maybe (Name, ModIface)) lookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do let dflags = hsc_dflags hsc_env + let fopts = initFinderOpts dflags let fc = hsc_FC hsc_env let units = hsc_units hsc_env let home_unit = hsc_home_unit hsc_env -- First find the unit the module resides in by searching exposed units and home modules - found_module <- findPluginModule fc units home_unit dflags mod_name + found_module <- findPluginModule fc fopts units home_unit mod_name case found_module of Found _ mod -> do -- Find the exports of the module diff --git a/compiler/GHC/Tc/Gen/Splice.hs b/compiler/GHC/Tc/Gen/Splice.hs index bcb77326e2..fcd1474afa 100644 --- a/compiler/GHC/Tc/Gen/Splice.hs +++ b/compiler/GHC/Tc/Gen/Splice.hs @@ -39,6 +39,7 @@ import GHC.Driver.Session import GHC.Driver.Env import GHC.Driver.Hooks import GHC.Driver.Config.Diagnostic +import GHC.Driver.Config.Finder import GHC.Hs @@ -1264,7 +1265,8 @@ instance TH.Quasi TcM where let fc = hsc_FC hsc_env let home_unit = hsc_home_unit hsc_env let dflags = hsc_dflags hsc_env - r <- liftIO $ findHomeModule fc home_unit dflags (mkModuleName plugin) + let fopts = initFinderOpts dflags + r <- liftIO $ findHomeModule fc fopts home_unit (mkModuleName plugin) let err = hang (text "addCorePlugin: invalid plugin module " <+> text (show plugin) diff --git a/compiler/GHC/Tc/Plugin.hs b/compiler/GHC/Tc/Plugin.hs index fd5d21751e..0674f69903 100644 --- a/compiler/GHC/Tc/Plugin.hs +++ b/compiler/GHC/Tc/Plugin.hs @@ -77,6 +77,7 @@ import GHC.Types.TyThing import GHC.Core.TyCon import GHC.Core.DataCon import GHC.Core.Class +import GHC.Driver.Config.Finder import GHC.Driver.Env import GHC.Utils.Outputable import GHC.Core.Type @@ -102,7 +103,8 @@ findImportedModule mod_name mb_pkg = do let home_unit = hsc_home_unit hsc_env let units = hsc_units hsc_env let dflags = hsc_dflags hsc_env - tcPluginIO $ Finder.findImportedModule fc units home_unit dflags mod_name mb_pkg + let fopts = initFinderOpts dflags + tcPluginIO $ Finder.findImportedModule fc fopts units home_unit mod_name mb_pkg lookupOrig :: Module -> OccName -> TcPluginM Name lookupOrig mod = unsafeTcPluginTcM . IfaceEnv.lookupOrig mod diff --git a/compiler/GHC/Tc/Utils/Backpack.hs b/compiler/GHC/Tc/Utils/Backpack.hs index ffaa882cf6..a2599c3a57 100644 --- a/compiler/GHC/Tc/Utils/Backpack.hs +++ b/compiler/GHC/Tc/Utils/Backpack.hs @@ -19,6 +19,8 @@ module GHC.Tc.Utils.Backpack ( import GHC.Prelude + +import GHC.Driver.Config.Finder import GHC.Driver.Env import GHC.Driver.Ppr import GHC.Driver.Session @@ -322,7 +324,7 @@ implicitRequirements' :: HscEnv implicitRequirements' hsc_env normal_imports = fmap concat $ forM normal_imports $ \(mb_pkg, L _ imp) -> do - found <- findImportedModule fc units home_unit dflags imp mb_pkg + found <- findImportedModule fc fopts units home_unit imp mb_pkg case found of Found _ mod | not (isHomeModule home_unit mod) -> return (uniqDSetToList (moduleFreeHoles mod)) @@ -332,6 +334,7 @@ implicitRequirements' hsc_env normal_imports home_unit = hsc_home_unit hsc_env units = hsc_units hsc_env dflags = hsc_dflags hsc_env + fopts = initFinderOpts dflags -- | Like @implicitRequirements'@, but returns either the module name, if it is -- a free hole, or the instantiated unit the imported module is from, so that @@ -347,10 +350,11 @@ implicitRequirementsShallow hsc_env normal_imports = go ([], []) normal_imports home_unit = hsc_home_unit hsc_env units = hsc_units hsc_env dflags = hsc_dflags hsc_env + fopts = initFinderOpts dflags go acc [] = pure acc go (accL, accR) ((mb_pkg, L _ imp):imports) = do - found <- findImportedModule fc units home_unit dflags imp mb_pkg + found <- findImportedModule fc fopts units home_unit imp mb_pkg let acc' = case found of Found _ mod | not (isHomeModule home_unit mod) -> case moduleUnit mod of diff --git a/compiler/GHC/Unit/Finder.hs b/compiler/GHC/Unit/Finder.hs index a99c4b68c0..f0ecfb2ba7 100644 --- a/compiler/GHC/Unit/Finder.hs +++ b/compiler/GHC/Unit/Finder.hs @@ -10,6 +10,7 @@ module GHC.Unit.Finder ( FindResult(..), InstalledFindResult(..), + FinderOpts(..), FinderCache, initFinderCache, flushFinderCaches, @@ -32,13 +33,10 @@ module GHC.Unit.Finder ( -- Hash cache lookupFileCache - ) where import GHC.Prelude -import GHC.Driver.Session - import GHC.Platform.Ways import GHC.Builtin.Names ( gHC_PRIM ) @@ -125,6 +123,38 @@ lookupFileCache (FinderCache _ ref) key = do -- ----------------------------------------------------------------------------- -- The three external entry points +-- | Locations and information the finder cares about. +-- +-- Should be taken from 'DynFlags' via 'initFinderOpts'. +data FinderOpts = FinderOpts + { finder_importPaths :: [FilePath] + -- ^ Where are we allowed to look for Modules and Source files + , finder_lookupHomeInterfaces :: Bool + -- ^ When looking up a home module: + -- + -- * 'True': search interface files (e.g. in '-c' mode) + -- * 'False': search source files (e.g. in '--make' mode) + + , finder_bypassHiFileCheck :: Bool + -- ^ Don't check that an imported interface file actually exists + -- if it can only be at one location. The interface will be reported + -- as `InstalledFound` even if the file doesn't exist, so this is + -- only useful in specific cases (e.g. to generate dependencies + -- with `ghc -M`) + , finder_ways :: Ways + , finder_enableSuggestions :: Bool + -- ^ If we encounter unknown modules, should we suggest modules + -- that have a similar name. + , finder_hieDir :: Maybe FilePath + , finder_hieSuf :: String + , finder_hiDir :: Maybe FilePath + , finder_hiSuf :: String + , finder_objectDir :: Maybe FilePath + , finder_objectSuf :: String + , finder_stubDir :: Maybe FilePath + } + + -- | Locate a module that was imported by the user. We have the -- module's name, and possibly a package name. Without a package -- name, this function will use the search path and the known exposed @@ -133,35 +163,35 @@ lookupFileCache (FinderCache _ ref) key = do findImportedModule :: FinderCache + -> FinderOpts -> UnitState -> HomeUnit - -> DynFlags -> ModuleName -> Maybe FastString -> IO FindResult -findImportedModule fc units home_unit dflags mod_name mb_pkg = +findImportedModule fc fopts units home_unit mod_name mb_pkg = case mb_pkg of Nothing -> unqual_import Just pkg | pkg == fsLit "this" -> home_import -- "this" is special | otherwise -> pkg_import where - home_import = findHomeModule fc home_unit dflags mod_name + home_import = findHomeModule fc fopts home_unit mod_name - pkg_import = findExposedPackageModule fc units dflags mod_name mb_pkg + pkg_import = findExposedPackageModule fc fopts units mod_name mb_pkg unqual_import = home_import `orIfNotFound` - findExposedPackageModule fc units dflags mod_name Nothing + findExposedPackageModule fc fopts units mod_name Nothing -- | Locate a plugin module requested by the user, for a compiler -- plugin. This consults the same set of exposed packages as -- 'findImportedModule', unless @-hide-all-plugin-packages@ or -- @-plugin-package@ are specified. -findPluginModule :: FinderCache -> UnitState -> HomeUnit -> DynFlags -> ModuleName -> IO FindResult -findPluginModule fc units home_unit dflags mod_name = - findHomeModule fc home_unit dflags mod_name +findPluginModule :: FinderCache -> FinderOpts -> UnitState -> HomeUnit -> ModuleName -> IO FindResult +findPluginModule fc fopts units home_unit mod_name = + findHomeModule fc fopts home_unit mod_name `orIfNotFound` - findExposedPluginPackageModule fc units dflags mod_name + findExposedPluginPackageModule fc fopts units mod_name -- | Locate a specific 'Module'. The purpose of this function is to -- create a 'ModLocation' for a given 'Module', that is to find out @@ -169,11 +199,11 @@ findPluginModule fc units home_unit dflags mod_name = -- reading the interface for a module mentioned by another interface, -- for example (a "system import"). -findExactModule :: FinderCache -> DynFlags -> UnitState -> HomeUnit -> InstalledModule -> IO InstalledFindResult -findExactModule fc dflags unit_state home_unit mod = do +findExactModule :: FinderCache -> FinderOpts -> UnitState -> HomeUnit -> InstalledModule -> IO InstalledFindResult +findExactModule fc fopts unit_state home_unit mod = do if isHomeInstalledModule home_unit mod - then findInstalledHomeModule fc dflags home_unit (moduleName mod) - else findPackageModule fc unit_state dflags mod + then findInstalledHomeModule fc fopts home_unit (moduleName mod) + else findPackageModule fc unit_state fopts mod -- ----------------------------------------------------------------------------- -- Helpers @@ -213,21 +243,21 @@ homeSearchCache fc home_unit mod_name do_this = do let mod = mkHomeInstalledModule home_unit mod_name modLocationCache fc mod do_this -findExposedPackageModule :: FinderCache -> UnitState -> DynFlags -> ModuleName -> Maybe FastString -> IO FindResult -findExposedPackageModule fc units dflags mod_name mb_pkg = - findLookupResult fc dflags +findExposedPackageModule :: FinderCache -> FinderOpts -> UnitState -> ModuleName -> Maybe FastString -> IO FindResult +findExposedPackageModule fc fopts units mod_name mb_pkg = + findLookupResult fc fopts $ lookupModuleWithSuggestions units mod_name mb_pkg -findExposedPluginPackageModule :: FinderCache -> UnitState -> DynFlags -> ModuleName -> IO FindResult -findExposedPluginPackageModule fc units dflags mod_name = - findLookupResult fc dflags +findExposedPluginPackageModule :: FinderCache -> FinderOpts -> UnitState -> ModuleName -> IO FindResult +findExposedPluginPackageModule fc fopts units mod_name = + findLookupResult fc fopts $ lookupPluginModuleWithSuggestions units mod_name Nothing -findLookupResult :: FinderCache -> DynFlags -> LookupResult -> IO FindResult -findLookupResult fc dflags r = case r of +findLookupResult :: FinderCache -> FinderOpts -> LookupResult -> IO FindResult +findLookupResult fc fopts r = case r of LookupFound m pkg_conf -> do let im = fst (getModuleInstantiation m) - r' <- findPackageModule_ fc dflags im (fst pkg_conf) + r' <- findPackageModule_ fc fopts im (fst pkg_conf) case r' of -- TODO: ghc -M is unlikely to do the right thing -- with just the location of the thing that was @@ -260,7 +290,7 @@ findLookupResult fc dflags r = case r of , fr_suggestions = [] }) LookupNotFound suggest -> do let suggest' - | gopt Opt_HelpfulErrors dflags = suggest + | finder_enableSuggestions fopts = suggest | otherwise = [] return (NotFound{ fr_paths = [], fr_pkg = Nothing , fr_pkgs_hidden = [] @@ -293,10 +323,10 @@ uncacheModule fc home_unit mod_name = do -- ----------------------------------------------------------------------------- -- The internal workers -findHomeModule :: FinderCache -> HomeUnit -> DynFlags -> ModuleName -> IO FindResult -findHomeModule fc home_unit dflags mod_name = do +findHomeModule :: FinderCache -> FinderOpts -> HomeUnit -> ModuleName -> IO FindResult +findHomeModule fc fopts home_unit mod_name = do let uid = homeUnitAsUnit home_unit - r <- findInstalledHomeModule fc dflags home_unit mod_name + r <- findInstalledHomeModule fc fopts home_unit mod_name return $ case r of InstalledFound loc _ -> Found loc (mkHomeModule home_unit mod_name) InstalledNoPackage _ -> NoPackage uid -- impossible @@ -325,32 +355,32 @@ findHomeModule fc home_unit dflags mod_name = do -- -- 4. Some special-case code in GHCi (ToDo: Figure out why that needs to -- call this.) -findInstalledHomeModule :: FinderCache -> DynFlags -> HomeUnit -> ModuleName -> IO InstalledFindResult -findInstalledHomeModule fc dflags home_unit mod_name = do +findInstalledHomeModule :: FinderCache -> FinderOpts -> HomeUnit -> ModuleName -> IO InstalledFindResult +findInstalledHomeModule fc fopts home_unit mod_name = do homeSearchCache fc home_unit mod_name $ let - home_path = importPaths dflags - hisuf = hiSuf dflags + home_path = finder_importPaths fopts + hisuf = finder_hiSuf fopts mod = mkHomeInstalledModule home_unit mod_name source_exts = - [ ("hs", mkHomeModLocationSearched dflags mod_name "hs") - , ("lhs", mkHomeModLocationSearched dflags mod_name "lhs") - , ("hsig", mkHomeModLocationSearched dflags mod_name "hsig") - , ("lhsig", mkHomeModLocationSearched dflags mod_name "lhsig") + [ ("hs", mkHomeModLocationSearched fopts mod_name "hs") + , ("lhs", mkHomeModLocationSearched fopts mod_name "lhs") + , ("hsig", mkHomeModLocationSearched fopts mod_name "hsig") + , ("lhsig", mkHomeModLocationSearched fopts mod_name "lhsig") ] -- we use mkHomeModHiOnlyLocation instead of mkHiOnlyModLocation so that -- when hiDir field is set in dflags, we know to look there (see #16500) - hi_exts = [ (hisuf, mkHomeModHiOnlyLocation dflags mod_name) - , (addBootSuffix hisuf, mkHomeModHiOnlyLocation dflags mod_name) + hi_exts = [ (hisuf, mkHomeModHiOnlyLocation fopts mod_name) + , (addBootSuffix hisuf, mkHomeModHiOnlyLocation fopts mod_name) ] -- In compilation manager modes, we look for source files in the home -- package because we can compile these automatically. In one-shot -- compilation mode we look for .hi and .hi-boot files only. - exts | isOneShot (ghcMode dflags) = hi_exts - | otherwise = source_exts + exts | finder_lookupHomeInterfaces fopts = hi_exts + | otherwise = source_exts in -- special case for GHC.Prim; we won't find it in the filesystem. @@ -362,12 +392,12 @@ findInstalledHomeModule fc dflags home_unit mod_name = do -- | Search for a module in external packages only. -findPackageModule :: FinderCache -> UnitState -> DynFlags -> InstalledModule -> IO InstalledFindResult -findPackageModule fc unit_state dflags mod = do +findPackageModule :: FinderCache -> UnitState -> FinderOpts -> InstalledModule -> IO InstalledFindResult +findPackageModule fc unit_state fopts mod = do let pkg_id = moduleUnit mod case lookupUnitId unit_state pkg_id of Nothing -> return (InstalledNoPackage pkg_id) - Just u -> findPackageModule_ fc dflags mod u + Just u -> findPackageModule_ fc fopts mod u -- | Look up the interface file associated with module @mod@. This function -- requires a few invariants to be upheld: (1) the 'Module' in question must @@ -376,8 +406,8 @@ findPackageModule fc unit_state dflags mod = do -- the 'UnitInfo' must be consistent with the unit id in the 'Module'. -- The redundancy is to avoid an extra lookup in the package state -- for the appropriate config. -findPackageModule_ :: FinderCache -> DynFlags -> InstalledModule -> UnitInfo -> IO InstalledFindResult -findPackageModule_ fc dflags mod pkg_conf = do +findPackageModule_ :: FinderCache -> FinderOpts -> InstalledModule -> UnitInfo -> IO InstalledFindResult +findPackageModule_ fc fopts mod pkg_conf = do massertPpr (moduleUnit mod == unitId pkg_conf) (ppr (moduleUnit mod) <+> ppr (unitId pkg_conf)) modLocationCache fc mod $ @@ -388,20 +418,20 @@ findPackageModule_ fc dflags mod pkg_conf = do else let - tag = waysBuildTag (ways dflags) + tag = waysBuildTag (finder_ways fopts) -- hi-suffix for packages depends on the build tag. package_hisuf | null tag = "hi" | otherwise = tag ++ "_hi" - mk_hi_loc = mkHiOnlyModLocation dflags package_hisuf + mk_hi_loc = mkHiOnlyModLocation fopts package_hisuf import_dirs = map ST.unpack $ unitImportDirs pkg_conf -- we never look for a .hi-boot file in an external package; -- .hi-boot files only make sense for the home package. in case import_dirs of - [one] | MkDepend <- ghcMode dflags -> do + [one] | finder_bypassHiFileCheck fopts -> do -- there's only one place that this .hi file can be, so -- don't bother looking for it. let basename = moduleNameSlashes (moduleName mod) @@ -443,10 +473,10 @@ searchPathExts paths mod exts = search to_search then do { loc <- mk_result; return (InstalledFound loc mod) } else search rest -mkHomeModLocationSearched :: DynFlags -> ModuleName -> FileExt +mkHomeModLocationSearched :: FinderOpts -> ModuleName -> FileExt -> FilePath -> BaseName -> IO ModLocation -mkHomeModLocationSearched dflags mod suff path basename = - mkHomeModLocation2 dflags mod (path </> basename) suff +mkHomeModLocationSearched fopts mod suff path basename = + mkHomeModLocation2 fopts mod (path </> basename) suff -- ----------------------------------------------------------------------------- -- Constructing a home module location @@ -481,43 +511,43 @@ mkHomeModLocationSearched dflags mod suff path basename = -- ext -- The filename extension of the source file (usually "hs" or "lhs"). -mkHomeModLocation :: DynFlags -> ModuleName -> FilePath -> IO ModLocation +mkHomeModLocation :: FinderOpts -> ModuleName -> FilePath -> IO ModLocation mkHomeModLocation dflags mod src_filename = do let (basename,extension) = splitExtension src_filename mkHomeModLocation2 dflags mod basename extension -mkHomeModLocation2 :: DynFlags +mkHomeModLocation2 :: FinderOpts -> ModuleName -> FilePath -- Of source module, without suffix -> String -- Suffix -> IO ModLocation -mkHomeModLocation2 dflags mod src_basename ext = do +mkHomeModLocation2 fopts mod src_basename ext = do let mod_basename = moduleNameSlashes mod - obj_fn = mkObjPath dflags src_basename mod_basename - hi_fn = mkHiPath dflags src_basename mod_basename - hie_fn = mkHiePath dflags src_basename mod_basename + obj_fn = mkObjPath fopts src_basename mod_basename + hi_fn = mkHiPath fopts src_basename mod_basename + hie_fn = mkHiePath fopts src_basename mod_basename return (ModLocation{ ml_hs_file = Just (src_basename <.> ext), ml_hi_file = hi_fn, ml_obj_file = obj_fn, ml_hie_file = hie_fn }) -mkHomeModHiOnlyLocation :: DynFlags +mkHomeModHiOnlyLocation :: FinderOpts -> ModuleName -> FilePath -> BaseName -> IO ModLocation -mkHomeModHiOnlyLocation dflags mod path basename = do - loc <- mkHomeModLocation2 dflags mod (path </> basename) "" +mkHomeModHiOnlyLocation fopts mod path basename = do + loc <- mkHomeModLocation2 fopts mod (path </> basename) "" return loc { ml_hs_file = Nothing } -mkHiOnlyModLocation :: DynFlags -> Suffix -> FilePath -> String +mkHiOnlyModLocation :: FinderOpts -> Suffix -> FilePath -> String -> IO ModLocation -mkHiOnlyModLocation dflags hisuf path basename +mkHiOnlyModLocation fopts hisuf path basename = do let full_basename = path </> basename - obj_fn = mkObjPath dflags full_basename basename - hie_fn = mkHiePath dflags full_basename basename + obj_fn = mkObjPath fopts full_basename basename + hie_fn = mkHiePath fopts full_basename basename return ModLocation{ ml_hs_file = Nothing, ml_hi_file = full_basename <.> hisuf, -- Remove the .hi-boot suffix from @@ -531,14 +561,14 @@ mkHiOnlyModLocation dflags hisuf path basename -- | Constructs the filename of a .o file for a given source file. -- Does /not/ check whether the .o file exists mkObjPath - :: DynFlags + :: FinderOpts -> FilePath -- the filename of the source file, minus the extension -> String -- the module name with dots replaced by slashes -> FilePath -mkObjPath dflags basename mod_basename = obj_basename <.> osuf +mkObjPath fopts basename mod_basename = obj_basename <.> osuf where - odir = objectDir dflags - osuf = objectSuf dflags + odir = finder_objectDir fopts + osuf = finder_objectSuf fopts obj_basename | Just dir <- odir = dir </> mod_basename | otherwise = basename @@ -547,14 +577,14 @@ mkObjPath dflags basename mod_basename = obj_basename <.> osuf -- | Constructs the filename of a .hi file for a given source file. -- Does /not/ check whether the .hi file exists mkHiPath - :: DynFlags + :: FinderOpts -> FilePath -- the filename of the source file, minus the extension -> String -- the module name with dots replaced by slashes -> FilePath -mkHiPath dflags basename mod_basename = hi_basename <.> hisuf +mkHiPath fopts basename mod_basename = hi_basename <.> hisuf where - hidir = hiDir dflags - hisuf = hiSuf dflags + hidir = finder_hiDir fopts + hisuf = finder_hiSuf fopts hi_basename | Just dir <- hidir = dir </> mod_basename | otherwise = basename @@ -562,14 +592,14 @@ mkHiPath dflags basename mod_basename = hi_basename <.> hisuf -- | Constructs the filename of a .hie file for a given source file. -- Does /not/ check whether the .hie file exists mkHiePath - :: DynFlags + :: FinderOpts -> FilePath -- the filename of the source file, minus the extension -> String -- the module name with dots replaced by slashes -> FilePath -mkHiePath dflags basename mod_basename = hie_basename <.> hiesuf +mkHiePath fopts basename mod_basename = hie_basename <.> hiesuf where - hiedir = hieDir dflags - hiesuf = hieSuf dflags + hiedir = finder_hieDir fopts + hiesuf = finder_hieSuf fopts hie_basename | Just dir <- hiedir = dir </> mod_basename | otherwise = basename @@ -583,14 +613,14 @@ mkHiePath dflags basename mod_basename = hie_basename <.> hiesuf -- from other available information, and they're only rarely needed. mkStubPaths - :: DynFlags + :: FinderOpts -> ModuleName -> ModLocation -> FilePath -mkStubPaths dflags mod location +mkStubPaths fopts mod location = let - stubdir = stubDir dflags + stubdir = finder_stubDir fopts mod_basename = moduleNameSlashes mod src_basename = dropExtension $ expectJust "mkStubPaths" diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index 1176aa9c89..55e37b1d60 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -391,6 +391,7 @@ Library GHC.Driver.Config GHC.Driver.Config.CmmToAsm GHC.Driver.Config.Diagnostic + GHC.Driver.Config.Finder GHC.Driver.Config.Logger GHC.Driver.Config.Parser GHC.Driver.Env diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs index f861c9b82a..d1e49dadd3 100644 --- a/ghc/GHCi/UI.hs +++ b/ghc/GHCi/UI.hs @@ -51,6 +51,7 @@ import GHC.Driver.Session as DynFlags import GHC.Driver.Ppr hiding (printForUser) import GHC.Utils.Error hiding (traceCmd) import GHC.Driver.Monad ( modifySession ) +import GHC.Driver.Config.Finder (initFinderOpts) import GHC.Driver.Config.Parser (initParserOpts) import GHC.Driver.Config.Diagnostic import qualified GHC @@ -2035,8 +2036,9 @@ addModule files = do let home_unit = hsc_home_unit hsc_env let units = hsc_units hsc_env let dflags = hsc_dflags hsc_env + let fopts = initFinderOpts dflags result <- liftIO $ - Finder.findImportedModule fc units home_unit dflags m (Just (fsLit "this")) + Finder.findImportedModule fc fopts units home_unit m (Just (fsLit "this")) case result of Found _ _ -> return True _ -> (liftIO $ putStrLn $ diff --git a/ghc/Main.hs b/ghc/Main.hs index ad975d1840..9c4c012247 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -29,6 +29,7 @@ import GHC.Driver.Pipeline ( oneShot, compileFile ) import GHC.Driver.MakeFile ( doMkDependHS ) import GHC.Driver.Backpack ( doBackpack ) import GHC.Driver.Plugins +import GHC.Driver.Config.Finder (initFinderOpts) import GHC.Driver.Config.Logger (initLogFlags) import GHC.Driver.Config.Diagnostic @@ -851,12 +852,13 @@ abiHash strs = do let home_unit = hsc_home_unit hsc_env let units = hsc_units hsc_env let dflags = hsc_dflags hsc_env + let fopts = initFinderOpts dflags liftIO $ do let find_it str = do let modname = mkModuleName str - r <- findImportedModule fc units home_unit dflags modname Nothing + r <- findImportedModule fc fopts units home_unit modname Nothing case r of Found _ m -> return m _error -> throwGhcException $ CmdLineError $ showSDoc dflags $ diff --git a/testsuite/tests/count-deps/CountDepsAst.stdout b/testsuite/tests/count-deps/CountDepsAst.stdout index e9ee86cf09..184f20d7d0 100644 --- a/testsuite/tests/count-deps/CountDepsAst.stdout +++ b/testsuite/tests/count-deps/CountDepsAst.stdout @@ -1,4 +1,4 @@ -Found 273 Language.Haskell.Syntax module dependencies +Found 274 Language.Haskell.Syntax module dependencies GHC.Builtin.Names GHC.Builtin.PrimOps GHC.Builtin.Types @@ -84,6 +84,7 @@ GHC.Data.TrieMap GHC.Driver.Backend GHC.Driver.CmdLine GHC.Driver.Config.Diagnostic +GHC.Driver.Config.Finder GHC.Driver.Config.Logger GHC.Driver.Env GHC.Driver.Env.Types diff --git a/testsuite/tests/count-deps/CountDepsParser.stdout b/testsuite/tests/count-deps/CountDepsParser.stdout index daaf8294a1..a2ef4064f5 100644 --- a/testsuite/tests/count-deps/CountDepsParser.stdout +++ b/testsuite/tests/count-deps/CountDepsParser.stdout @@ -1,4 +1,4 @@ -Found 279 GHC.Parser module dependencies +Found 280 GHC.Parser module dependencies GHC.Builtin.Names GHC.Builtin.PrimOps GHC.Builtin.Types @@ -85,6 +85,7 @@ GHC.Driver.Backend GHC.Driver.Backpack.Syntax GHC.Driver.CmdLine GHC.Driver.Config.Diagnostic +GHC.Driver.Config.Finder GHC.Driver.Config.Logger GHC.Driver.Env GHC.Driver.Env.Types |