[commit: ghc] master: Store renamings as (ModuleName, ModuleName) pairs. (68d4f47)

git at git.haskell.org git at git.haskell.org
Sat Mar 7 19:30:51 UTC 2015


Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/68d4f47212633d101c5f4963dbfccf0fb9a8580f/ghc

>---------------------------------------------------------------

commit 68d4f47212633d101c5f4963dbfccf0fb9a8580f
Author: Edward Z. Yang <ezyang at cs.stanford.edu>
Date:   Fri Mar 6 20:01:12 2015 -0800

    Store renamings as (ModuleName, ModuleName) pairs.
    
    Summary: Signed-off-by: Edward Z. Yang <ezyang at cs.stanford.edu>
    
    Test Plan: validate
    
    Reviewers: austin, simonpj
    
    Subscribers: thomie
    
    Differential Revision: https://phabricator.haskell.org/D710


>---------------------------------------------------------------

68d4f47212633d101c5f4963dbfccf0fb9a8580f
 compiler/main/DynFlags.hs | 15 ++++++++-------
 compiler/main/Packages.hs |  8 +++-----
 2 files changed, 11 insertions(+), 12 deletions(-)

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 04445c8..74e0ce6 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -1109,8 +1109,8 @@ data PackageArg = PackageArg String
                 | PackageKeyArg String
   deriving (Eq, Show)
 
-data ModRenaming = ModRenaming Bool [(String, String)]
-  deriving (Eq, Show)
+data ModRenaming = ModRenaming Bool [(ModuleName, ModuleName)]
+  deriving (Eq)
 
 data PackageFlag
   = ExposePackage   PackageArg ModRenaming
@@ -1118,7 +1118,7 @@ data PackageFlag
   | IgnorePackage   String
   | TrustPackage    String
   | DistrustPackage String
-  deriving (Eq, Show)
+  deriving (Eq)
 
 defaultHscTarget :: Platform -> HscTarget
 defaultHscTarget = defaultObjectTarget
@@ -1928,12 +1928,12 @@ parseSigOf str = case filter ((=="").snd) (readP_to_S parse str) of
             -- ToDo: deprecate this 'is' syntax?
             tok $ ((string "is" >> return ()) +++ (R.char '=' >> return ()))
             m <- tok $ parseModule
-            return (mkModuleName n, m)
+            return (n, m)
         parseModule = do
             pk <- munch1 (\c -> isAlphaNum c || c `elem` "-_")
             _ <- R.char ':'
             m <- parseModuleName
-            return (mkModule (stringToPackageKey pk) (mkModuleName m))
+            return (mkModule (stringToPackageKey pk) m)
         tok m = skipSpaces >> m
 
 setSigOf :: String -> DynFlags -> DynFlags
@@ -3683,8 +3683,9 @@ removeGlobalPkgConf = upd $ \s -> s { extraPkgConfs = filter isNotGlobal . extra
 clearPkgConf :: DynP ()
 clearPkgConf = upd $ \s -> s { extraPkgConfs = const [] }
 
-parseModuleName :: ReadP String
-parseModuleName = munch1 (\c -> isAlphaNum c || c `elem` ".")
+parseModuleName :: ReadP ModuleName
+parseModuleName = fmap mkModuleName
+                $ munch1 (\c -> isAlphaNum c || c `elem` ".")
 
 parsePackageFlag :: (String -> PackageArg) -- type of argument
                  -> String                 -- string to parse
diff --git a/compiler/main/Packages.hs b/compiler/main/Packages.hs
index 42aa0a1..e36221b 100644
--- a/compiler/main/Packages.hs
+++ b/compiler/main/Packages.hs
@@ -502,10 +502,8 @@ applyPackageFlag dflags unusable (pkgs, vm) flag =
          Right (p:_,_) -> return (pkgs, vm')
           where
            n = fsPackageName p
-           vm' = addToUFM_C edit vm_cleared (packageConfigId p)
-                            (b, map convRn rns, n)
+           vm' = addToUFM_C edit vm_cleared (packageConfigId p) (b, 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
@@ -611,8 +609,8 @@ pprFlag flag = case flag of
         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
+        ppr_rn (orig, new) | orig == new = ppr orig
+                           | otherwise = ppr orig <+> text "as" <+> ppr new
 
 -- -----------------------------------------------------------------------------
 -- Wired-in packages



More information about the ghc-commits mailing list