[Git][ghc/ghc][master] Extend -reexported-module flag to support module renaming
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Wed Aug 14 18:28:04 UTC 2024
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
ee0a9c18 by Matthew Pickering at 2024-08-14T14:27:39-04:00
Extend -reexported-module flag to support module renaming
The -reexported-module flag now supports renaming -rexported-modules.
```
-rexported-module "A as B"
```
This feature is only relevant to multi-component sessions.
Fixes #25139
- - - - -
19 changed files:
- compiler/GHC/Driver/Config/Finder.hs
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/Driver/Errors/Types.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Unit/Finder.hs
- compiler/GHC/Unit/Finder/Types.hs
- docs/users_guide/using.rst
- testsuite/tests/driver/multipleHomeUnits/all.T
- + testsuite/tests/driver/multipleHomeUnits/t25139/u1
- + testsuite/tests/driver/multipleHomeUnits/t25139/u1src/A.hs
- + testsuite/tests/driver/multipleHomeUnits/t25139/u1src/A1.hs
- + testsuite/tests/driver/multipleHomeUnits/t25139/u1src/A2.hs
- + testsuite/tests/driver/multipleHomeUnits/t25139/u2
- + testsuite/tests/driver/multipleHomeUnits/t25139/u2src/U.hs
- + testsuite/tests/driver/multipleHomeUnits/t25139/u3
- + testsuite/tests/driver/multipleHomeUnits/t25139/u3src/C.hs
- + testsuite/tests/driver/multipleHomeUnits/t25139/u4
- + testsuite/tests/driver/multipleHomeUnits/t25139/u4src/U4.hs
Changes:
=====================================
compiler/GHC/Driver/Config/Finder.hs
=====================================
@@ -9,6 +9,7 @@ import GHC.Driver.DynFlags
import GHC.Unit.Finder.Types
import GHC.Data.FastString
import GHC.Data.OsPath
+import qualified Data.Map as Map
-- | Create a new 'FinderOpts' from DynFlags.
initFinderOpts :: DynFlags -> FinderOpts
@@ -21,7 +22,7 @@ initFinderOpts flags = FinderOpts
, finder_workingDirectory = fmap unsafeEncodeUtf $ workingDirectory flags
, finder_thisPackageName = mkFastString <$> thisPackageName flags
, finder_hiddenModules = hiddenModules flags
- , finder_reexportedModules = reexportedModules flags
+ , finder_reexportedModules = Map.fromList [(known_as, is_as) | ReexportedModule is_as known_as <- reverse (reexportedModules flags)]
, finder_hieDir = fmap unsafeEncodeUtf $ hieDir flags
, finder_hieSuf = unsafeEncodeUtf $ hieSuf flags
, finder_hiDir = fmap unsafeEncodeUtf $ hiDir flags
=====================================
compiler/GHC/Driver/DynFlags.hs
=====================================
@@ -42,6 +42,8 @@ module GHC.Driver.DynFlags (
targetProfile,
+ ReexportedModule(..),
+
-- ** Manipulating DynFlags
defaultDynFlags, -- Settings -> DynFlags
initDynFlags, -- DynFlags -> IO DynFlags
@@ -250,7 +252,7 @@ data DynFlags = DynFlags {
workingDirectory :: Maybe FilePath,
thisPackageName :: Maybe String, -- ^ What the package is called, use with multiple home units
hiddenModules :: Set.Set ModuleName,
- reexportedModules :: Set.Set ModuleName,
+ reexportedModules :: [ReexportedModule],
-- ways
targetWays_ :: Ways, -- ^ Target way flags from the command line
@@ -578,7 +580,7 @@ defaultDynFlags mySettings =
workingDirectory = Nothing,
thisPackageName = Nothing,
hiddenModules = Set.empty,
- reexportedModules = Set.empty,
+ reexportedModules = [],
objectDir = Nothing,
dylibInstallName = Nothing,
@@ -958,6 +960,17 @@ flattenIncludes specs =
includePathsQuoteImplicit specs ++
includePathsGlobal specs
+
+-- An argument to --reexported-module which can optionally specify a module renaming.
+data ReexportedModule = ReexportedModule { reexportFrom :: ModuleName
+ , reexportTo :: ModuleName
+ }
+
+instance Outputable ReexportedModule where
+ ppr (ReexportedModule from to) =
+ if from == to then ppr from
+ else ppr from <+> text "as" <+> ppr to
+
{- Note [Implicit include paths]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The compile driver adds the path to the folder containing the source file being
=====================================
compiler/GHC/Driver/Errors/Types.hs
=====================================
@@ -24,7 +24,7 @@ import GHC.Prelude
import Data.Bifunctor
import Data.Typeable
-import GHC.Driver.DynFlags (DynFlags, PackageArg, gopt)
+import GHC.Driver.DynFlags (DynFlags, PackageArg, gopt, ReexportedModule)
import GHC.Driver.Flags (GeneralFlag (Opt_BuildingCabalPackage))
import GHC.Types.Error
import GHC.Unit.Module
@@ -152,7 +152,7 @@ data DriverMessage where
{-| DriverUnknown is a warning that arises when a user tries to
reexport a module which isn't part of that unit.
-}
- DriverUnknownReexportedModules :: UnitId -> [ModuleName] -> DriverMessage
+ DriverUnknownReexportedModules :: UnitId -> [ReexportedModule] -> DriverMessage
{-| DriverUnknownHiddenModules is a warning that arises when a user tries to
hide a module which isn't part of that unit.
=====================================
compiler/GHC/Driver/Make.hs
=====================================
@@ -58,6 +58,7 @@ import GHC.Driver.Config.Diagnostic
import GHC.Driver.Phases
import GHC.Driver.Pipeline
import GHC.Driver.Session
+import GHC.Driver.DynFlags (ReexportedModule(..))
import GHC.Driver.Backend
import GHC.Driver.Monad
import GHC.Driver.Env
@@ -365,7 +366,7 @@ warnMissingHomeModules dflags targets mod_graph =
-- Check that any modules we want to reexport or hide are actually in the package.
warnUnknownModules :: HscEnv -> DynFlags -> ModuleGraph -> IO DriverMessages
warnUnknownModules hsc_env dflags mod_graph = do
- reexported_warns <- filterM check_reexport (Set.toList reexported_mods)
+ reexported_warns <- filterM check_reexport reexported_mods
return $ final_msgs hidden_warns reexported_warns
where
diag_opts = initDiagOpts dflags
@@ -382,7 +383,7 @@ warnUnknownModules hsc_env dflags mod_graph = do
lookupModule mn = findImportedModule hsc_env mn NoPkgQual
check_reexport mn = do
- fr <- lookupModule mn
+ fr <- lookupModule (reexportFrom mn)
case fr of
Found _ m -> return (moduleUnitId m == homeUnitId_ dflags)
_ -> return True
@@ -2217,9 +2218,9 @@ summariseModule hsc_env' home_unit old_summary_map is_boot (L _ wanted_mod) mb_p
| isHaskellSigFilename src_fn = HsigFile
| otherwise = HsSrcFile
- when (pi_mod_name /= wanted_mod) $
+ when (pi_mod_name /= moduleName mod) $
throwE $ singleMessage $ mkPlainErrorMsgEnvelope pi_mod_name_loc
- $ DriverFileModuleNameMismatch pi_mod_name wanted_mod
+ $ DriverFileModuleNameMismatch pi_mod_name (moduleName mod)
let instantiations = homeUnitInstantiations home_unit
when (hsc_src == HsigFile && isNothing (lookup pi_mod_name instantiations)) $
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -3088,7 +3088,24 @@ addHiddenModule p =
addReexportedModule :: String -> DynP ()
addReexportedModule p =
- upd (\s -> s{ reexportedModules = Set.insert (mkModuleName p) (reexportedModules s) })
+ upd (\s -> s{ reexportedModules = (parseReexportedModule p) : (reexportedModules s) })
+
+parseReexportedModule :: String -- string to parse
+ -> ReexportedModule
+parseReexportedModule str
+ = case filter ((=="").snd) (readP_to_S parseItem str) of
+ [(r, "")] -> r
+ _ -> throwGhcException $ CmdLineError ("Can't parse reexported module flag: " ++ str)
+ where
+ parseItem = do
+ orig <- tok $ parseModuleName
+ (do _ <- tok $ string "as"
+ new <- tok $ parseModuleName
+ return (ReexportedModule orig new))
+ +++
+ return (ReexportedModule orig orig)
+
+ tok m = m >>= \x -> skipSpaces >> return x
-- If we're linking a binary, then only backends that produce object
=====================================
compiler/GHC/Unit/Finder.hs
=====================================
@@ -165,8 +165,8 @@ findImportedModuleNoHsc fc fopts ue mhome_unit mod_name mb_pkg =
home_pkg_import (uid, opts)
-- If the module is reexported, then look for it as if it was from the perspective
-- of that package which reexports it.
- | mod_name `Set.member` finder_reexportedModules opts =
- findImportedModuleNoHsc fc opts ue (Just $ DefiniteHomeUnit uid Nothing) mod_name NoPkgQual
+ | Just real_mod_name <- mod_name `M.lookup` finder_reexportedModules opts =
+ findImportedModuleNoHsc fc opts ue (Just $ DefiniteHomeUnit uid Nothing) real_mod_name NoPkgQual
| mod_name `Set.member` finder_hiddenModules opts =
return (mkHomeHidden uid)
| otherwise =
=====================================
compiler/GHC/Unit/Finder/Types.hs
=====================================
@@ -102,7 +102,7 @@ data FinderOpts = FinderOpts
, finder_workingDirectory :: Maybe OsPath
, finder_thisPackageName :: Maybe FastString
, finder_hiddenModules :: Set.Set ModuleName
- , finder_reexportedModules :: Set.Set ModuleName
+ , finder_reexportedModules :: M.Map ModuleName ModuleName -- Reverse mapping, if you are looking for this name then look for this module.
, finder_hieDir :: Maybe OsPath
, finder_hieSuf :: OsString
, finder_hiDir :: Maybe OsPath
@@ -112,4 +112,4 @@ data FinderOpts = FinderOpts
, finder_objectSuf :: OsString
, finder_dynObjectSuf :: OsString
, finder_stubDir :: Maybe OsPath
- } deriving Show
+ }
=====================================
docs/users_guide/using.rst
=====================================
@@ -896,7 +896,7 @@ units easier.
The main use of this flag is to be able to recreate the difference between
an exposed and hidden module for installed packages.
-.. ghc-flag:: -reexported-module ⟨module name⟩
+.. ghc-flag:: -reexported-module ⟨reexport-spec⟩
:shortdesc: A module which should be reexported from this unit.
:type: dynamic
:category:
@@ -905,6 +905,16 @@ units easier.
are not defined in a unit but should be reexported. The effect is that other
units will see this module as if it was defined in this unit.
+ The simple form of the flag allows the reexport of a single module at the
+ same name::
+
+ -reexported-module A
+
+ the complicated version of the flag allows the module to be renamed when
+ reexported::
+
+ -reexported-module "A as B"
+
The use of this flag is to be able to replicate the reexported modules
feature of packages with multiple home units.
=====================================
testsuite/tests/driver/multipleHomeUnits/all.T
=====================================
@@ -70,6 +70,7 @@ test('multipleHomeUnits_recomp_th', [filter_stdout_lines(r'.*Compiling.*'), copy
test('multipleHomeUnits_shared', [extra_files([ 'A.hs', 'unitShared1', 'unitShared2'])], multiunit_compile, [['unitShared1', 'unitShared2'], '-fhide-source-paths'])
test('multipleHomeUnits_shared_ghci', [extra_files([ 'shared.script', 'A.hs', 'unitShared1', 'unitShared2']), extra_run_opts('-unit @unitShared1 -unit @unitShared2')], ghci_script, ['shared.script'])
+test('t25139', [extra_files(['t25139/'])], multiunit_compile, [['t25139/u1', 't25139/u2', 't25139/u3', 't25139/u4'], '-v0'])
test('T25122',
[ extra_files(
=====================================
testsuite/tests/driver/multipleHomeUnits/t25139/u1
=====================================
@@ -0,0 +1,6 @@
+A A2
+-this-unit-id u1
+-working-dir t25139
+-i
+-iu1src
+
=====================================
testsuite/tests/driver/multipleHomeUnits/t25139/u1src/A.hs
=====================================
@@ -0,0 +1,3 @@
+module A where
+
+a = 2
=====================================
testsuite/tests/driver/multipleHomeUnits/t25139/u1src/A1.hs
=====================================
@@ -0,0 +1,3 @@
+module A1 where
+
+a1 = "a1"
=====================================
testsuite/tests/driver/multipleHomeUnits/t25139/u1src/A2.hs
=====================================
@@ -0,0 +1,3 @@
+module A2 where
+
+a2 = "a2"
=====================================
testsuite/tests/driver/multipleHomeUnits/t25139/u2
=====================================
@@ -0,0 +1,12 @@
+U
+-package-id u1
+-reexported-module "A as B"
+-reexported-module "A1 as B1"
+-reexported-module "A2 as B2"
+-reexported-module "A2 as B3"
+-reexported-module "A1 as B4"
+-reexported-module "A2 as B4"
+-this-unit-id u2
+-working-dir t25139
+-i
+-iu2src
=====================================
testsuite/tests/driver/multipleHomeUnits/t25139/u2src/U.hs
=====================================
@@ -0,0 +1,3 @@
+module U where
+
+u = 1
=====================================
testsuite/tests/driver/multipleHomeUnits/t25139/u3
=====================================
@@ -0,0 +1,7 @@
+C
+-package-id u2
+-this-unit-id u3
+-working-dir t25139
+-reexported-module "B as E"
+-i
+-iu3src
=====================================
testsuite/tests/driver/multipleHomeUnits/t25139/u3src/C.hs
=====================================
@@ -0,0 +1,11 @@
+module C where
+
+import B
+import B1
+import B2
+import B3
+import qualified B4 as B4
+
+c = a
+
+im = B4.a2
=====================================
testsuite/tests/driver/multipleHomeUnits/t25139/u4
=====================================
@@ -0,0 +1,8 @@
+U4
+-package-id u2
+-package-id u3
+-this-unit-id u4
+-working-dir t25139
+-i
+-iu4src
+
=====================================
testsuite/tests/driver/multipleHomeUnits/t25139/u4src/U4.hs
=====================================
@@ -0,0 +1,6 @@
+module U4 where
+
+import B
+import E
+
+u4 = a
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ee0a9c18f537e4a02fa12999199fefc89b606402
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ee0a9c18f537e4a02fa12999199fefc89b606402
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240814/7e108c93/attachment-0001.html>
More information about the ghc-commits
mailing list