[commit: ghc] master: Simplify type of ms_srcimps and ms_textual_imps. (e5baf62)
git at git.haskell.org
git at git.haskell.org
Fri Oct 9 23:09:34 UTC 2015
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/e5baf62dfac7fd81acc2bd570ba7d3b1fedd8363/ghc
>---------------------------------------------------------------
commit e5baf62dfac7fd81acc2bd570ba7d3b1fedd8363
Author: Edward Z. Yang <ezyang at cs.stanford.edu>
Date: Thu Oct 8 15:03:01 2015 -0700
Simplify type of ms_srcimps and ms_textual_imps.
Summary:
Previously, we stored an entire ImportDecl, which was pretty
wasteful since all we really cared about was the package qualifier
and the module name.
Signed-off-by: Edward Z. Yang <ezyang at cs.stanford.edu>
Test Plan: validate
Reviewers: bgamari, austin
Subscribers: thomie
Differential Revision: https://phabricator.haskell.org/D1317
>---------------------------------------------------------------
e5baf62dfac7fd81acc2bd570ba7d3b1fedd8363
compiler/iface/MkIface.hs | 4 ++--
compiler/main/DriverMkDepend.hs | 13 +++++--------
compiler/main/GhcMake.hs | 8 +++-----
compiler/main/HeaderInfo.hs | 10 ++++++++--
compiler/main/HscTypes.hs | 22 ++++------------------
5 files changed, 22 insertions(+), 35 deletions(-)
diff --git a/compiler/iface/MkIface.hs b/compiler/iface/MkIface.hs
index 43e57cd..0fc45cc 100644
--- a/compiler/iface/MkIface.hs
+++ b/compiler/iface/MkIface.hs
@@ -1300,8 +1300,8 @@ checkDependencies hsc_env summary iface
this_pkg = thisPackage (hsc_dflags hsc_env)
- dep_missing (L _ (ImportDecl { ideclName = L _ mod, ideclPkgQual = pkg })) = do
- find_res <- liftIO $ findImportedModule hsc_env mod (fmap sl_fs pkg)
+ dep_missing (mb_pkg, L _ mod) = do
+ find_res <- liftIO $ findImportedModule hsc_env mod (mb_pkg)
let reason = moduleNameString mod ++ " changed"
case find_res of
Found _ mod
diff --git a/compiler/main/DriverMkDepend.hs b/compiler/main/DriverMkDepend.hs
index aae4d0e..1541d95 100644
--- a/compiler/main/DriverMkDepend.hs
+++ b/compiler/main/DriverMkDepend.hs
@@ -16,7 +16,6 @@ module DriverMkDepend (
import qualified GHC
import GhcMonad
-import HsSyn ( ImportDecl(..) )
import DynFlags
import Util
import HscTypes
@@ -30,7 +29,6 @@ import Panic
import SrcLoc
import Data.List
import FastString
-import BasicTypes ( StringLiteral(..) )
import Exception
import ErrUtils
@@ -227,9 +225,8 @@ processDeps dflags hsc_env excl_mods root hdl (AcyclicSCC node)
-- Emit a dependency for each import
; let do_imps is_boot idecls = sequence_
- [ do_imp loc is_boot (fmap sl_fs $ ideclPkgQual i) mod
- | L loc i <- idecls,
- let mod = unLoc (ideclName i),
+ [ do_imp loc is_boot mb_pkg mod
+ | (mb_pkg, L loc mod) <- idecls,
mod `notElem` excl_mods ]
; do_imps True (ms_srcimps node)
@@ -379,7 +376,7 @@ pprCycle summaries = pp_group (CyclicSCC summaries)
pp_ms loop_breaker $$ vcat (map pp_group groups)
where
(boot_only, others) = partition is_boot_only mss
- is_boot_only ms = not (any in_group (map (ideclName.unLoc) (ms_imps ms)))
+ is_boot_only ms = not (any in_group (map snd (ms_imps ms)))
in_group (L _ m) = m `elem` group_mods
group_mods = map (moduleName . ms_mod) mss
@@ -388,8 +385,8 @@ pprCycle summaries = pp_group (CyclicSCC summaries)
groups = GHC.topSortModuleGraph True all_others Nothing
pp_ms summary = text mod_str <> text (take (20 - length mod_str) (repeat ' '))
- <+> (pp_imps empty (map (ideclName.unLoc) (ms_imps summary)) $$
- pp_imps (ptext (sLit "{-# SOURCE #-}")) (map (ideclName.unLoc) (ms_srcimps summary)))
+ <+> (pp_imps empty (map snd (ms_imps summary)) $$
+ pp_imps (ptext (sLit "{-# SOURCE #-}")) (map snd (ms_srcimps summary)))
where
mod_str = moduleNameString (moduleName (ms_mod summary))
diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs
index 3d29b1d..123cc9e 100644
--- a/compiler/main/GhcMake.hs
+++ b/compiler/main/GhcMake.hs
@@ -34,10 +34,8 @@ import ErrUtils
import Finder
import GhcMonad
import HeaderInfo
-import HsSyn
import HscTypes
import Module
-import RdrName ( RdrName )
import TcIface ( typecheckIface )
import TcRnMonad ( initIfaceCheck )
@@ -1720,9 +1718,9 @@ msDeps s =
then [ (noLoc (moduleName (ms_mod s)), IsBoot) ]
else []
-home_imps :: [Located (ImportDecl RdrName)] -> [Located ModuleName]
-home_imps imps = [ ideclName i | L _ i <- imps,
- isLocal (fmap sl_fs $ ideclPkgQual i) ]
+home_imps :: [(Maybe FastString, Located ModuleName)] -> [Located ModuleName]
+home_imps imps = [ lmodname | (mb_pkg, lmodname) <- imps,
+ isLocal mb_pkg ]
where isLocal Nothing = True
isLocal (Just pkg) | pkg == fsLit "this" = True -- "this" is special
isLocal _ = False
diff --git a/compiler/main/HeaderInfo.hs b/compiler/main/HeaderInfo.hs
index 3473a4a..b4c3f81 100644
--- a/compiler/main/HeaderInfo.hs
+++ b/compiler/main/HeaderInfo.hs
@@ -37,6 +37,7 @@ import Maybes
import Bag ( emptyBag, listToBag, unitBag )
import MonadUtils
import Exception
+import BasicTypes
import Control.Monad
import System.IO
@@ -54,7 +55,9 @@ getImports :: DynFlags
-- reporting parse error locations.
-> FilePath -- ^ The original source filename (used for locations
-- in the function result)
- -> IO ([Located (ImportDecl RdrName)], [Located (ImportDecl RdrName)], Located ModuleName)
+ -> IO ([(Maybe FastString, Located ModuleName)],
+ [(Maybe FastString, Located ModuleName)],
+ Located ModuleName)
-- ^ The source imports, normal imports, and the module name.
getImports dflags buf filename source_filename = do
let loc = mkRealSrcLoc (mkFastString filename) 1 1
@@ -83,8 +86,11 @@ getImports dflags buf filename source_filename = do
implicit_prelude = xopt Opt_ImplicitPrelude dflags
implicit_imports = mkPrelImports (unLoc mod) main_loc
implicit_prelude imps
+ convImport (L _ i) = (fmap sl_fs (ideclPkgQual i), ideclName i)
in
- return (src_idecls, implicit_imports ++ ordinary_imps, mod)
+ return (map convImport src_idecls,
+ map convImport (implicit_imports ++ ordinary_imps),
+ mod)
mkPrelImports :: ModuleName
-> SrcSpan -- Attribute the "import Prelude" to this location
diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs
index ddb4ca1..2c426d9 100644
--- a/compiler/main/HscTypes.hs
+++ b/compiler/main/HscTypes.hs
@@ -2406,9 +2406,9 @@ data ModSummary
-- ^ Timestamp of hi file, if we *only* are typechecking (it is
-- 'Nothing' otherwise.
-- See Note [Recompilation checking when typechecking only] and #9243
- ms_srcimps :: [Located (ImportDecl RdrName)],
+ ms_srcimps :: [(Maybe FastString, Located ModuleName)],
-- ^ Source imports of the module
- ms_textual_imps :: [Located (ImportDecl RdrName)],
+ ms_textual_imps :: [(Maybe FastString, Located ModuleName)],
-- ^ Non-source imports of the module from the module *text*
ms_merge_imps :: (Bool, [Module]),
-- ^ Non-textual imports computed for HsBootMerge
@@ -2424,26 +2424,12 @@ data ModSummary
ms_mod_name :: ModSummary -> ModuleName
ms_mod_name = moduleName . ms_mod
-ms_imps :: ModSummary -> [Located (ImportDecl RdrName)]
+ms_imps :: ModSummary -> [(Maybe FastString, Located ModuleName)]
ms_imps ms =
ms_textual_imps ms ++
map mk_additional_import (dynFlagDependencies (ms_hspp_opts ms))
where
- -- This is a not-entirely-satisfactory means of creating an import
- -- that corresponds to an import that did not occur in the program
- -- text, such as those induced by the use of plugins (the -plgFoo
- -- flag)
- mk_additional_import mod_nm = noLoc $ ImportDecl {
- ideclSourceSrc = Nothing,
- ideclName = noLoc mod_nm,
- ideclPkgQual = Nothing,
- ideclSource = False,
- ideclImplicit = True, -- Maybe implicit because not "in the program text"
- ideclQualified = False,
- ideclAs = Nothing,
- ideclHiding = Nothing,
- ideclSafe = False
- }
+ mk_additional_import mod_nm = (Nothing, noLoc mod_nm)
-- The ModLocation contains both the original source filename and the
-- filename of the cleaned-up source file after all preprocessing has been
More information about the ghc-commits
mailing list