summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorFendor <power.walross@gmail.com>2021-07-20 15:00:49 +0200
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-07-23 21:08:42 -0400
commit6c79981e646a9983e959ccbf67f6c11b86bdbc6f (patch)
tree1cc2dea0845c20331a5cf68b03eb211c0319554b
parent509445b5947ce85499672399f5e88b6196af4c5a (diff)
downloadhaskell-6c79981e646a9983e959ccbf67f6c11b86bdbc6f.tar.gz
Introduce FinderLocations for decoupling Finder from DynFlags
-rw-r--r--compiler/GHC.hs11
-rw-r--r--compiler/GHC/Driver/Backpack.hs7
-rw-r--r--compiler/GHC/Driver/CodeOutput.hs3
-rw-r--r--compiler/GHC/Driver/Config/Finder.hs26
-rw-r--r--compiler/GHC/Driver/Make.hs7
-rw-r--r--compiler/GHC/Driver/MakeFile.hs4
-rw-r--r--compiler/GHC/Driver/Pipeline/Monad.hs5
-rw-r--r--compiler/GHC/Iface/Load.hs7
-rw-r--r--compiler/GHC/Iface/Recomp.hs4
-rw-r--r--compiler/GHC/Linker/Loader.hs4
-rw-r--r--compiler/GHC/Runtime/Loader.hs4
-rw-r--r--compiler/GHC/Tc/Gen/Splice.hs4
-rw-r--r--compiler/GHC/Tc/Plugin.hs4
-rw-r--r--compiler/GHC/Tc/Utils/Backpack.hs8
-rw-r--r--compiler/GHC/Unit/Finder.hs190
-rw-r--r--compiler/ghc.cabal.in1
-rw-r--r--ghc/GHCi/UI.hs4
-rw-r--r--ghc/Main.hs4
-rw-r--r--testsuite/tests/count-deps/CountDepsAst.stdout3
-rw-r--r--testsuite/tests/count-deps/CountDepsParser.stdout3
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