summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
Diffstat (limited to 'compiler')
-rw-r--r--compiler/basicTypes/Module.hs4
-rw-r--r--compiler/iface/FlagChecker.hs4
-rw-r--r--compiler/iface/LoadIface.hs68
-rw-r--r--compiler/iface/MkIface.hs13
-rw-r--r--compiler/iface/TcIface.hs2
-rw-r--r--compiler/typecheck/TcBackpack.hs12
6 files changed, 66 insertions, 37 deletions
diff --git a/compiler/basicTypes/Module.hs b/compiler/basicTypes/Module.hs
index e076580119..e7f8a8d78e 100644
--- a/compiler/basicTypes/Module.hs
+++ b/compiler/basicTypes/Module.hs
@@ -62,6 +62,7 @@ module Module
splitModuleInsts,
splitUnitIdInsts,
generalizeIndefUnitId,
+ generalizeIndefModule,
-- * Parsers
parseModuleName,
@@ -1000,6 +1001,9 @@ generalizeIndefUnitId IndefUnitId{ indefUnitIdComponentId = cid
, indefUnitIdInsts = insts } =
newIndefUnitId cid (map (\(m,_) -> (m, mkHoleModule m)) insts)
+generalizeIndefModule :: IndefModule -> IndefModule
+generalizeIndefModule (IndefModule uid n) = IndefModule (generalizeIndefUnitId uid) n
+
parseModuleName :: ReadP ModuleName
parseModuleName = fmap mkModuleName
$ Parse.munch1 (\c -> isAlphaNum c || c `elem` "_.")
diff --git a/compiler/iface/FlagChecker.hs b/compiler/iface/FlagChecker.hs
index 10cfae6eeb..a0654b01e6 100644
--- a/compiler/iface/FlagChecker.hs
+++ b/compiler/iface/FlagChecker.hs
@@ -22,6 +22,10 @@ import System.FilePath (normalise)
-- | Produce a fingerprint of a @DynFlags@ value. We only base
-- the finger print on important fields in @DynFlags@ so that
-- the recompilation checker can use this fingerprint.
+--
+-- NB: The 'Module' parameter is the 'Module' recorded by the
+-- *interface* file, not the actual 'Module' according to our
+-- 'DynFlags'.
fingerprintDynFlags :: DynFlags -> Module
-> (BinHandle -> Name -> IO ())
-> IO Fingerprint
diff --git a/compiler/iface/LoadIface.hs b/compiler/iface/LoadIface.hs
index 0890e20cff..0edf5d9794 100644
--- a/compiler/iface/LoadIface.hs
+++ b/compiler/iface/LoadIface.hs
@@ -537,7 +537,7 @@ computeInterface doc_str hi_boot_file mod0 = do
dflags <- getDynFlags
case splitModuleInsts mod0 of
(imod, Just indef) | not (unitIdIsDefinite (thisPackage dflags)) -> do
- r <- findAndReadIface doc_str imod hi_boot_file
+ r <- findAndReadIface doc_str imod mod0 hi_boot_file
case r of
Succeeded (iface0, path) -> do
hsc_env <- getTopEnv
@@ -549,7 +549,7 @@ computeInterface doc_str hi_boot_file mod0 = do
Left errs -> liftIO . throwIO . mkSrcErr $ errs
Failed err -> return (Failed err)
(mod, _) ->
- findAndReadIface doc_str mod hi_boot_file
+ findAndReadIface doc_str mod mod0 hi_boot_file
-- | Compute the signatures which must be compiled in order to
-- load the interface for a 'Module'. The output of this function
@@ -585,7 +585,7 @@ moduleFreeHolesPrecise doc_str mod
Just ifhs -> Just (renameFreeHoles ifhs insts)
_otherwise -> Nothing
readAndCache imod insts = do
- mb_iface <- findAndReadIface (text "moduleFreeHolesPrecise" <+> doc_str) imod False
+ mb_iface <- findAndReadIface (text "moduleFreeHolesPrecise" <+> doc_str) imod mod False
case mb_iface of
Succeeded (iface, _) -> do
let ifhs = mi_free_holes iface
@@ -778,7 +778,14 @@ This actually happened with P=base, Q=ghc-prim, via the AMP warnings.
See Trac #8320.
-}
-findAndReadIface :: SDoc -> InstalledModule
+findAndReadIface :: SDoc
+ -- The unique identifier of the on-disk module we're
+ -- looking for
+ -> InstalledModule
+ -- The *actual* module we're looking for. We use
+ -- this to check the consistency of the requirements
+ -- of the module we read out.
+ -> Module
-> IsBootInterface -- True <=> Look for a .hi-boot file
-- False <=> Look for .hi file
-> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, FilePath))
@@ -787,7 +794,7 @@ findAndReadIface :: SDoc -> InstalledModule
-- It *doesn't* add an error to the monad, because
-- sometimes it's ok to fail... see notes with loadInterface
-findAndReadIface doc_str mod hi_boot_file
+findAndReadIface doc_str mod wanted_mod_with_insts hi_boot_file
= do traceIf (sep [hsep [text "Reading",
if hi_boot_file
then text "[boot]"
@@ -828,14 +835,20 @@ findAndReadIface doc_str mod hi_boot_file
(installedModuleName mod) err))
where read_file file_path = do
traceIf (text "readIFace" <+> text file_path)
- read_result <- readIface mod file_path
+ -- Figure out what is recorded in mi_module. If this is
+ -- a fully definite interface, it'll match exactly, but
+ -- if it's indefinite, the inside will be uninstantiated!
+ dflags <- getDynFlags
+ let wanted_mod =
+ case splitModuleInsts wanted_mod_with_insts of
+ (_, Nothing) -> wanted_mod_with_insts
+ (_, Just indef_mod) ->
+ indefModuleToModule dflags
+ (generalizeIndefModule indef_mod)
+ read_result <- readIface wanted_mod file_path
case read_result of
Failed err -> return (Failed (badIfaceFile file_path err))
- Succeeded iface
- | not (mod `installedModuleEq` mi_module iface) ->
- return (Failed (wrongIfaceModErr iface mod file_path))
- | otherwise ->
- return (Succeeded (iface, file_path))
+ Succeeded iface -> return (Succeeded (iface, file_path))
-- Don't forget to fill in the package name...
checkBuildDynamicToo (Succeeded (iface, filePath)) = do
dflags <- getDynFlags
@@ -862,7 +875,7 @@ findAndReadIface doc_str mod hi_boot_file
-- @readIface@ tries just the one file.
-readIface :: InstalledModule -> FilePath
+readIface :: Module -> FilePath
-> TcRnIf gbl lcl (MaybeErr MsgDoc ModIface)
-- Failed err <=> file not found, or unreadable, or illegible
-- Succeeded iface <=> successfully found and parsed
@@ -873,8 +886,10 @@ readIface wanted_mod file_path
; dflags <- getDynFlags
; case res of
Right iface
- -- Same deal
- | wanted_mod `installedModuleEq` actual_mod
+ -- NB: This check is NOT just a sanity check, it is
+ -- critical for correctness of recompilation checking
+ -- (it lets us tell when -this-unit-id has changed.)
+ | wanted_mod == actual_mod
-> return (Succeeded iface)
| otherwise -> return (Failed err)
where
@@ -1130,8 +1145,16 @@ badIfaceFile file err
= vcat [text "Bad interface file:" <+> text file,
nest 4 err]
-hiModuleNameMismatchWarn :: DynFlags -> InstalledModule -> Module -> MsgDoc
-hiModuleNameMismatchWarn dflags requested_mod read_mod =
+hiModuleNameMismatchWarn :: DynFlags -> Module -> Module -> MsgDoc
+hiModuleNameMismatchWarn dflags requested_mod read_mod
+ | moduleUnitId requested_mod == moduleUnitId read_mod =
+ sep [text "Interface file contains module" <+> quotes (ppr read_mod) <> comma,
+ text "but we were expecting module" <+> quotes (ppr requested_mod),
+ sep [text "Probable cause: the source code which generated interface file",
+ text "has an incompatible module name"
+ ]
+ ]
+ | otherwise =
-- ToDo: This will fail to have enough qualification when the package IDs
-- are the same
withPprStyle (mkUserStyle dflags alwaysQualify AllTheWay) $
@@ -1141,20 +1164,9 @@ hiModuleNameMismatchWarn dflags requested_mod read_mod =
, ppr requested_mod
, text "differs from name found in the interface file"
, ppr read_mod
+ , parens (text "if these names look the same, try again with -dppr-debug")
]
-wrongIfaceModErr :: ModIface -> InstalledModule -> String -> SDoc
-wrongIfaceModErr iface mod file_path
- = sep [text "Interface file" <+> iface_file,
- text "contains module" <+> quotes (ppr (mi_module iface)) <> comma,
- text "but we were expecting module" <+> quotes (ppr mod),
- sep [text "Probable cause: the source code which generated",
- nest 2 iface_file,
- text "has an incompatible module name"
- ]
- ]
- where iface_file = doubleQuotes (text file_path)
-
homeModError :: InstalledModule -> ModLocation -> SDoc
-- See Note [Home module load error]
homeModError mod location
diff --git a/compiler/iface/MkIface.hs b/compiler/iface/MkIface.hs
index aacdac9b71..acf61a7066 100644
--- a/compiler/iface/MkIface.hs
+++ b/compiler/iface/MkIface.hs
@@ -1103,7 +1103,8 @@ checkOldIface hsc_env mod_summary source_modified maybe_iface
= do let dflags = hsc_dflags hsc_env
showPass dflags $
"Checking old interface for " ++
- (showPpr dflags $ ms_mod mod_summary)
+ (showPpr dflags $ ms_mod mod_summary) ++
+ " (use -ddump-hi-diffs for more details)"
initIfaceCheck (text "checkOldIface") hsc_env $
check_old_iface hsc_env mod_summary source_modified maybe_iface
@@ -1126,10 +1127,11 @@ check_old_iface hsc_env mod_summary src_modified maybe_iface
loadIface = do
let iface_path = msHiFilePath mod_summary
- read_result <- readIface (ms_installed_mod mod_summary) iface_path
+ read_result <- readIface (ms_mod mod_summary) iface_path
case read_result of
Failed err -> do
traceIf (text "FYI: cannot read old interface file:" $$ nest 4 err)
+ traceHiDiffs (text "Old interface file was invalid:" $$ nest 4 err)
return Nothing
Succeeded iface -> do
traceIf (text "Read the interface file" <+> text iface_path)
@@ -1187,6 +1189,11 @@ checkVersions hsc_env mod_summary iface
= do { traceHiDiffs (text "Considering whether compilation is required for" <+>
ppr (mi_module iface) <> colon)
+ -- readIface will have verified that the InstalledUnitId matches,
+ -- but we ALSO must make sure the instantiation matches up. See
+ -- test case bkpcabal04!
+ ; if moduleUnitId (mi_module iface) /= thisPackage (hsc_dflags hsc_env)
+ then return (RecompBecause "-this-unit-id changed", Nothing) else do {
; recomp <- checkFlagHash hsc_env iface
; if recompileRequired recomp then return (recomp, Nothing) else do {
; recomp <- checkMergedSignatures mod_summary iface
@@ -1212,7 +1219,7 @@ checkVersions hsc_env mod_summary iface
; updateEps_ $ \eps -> eps { eps_is_boot = udfmToUfm mod_deps }
; recomp <- checkList [checkModUsage this_pkg u | u <- mi_usages iface]
; return (recomp, Just iface)
- }}}}}
+ }}}}}}
where
this_pkg = thisPackage (hsc_dflags hsc_env)
-- This is a bit of a hack really
diff --git a/compiler/iface/TcIface.hs b/compiler/iface/TcIface.hs
index d2ddeb2b82..a920945e16 100644
--- a/compiler/iface/TcIface.hs
+++ b/compiler/iface/TcIface.hs
@@ -459,7 +459,7 @@ tcHiBootIface hsc_src mod
-- to check consistency against, rather than just when we notice
-- that an hi-boot is necessary due to a circular import.
{ read_result <- findAndReadIface
- need (fst (splitModuleInsts mod))
+ need (fst (splitModuleInsts mod)) mod
True -- Hi-boot file
; case read_result of {
diff --git a/compiler/typecheck/TcBackpack.hs b/compiler/typecheck/TcBackpack.hs
index cca40d819d..086dee178b 100644
--- a/compiler/typecheck/TcBackpack.hs
+++ b/compiler/typecheck/TcBackpack.hs
@@ -505,10 +505,11 @@ mergeSignatures hsmod lcl_iface0 = do
-- STEP 2: Read in the RAW forms of all of these interfaces
ireq_ifaces0 <- forM reqs $ \(IndefModule iuid mod_name) ->
- fmap fst
+ let m = mkModule (IndefiniteUnitId iuid) mod_name
+ im = fst (splitModuleInsts m)
+ in fmap fst
. withException
- . flip (findAndReadIface (text "mergeSignatures")) False
- $ fst (splitModuleInsts (mkModule (IndefiniteUnitId iuid) mod_name))
+ $ findAndReadIface (text "mergeSignatures") im m False
-- STEP 3: Get the unrenamed exports of all these interfaces,
-- thin it according to the export list, and do shaping on them.
@@ -818,8 +819,9 @@ checkImplements impl_mod req_mod@(IndefModule uid mod_name) =
-- the ORIGINAL signature. We are going to eventually rename it,
-- but we must proceed slowly, because it is NOT known if the
-- instantiation is correct.
- let isig_mod = fst (splitModuleInsts (mkModule (IndefiniteUnitId uid) mod_name))
- mb_isig_iface <- findAndReadIface (text "checkImplements 2") isig_mod False
+ let sig_mod = mkModule (IndefiniteUnitId uid) mod_name
+ isig_mod = fst (splitModuleInsts sig_mod)
+ mb_isig_iface <- findAndReadIface (text "checkImplements 2") isig_mod sig_mod False
isig_iface <- case mb_isig_iface of
Succeeded (iface, _) -> return iface
Failed err -> failWithTc $
View Lorry Controller Status