Commit 7c748d9f authored by Edward Z. Yang's avatar Edward Z. Yang

Support for "with" renaming syntax, and output a feature flag.

Summary:
- Feature flag indicates to Cabal that we support thinning and renaming as
  it needs.

- Support -package "base with (Foo as Bar)" which brings the ordinary
  modules into scope, as well as adding the renamings to scope.
Signed-off-by: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>

Test Plan: validate

Reviewers: simonpj, austin

Subscribers: thomie, carter

Differential Revision: https://phabricator.haskell.org/D485
parent 1019e3c6
......@@ -43,7 +43,7 @@ module DynFlags (
targetRetainsAllBindings,
GhcMode(..), isOneShot,
GhcLink(..), isNoLink,
PackageFlag(..), PackageArg(..), ModRenaming,
PackageFlag(..), PackageArg(..), ModRenaming(..),
PkgConfRef(..),
Option(..), showOpt,
DynLibLoader(..),
......@@ -1059,7 +1059,8 @@ data PackageArg = PackageArg String
| PackageKeyArg String
deriving (Eq, Show)
type ModRenaming = Maybe [(String, String)]
data ModRenaming = ModRenaming Bool [(String, String)]
deriving (Eq, Show)
data PackageFlag
= ExposePackage PackageArg ModRenaming
......@@ -3440,13 +3441,15 @@ parsePackageFlag constr str = case filter ((=="").snd) (readP_to_S parse str) of
[(r, "")] -> r
_ -> throwGhcException $ CmdLineError ("Can't parse package flag: " ++ str)
where parse = do
pkg <- munch1 (\c -> isAlphaNum c || c `elem` ":-_.")
(do _ <- tok $ R.char '('
rns <- tok $ sepBy parseItem (tok $ R.char ',')
_ <- tok $ R.char ')'
return (ExposePackage (constr pkg) (Just rns))
+++
return (ExposePackage (constr pkg) Nothing))
pkg <- tok $ munch1 (\c -> isAlphaNum c || c `elem` ":-_.")
( do _ <- tok $ string "with"
fmap (ExposePackage (constr pkg) . ModRenaming True) parseRns
<++ fmap (ExposePackage (constr pkg) . ModRenaming False) parseRns
<++ return (ExposePackage (constr pkg) (ModRenaming True [])))
parseRns = do _ <- tok $ R.char '('
rns <- tok $ sepBy parseItem (tok $ R.char ',')
_ <- tok $ R.char ')'
return rns
parseItem = do
orig <- tok $ parseModuleName
(do _ <- tok $ string "as"
......@@ -3454,7 +3457,7 @@ parsePackageFlag constr str = case filter ((=="").snd) (readP_to_S parse str) of
return (orig, new)
+++
return (orig, orig))
tok m = skipSpaces >> m
tok m = m >>= \x -> skipSpaces >> return x
exposePackage, exposePackageId, exposePackageKey, hidePackage, ignorePackage,
trustPackage, distrustPackage :: String -> DynP ()
......@@ -3723,6 +3726,7 @@ compilerInfo dflags
("Support dynamic-too", if isWindows then "NO" else "YES"),
("Support parallel --make", "YES"),
("Support reexported-modules", "YES"),
("Support thinning and renaming package flags", "YES"),
("Uses package keys", "YES"),
("Dynamic by default", if dYNAMIC_BY_DEFAULT dflags
then "YES" else "NO"),
......
......@@ -477,26 +477,19 @@ applyPackageFlag
applyPackageFlag dflags unusable (pkgs, vm) flag =
case flag of
ExposePackage arg m_rns ->
ExposePackage arg (ModRenaming b rns) ->
case selectPackages (matching arg) pkgs unusable of
Left ps -> packageFlagErr dflags flag ps
Right (p:_,_) -> return (pkgs, vm')
where
n = fsPackageName p
vm' = addToUFM_C edit vm_cleared (calcKey p)
(case m_rns of
Nothing -> (True, [], n)
Just rns' -> (False, map convRn rns', n))
vm' = addToUFM_C edit vm_cleared (calcKey p) (b, map convRn rns, n)
edit (b, rns, n) (b', rns', _) = (b || b', rns ++ rns', n)
convRn (a,b) = (mkModuleName a, mkModuleName b)
-- ToDo: ATM, -hide-all-packages implicitly triggers change in
-- behavior, maybe eventually make it toggleable with a separate
-- flag
vm_cleared | gopt Opt_HideAllPackages dflags = vm
-- NB: -package foo-0.1 (Foo as Foo1) does NOT hide
-- other versions of foo. Presence of renaming means
-- user probably wanted both.
| Just _ <- m_rns = vm
| otherwise = filterUFM_Directly
(\k (_,_,n') -> k == getUnique (calcKey p)
|| n /= n') vm
......@@ -594,9 +587,10 @@ pprFlag flag = case flag of
PackageArg p -> text "-package " <> text p
PackageIdArg p -> text "-package-id " <> text p
PackageKeyArg p -> text "-package-key " <> text p
ppr_rns Nothing = Outputable.empty
ppr_rns (Just rns) = char '(' <> hsep (punctuate comma (map ppr_rn rns))
<> char ')'
ppr_rns (ModRenaming True []) = Outputable.empty
ppr_rns (ModRenaming b rns) =
if b then text "with" else Outputable.empty <+>
char '(' <> hsep (punctuate comma (map ppr_rn rns)) <> char ')'
ppr_rn (orig, new) | orig == new = text orig
| otherwise = text orig <+> text "as" <+> text new
......
......@@ -390,13 +390,14 @@ _ZCMain_main_closure
parenthesized, comma-separated list of module names to import. For example,
<literal>-package "base (Data.List, Data.Bool)"</literal> makes only
<literal>Data.List</literal> and <literal>Data.Bool</literal> visible from
package <literal>base</literal>.
We also support renaming of modules, in case you need to refer to both modules
simultaneously; this is supporting by writing <literal>OldModName as
NewModName</literal>, e.g. <literal>-package "base (Data.Bool as
Bool)</literal>. It's important to specify quotes
so that your shell passes the package name and thinning/renaming list as a
single argument to GHC.</para>
package <literal>base</literal>. We also support renaming of modules, in case
you need to refer to both modules simultaneously; this is supporting by
writing <literal>OldModName as NewModName</literal>, e.g. <literal>-package
"base (Data.Bool as Bool)</literal>. You can also write <literal>-package
"base with (Data.Bool as Bool)</literal> to include all of the original
bindings (e.g. the renaming is strictly additive). It's important to specify
quotes so that your shell passes the package name and thinning/renaming list
as a single argument to GHC.</para>
<para>Package imports with thinning/renaming do not hide other versions of the
package: e.g. if containers-0.9 is already exposed, <literal>-package
......
......@@ -17,7 +17,10 @@ main =
liftIO $ print (mkModuleName "Outputable" `elem` listVisibleModuleNames dflags)
_ <- runGhc (Just libdir) $ do
dflags <- getSessionDynFlags
setSessionDynFlags (dflags { packageFlags = [ExposePackage (PackageArg "ghc") Nothing]})
setSessionDynFlags (dflags {
packageFlags = [ExposePackage (PackageArg "ghc")
(ModRenaming True [])]
})
dflags <- getSessionDynFlags
liftIO $ print (mkModuleName "Outputable" `elem` listVisibleModuleNames dflags)
return ()
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment