diff options
Diffstat (limited to 'compiler/GHC/Tc')
| -rw-r--r-- | compiler/GHC/Tc/Errors/Ppr.hs | 6 | ||||
| -rw-r--r-- | compiler/GHC/Tc/Errors/Types.hs | 6 | ||||
| -rw-r--r-- | compiler/GHC/Tc/Gen/Splice.hs | 21 |
3 files changed, 30 insertions, 3 deletions
diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs index 33b75e3eb1..014ffe33c2 100644 --- a/compiler/GHC/Tc/Errors/Ppr.hs +++ b/compiler/GHC/Tc/Errors/Ppr.hs @@ -1223,6 +1223,9 @@ instance Diagnostic TcRnMessage where TcRnSectionWithoutParentheses expr -> mkSimpleDecorated $ hang (text "A section must be enclosed in parentheses") 2 (text "thus:" <+> (parens (ppr expr))) + TcRnReifyModuleMissingInfo m -> mkSimpleDecorated $ + vcat [ (ppr m) <+> text "can't be reified due to missing information in its interface file." + , text "Possible cause:" <+> ppr m <+> text "was compiled with -fno-write-self-recomp-info" ] diagnosticReason = \case @@ -1628,6 +1631,8 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnIllegalTupleSection{} -> ErrorWithoutFlag + TcRnReifyModuleMissingInfo {} -> + WarningWithFlag Opt_WarnReifyModuleMissingInfo diagnosticHints = \case TcRnUnknownMessage m @@ -2037,6 +2042,7 @@ instance Diagnostic TcRnMessage where -> noHints TcRnIllegalTupleSection{} -> [suggestExtension LangExt.TupleSections] + TcRnReifyModuleMissingInfo {} -> noHints diagnosticCode = constructorCode diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs index 335e7c4965..b7b1a32b87 100644 --- a/compiler/GHC/Tc/Errors/Types.hs +++ b/compiler/GHC/Tc/Errors/Types.hs @@ -2762,6 +2762,12 @@ data TcRnMessage where -} TcRnSectionWithoutParentheses :: HsExpr GhcPs -> TcRnMessage + {-| TcRnReifyModuleMissingInfo is a warning triggered by attempting to + call reifyModule on a module whose interface file lacks the necessary information + to satisfy the query. This normally occurs when the module is compiled with `-fno-write-self-recomp-info`. + -} + TcRnReifyModuleMissingInfo:: Module -> TcRnMessage + deriving Generic -- | Things forbidden in @type data@ declarations. diff --git a/compiler/GHC/Tc/Gen/Splice.hs b/compiler/GHC/Tc/Gen/Splice.hs index 6ba304be16..3bbe9a9af7 100644 --- a/compiler/GHC/Tc/Gen/Splice.hs +++ b/compiler/GHC/Tc/Gen/Splice.hs @@ -2808,6 +2808,10 @@ modToTHMod :: Module -> TH.Module modToTHMod m = TH.Module (TH.PkgName $ unitString $ moduleUnit m) (TH.ModName $ moduleNameString $ moduleName m) +-- | Note that reifyModule will not work if the module is compiled with `-fno-write-self-recomp-info` +-- because the implementation works by consulting the `mi_usages` field which is intended to be only +-- used for recompilation checking. See #8489 for a ticket which tracks improvement +-- of this function. reifyModule :: TH.Module -> TcM TH.ModuleInfo reifyModule (TH.Module (TH.PkgName pkgString) (TH.ModName mString)) = do this_mod <- getModule @@ -2820,9 +2824,20 @@ reifyModule (TH.Module (TH.PkgName pkgString) (TH.ModName mString)) = do reifyFromIface reifMod = do iface <- loadInterfaceForModule (text "reifying module from TH for" <+> ppr reifMod) reifMod - let usages = [modToTHMod m | usage <- mi_usages iface, - Just m <- [usageToModule (moduleUnit reifMod) usage] ] - return $ TH.ModuleInfo usages + case mi_self_recomp_info iface of + NoSelfRecomp -> do + -- Arguably this should fail here but GHC.Prim always has NoSelfRecomp, so + -- any existing traversals would just stop working. Now they will start warning + -- and a user is expected to add a special case to avoid GHC.Prim in their traversal. + + -- An alternative would be to add that special case for GHC.Prim here and make it a hard + -- error if reifyModule was attempted to be used with these partial interface files. + addDiagnosticTc (TcRnReifyModuleMissingInfo reifMod) + return (TH.ModuleInfo []) + ModIfaceSelfRecomp{ mi_sr_usages } -> do + let usages = [modToTHMod m | usage <- mi_sr_usages + , Just m <- [usageToModule (moduleUnit reifMod) usage] ] + return $ TH.ModuleInfo usages usageToModule :: Unit -> Usage -> Maybe Module usageToModule _ (UsageFile {}) = Nothing |