Commit 1bd40c86 authored by Eric Seidel's avatar Eric Seidel Committed by Ben Gamari

Move checking for missing signatures to RnNames.reportUnusedNames

Checking for missing signatures before renaming the export list is
prone to errors, so we now perform the check in `reportUnusedNames` at
which point everything has been renamed.

Test Plan: validate, new test case is T10908

Reviewers: goldfire, simonpj, austin, bgamari

Subscribers: thomie

Projects: #ghc

Differential Revision: https://phabricator.haskell.org/D1561

GHC Trac Issues: #10908
parent 51a5e68d
......@@ -43,6 +43,8 @@ import Util
import FastString
import FastStringEnv
import ListSetOps
import Id
import Type
import Control.Monad
import Data.Either ( partitionEithers, isRight, rights )
......@@ -1471,7 +1473,8 @@ reportUnusedNames :: Maybe (Located [LIE RdrName]) -- Export list
reportUnusedNames _export_decls gbl_env
= do { traceRn ((text "RUN") <+> (ppr (tcg_dus gbl_env)))
; warnUnusedImportDecls gbl_env
; warnUnusedTopBinds unused_locals }
; warnUnusedTopBinds unused_locals
; warnMissingSigs gbl_env }
where
used_names :: NameSet
used_names = findUses (tcg_dus gbl_env) emptyNameSet
......@@ -1546,6 +1549,64 @@ warnUnusedImportDecls gbl_env
; whenGOptM Opt_D_dump_minimal_imports $
printMinimalImports usage }
-- | Warn the user about top level binders that lack type signatures.
warnMissingSigs :: TcGblEnv -> RnM ()
warnMissingSigs gbl_env
= do { let exports = availsToNameSet (tcg_exports gbl_env)
sig_ns = tcg_sigs gbl_env
binds = tcg_binds gbl_env
-- Warn about missing signatures
-- Do this only when we we have a type to offer
; warn_missing_sigs <- woptM Opt_WarnMissingSigs
; warn_only_exported <- woptM Opt_WarnMissingExportedSigs
; let sig_warn
| warn_only_exported = topSigWarnIfExported exports sig_ns
| warn_missing_sigs = topSigWarn sig_ns
| otherwise = noSigWarn
; sig_warn (collectHsBindsBinders binds) }
type SigWarn = [Id] -> RnM ()
-- Missing-signature warning
noSigWarn :: SigWarn
noSigWarn _ = return ()
topSigWarnIfExported :: NameSet -> NameSet -> SigWarn
topSigWarnIfExported exported sig_ns ids
= mapM_ (topSigWarnIdIfExported exported sig_ns) ids
topSigWarnIdIfExported :: NameSet -> NameSet -> Id -> RnM ()
topSigWarnIdIfExported exported sig_ns id
| getName id `elemNameSet` exported
= topSigWarnId sig_ns id
| otherwise
= return ()
topSigWarn :: NameSet -> SigWarn
topSigWarn sig_ns ids = mapM_ (topSigWarnId sig_ns) ids
topSigWarnId :: NameSet -> Id -> RnM ()
-- The NameSet is the Ids that *lack* a signature
-- We have to do it this way round because there are
-- lots of top-level bindings that are generated by GHC
-- and that don't have signatures
topSigWarnId sig_ns id
| idName id `elemNameSet` sig_ns = warnMissingSig msg id
| otherwise = return ()
where
msg = ptext (sLit "Top-level binding with no type signature:")
warnMissingSig :: SDoc -> Id -> RnM ()
warnMissingSig msg id
= do { env <- tcInitTidyEnv
; let (_, tidy_ty) = tidyOpenType env (idType id)
; addWarnAt (getSrcSpan id) (mk_msg tidy_ty) }
where
mk_msg ty = sep [ msg, nest 2 $ pprPrefixName (idName id) <+> dcolon <+> ppr ty ]
{-
Note [The ImportMap]
~~~~~~~~~~~~~~~~~~~~
......
......@@ -58,7 +58,7 @@ import Util
import BasicTypes
import Outputable
import FastString
import Type(mkStrLitTy)
import Type(mkStrLitTy, tidyOpenType)
import PrelNames( mkUnboundName, gHC_PRIM )
import TcValidity (checkValidType)
......@@ -728,6 +728,10 @@ mkExport prag_fn qtvs theta mono_info@(poly_name, mb_sig, mono_id)
-- e..g infer x :: forall a. F a -> Int
else addErrCtxtM (mk_impedence_match_msg mono_info sel_poly_ty poly_ty) $
tcSubType_NC sig_ctxt sel_poly_ty poly_ty
; warn_missing_sigs <- woptM Opt_WarnMissingLocalSigs
; when warn_missing_sigs $ localSigWarn poly_id mb_sig
; return (ABE { abe_wrap = wrap
-- abe_wrap :: idType poly_id ~ (forall qtvs. theta => mono_ty)
, abe_poly = poly_id
......@@ -852,6 +856,24 @@ mk_inf_msg poly_name poly_ty tidy_env
, nest 2 $ ppr poly_name <+> dcolon <+> ppr poly_ty ]
; return (tidy_env1, msg) }
-- | Warn the user about polymorphic local binders that lack type signatures.
localSigWarn :: Id -> Maybe TcIdSigInfo -> TcM ()
localSigWarn id mb_sig
| Just _ <- mb_sig = return ()
| not (isSigmaTy (idType id)) = return ()
| otherwise = warnMissingSig msg id
where
msg = ptext (sLit "Polymorphic local binding with no type signature:")
warnMissingSig :: SDoc -> Id -> TcM ()
warnMissingSig msg id
= do { env0 <- tcInitTidyEnv
; let (env1, tidy_ty) = tidyOpenType env0 (idType id)
; addWarnTcM (env1, mk_msg tidy_ty) }
where
mk_msg ty = sep [ msg, nest 2 $ pprPrefixName (idName id) <+> dcolon <+> ppr ty ]
{-
Note [Partial type signatures and generalisation]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
......
This diff is collapsed.
......@@ -329,7 +329,7 @@ tcRnModuleTcRnM hsc_env hsc_src
tcRnHsBootDecls hsc_src local_decls
else
{-# SCC "tcRnSrcDecls" #-}
tcRnSrcDecls explicit_mod_hdr export_ies local_decls ;
tcRnSrcDecls explicit_mod_hdr local_decls ;
setGblEnv tcg_env $ do {
-- Process the export list
......@@ -464,12 +464,11 @@ tcRnImports hsc_env import_decls
-}
tcRnSrcDecls :: Bool -- False => no 'module M(..) where' header at all
-> Maybe (Located [LIE RdrName]) -- Exports
-> [LHsDecl RdrName] -- Declarations
-> TcM TcGblEnv
-- Returns the variables free in the decls
-- Reason: solely to report unused imports and bindings
tcRnSrcDecls explicit_mod_hdr exports decls
tcRnSrcDecls explicit_mod_hdr decls
= do { -- Create a binding for $trModule
-- Do this before processing any data type declarations,
-- which need tcg_tr_module to be initialised
......@@ -523,7 +522,6 @@ tcRnSrcDecls explicit_mod_hdr exports decls
-- This pass also warns about missing type signatures
; let { TcGblEnv { tcg_type_env = type_env,
tcg_binds = binds,
tcg_sigs = sig_ns,
tcg_ev_binds = cur_ev_binds,
tcg_imp_specs = imp_specs,
tcg_rules = rules,
......@@ -533,7 +531,7 @@ tcRnSrcDecls explicit_mod_hdr exports decls
; (bind_ids, ev_binds', binds', fords', imp_specs', rules', vects')
<- {-# SCC "zonkTopDecls" #-}
zonkTopDecls all_ev_binds binds exports sig_ns rules vects
zonkTopDecls all_ev_binds binds rules vects
imp_specs fords ;
; traceTc "Tc11" empty
......@@ -2115,7 +2113,7 @@ tcRnDeclsi :: HscEnv
-> IO (Messages, Maybe TcGblEnv)
tcRnDeclsi hsc_env local_decls
= runTcInteractive hsc_env $
tcRnSrcDecls False Nothing local_decls
tcRnSrcDecls False local_decls
externaliseAndTidyId :: Module -> Id -> TcM Id
externaliseAndTidyId this_mod id
......
{-# OPTIONS_GHC -fwarn-missing-exported-sigs #-}
module Bug (Data.List.intercalate, x) where
import qualified Data.List
intercalate = True
x :: Bool
x = intercalate
......@@ -4,6 +4,7 @@ test('T9178', extra_clean(['T9178.o', 'T9178DataType.o',
'T9178.hi', 'T9178DataType.hi']),
multimod_compile, ['T9178', '-Wall'])
test('T9230', normal, compile_without_flag('-fno-warn-tabs'), [''])
test('T10908', normal, compile, [''])
test('T11077', normal, compile, ['-fwarn-missing-exported-sigs'])
test('T11128', normal, compile, [''])
......
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