Commit bb7d80b3 authored by simonpj@microsoft.com's avatar simonpj@microsoft.com
Browse files

Give the inferred type when warning of a missing type-signature (Trac #1256)

parent a01188d1
...@@ -178,20 +178,7 @@ rnTopBindsBoot (ValBindsIn mbinds sigs) ...@@ -178,20 +178,7 @@ rnTopBindsBoot (ValBindsIn mbinds sigs)
; return (ValBindsOut [] sigs', usesOnly (hsSigsFVs sigs')) } ; return (ValBindsOut [] sigs', usesOnly (hsSigsFVs sigs')) }
rnTopBindsSrc :: HsValBinds RdrName -> RnM (HsValBinds Name, DefUses) rnTopBindsSrc :: HsValBinds RdrName -> RnM (HsValBinds Name, DefUses)
rnTopBindsSrc binds@(ValBindsIn mbinds _) rnTopBindsSrc binds = rnValBinds noTrim binds
= do { (binds', dus) <- rnValBinds noTrim binds
-- Warn about missing signatures,
; let { ValBindsOut _ sigs' = binds'
; ty_sig_vars = mkNameSet [ unLoc n | L _ (TypeSig n _) <- sigs']
; un_sigd_bndrs = duDefs dus `minusNameSet` ty_sig_vars }
; warn_missing_sigs <- doptM Opt_WarnMissingSigs
; ifM (warn_missing_sigs)
(mappM_ missingSigWarn (nameSetToList un_sigd_bndrs))
; return (binds', dus)
}
\end{code} \end{code}
...@@ -647,12 +634,6 @@ unknownSigErr (L loc sig) ...@@ -647,12 +634,6 @@ unknownSigErr (L loc sig)
where where
what_it_is = hsSigDoc sig what_it_is = hsSigDoc sig
missingSigWarn var
= addWarnAt (mkSrcSpan loc loc) $
sep [ptext SLIT("Definition but no type signature for"), quotes (ppr var)]
where
loc = nameSrcLoc var -- TODO: make a proper span
methodBindErr mbind methodBindErr mbind
= hang (ptext SLIT("Pattern bindings (except simple variables) not allowed in instance declarations")) = hang (ptext SLIT("Pattern bindings (except simple variables) not allowed in instance declarations"))
2 (ppr mbind) 2 (ppr mbind)
......
...@@ -337,7 +337,7 @@ tcPolyBinds top_lvl sig_fn prag_fn rec_group rec_tc binds ...@@ -337,7 +337,7 @@ tcPolyBinds top_lvl sig_fn prag_fn rec_group rec_tc binds
-- BUILD THE POLYMORPHIC RESULT IDs -- BUILD THE POLYMORPHIC RESULT IDs
; let dict_ids = map instToId dicts ; let dict_ids = map instToId dicts
; exports <- mapM (mkExport prag_fn tyvars_to_gen (map idType dict_ids)) ; exports <- mapM (mkExport top_lvl prag_fn tyvars_to_gen (map idType dict_ids))
mono_bind_infos mono_bind_infos
; let poly_ids = [poly_id | (_, poly_id, _, _) <- exports] ; let poly_ids = [poly_id | (_, poly_id, _, _) <- exports]
...@@ -352,7 +352,8 @@ tcPolyBinds top_lvl sig_fn prag_fn rec_group rec_tc binds ...@@ -352,7 +352,8 @@ tcPolyBinds top_lvl sig_fn prag_fn rec_group rec_tc binds
-------------- --------------
mkExport :: TcPragFun -> [TyVar] -> [TcType] -> MonoBindInfo mkExport :: TopLevelFlag -> TcPragFun -> [TyVar] -> [TcType]
-> MonoBindInfo
-> TcM ([TyVar], Id, Id, [LPrag]) -> TcM ([TyVar], Id, Id, [LPrag])
-- mkExport generates exports with -- mkExport generates exports with
-- zonked type variables, -- zonked type variables,
...@@ -365,8 +366,10 @@ mkExport :: TcPragFun -> [TyVar] -> [TcType] -> MonoBindInfo ...@@ -365,8 +366,10 @@ mkExport :: TcPragFun -> [TyVar] -> [TcType] -> MonoBindInfo
-- Pre-condition: the inferred_tvs are already zonked -- Pre-condition: the inferred_tvs are already zonked
mkExport prag_fn inferred_tvs dict_tys (poly_name, mb_sig, mono_id) mkExport top_lvl prag_fn inferred_tvs dict_tys (poly_name, mb_sig, mono_id)
= do { (tvs, poly_id) <- mk_poly_id mb_sig = do { warn_missing_sigs <- doptM Opt_WarnMissingSigs
; let warn = isTopLevel top_lvl && warn_missing_sigs
; (tvs, poly_id) <- mk_poly_id warn mb_sig
; poly_id' <- zonkId poly_id ; poly_id' <- zonkId poly_id
; prags <- tcPrags poly_id' (prag_fn poly_name) ; prags <- tcPrags poly_id' (prag_fn poly_name)
...@@ -376,9 +379,10 @@ mkExport prag_fn inferred_tvs dict_tys (poly_name, mb_sig, mono_id) ...@@ -376,9 +379,10 @@ mkExport prag_fn inferred_tvs dict_tys (poly_name, mb_sig, mono_id)
where where
poly_ty = mkForAllTys inferred_tvs (mkFunTys dict_tys (idType mono_id)) poly_ty = mkForAllTys inferred_tvs (mkFunTys dict_tys (idType mono_id))
mk_poly_id Nothing = return (inferred_tvs, mkLocalId poly_name poly_ty) mk_poly_id warn Nothing = do { missingSigWarn warn poly_name poly_ty
mk_poly_id (Just sig) = do { tvs <- mapM zonk_tv (sig_tvs sig) ; return (inferred_tvs, mkLocalId poly_name poly_ty) }
; return (tvs, sig_id sig) } mk_poly_id warn (Just sig) = do { tvs <- mapM zonk_tv (sig_tvs sig)
; return (tvs, sig_id sig) }
zonk_tv tv = do { ty <- zonkTcTyVar tv; return (tcGetTyVar "mkExport" ty) } zonk_tv tv = do { ty <- zonkTcTyVar tv; return (tcGetTyVar "mkExport" ty) }
...@@ -1144,4 +1148,13 @@ restrictedBindCtxtErr binder_names ...@@ -1144,4 +1148,13 @@ restrictedBindCtxtErr binder_names
genCtxt binder_names genCtxt binder_names
= ptext SLIT("When generalising the type(s) for") <+> pprBinders binder_names = ptext SLIT("When generalising the type(s) for") <+> pprBinders binder_names
missingSigWarn False name ty = return ()
missingSigWarn True name ty
= do { env0 <- tcInitTidyEnv
; let (env1, tidy_ty) = tidyOpenType env0 ty
; addWarnTcM (env1, mk_msg tidy_ty) }
where
mk_msg ty = vcat [ptext SLIT("Definition but no type signature for") <+> quotes (ppr name),
sep [ptext SLIT("Inferred type:") <+> ppr name <+> dcolon <+> ppr ty]]
\end{code} \end{code}
...@@ -725,9 +725,12 @@ checkTc False err = failWithTc err ...@@ -725,9 +725,12 @@ checkTc False err = failWithTc err
\begin{code} \begin{code}
addWarnTc :: Message -> TcM () addWarnTc :: Message -> TcM ()
addWarnTc msg addWarnTc msg = do { env0 <- tcInitTidyEnv
; addWarnTcM (env0, msg) }
addWarnTcM :: (TidyEnv, Message) -> TcM ()
addWarnTcM (env0, msg)
= do { ctxt <- getErrCtxt ; = do { ctxt <- getErrCtxt ;
env0 <- tcInitTidyEnv ;
ctxt_msgs <- do_ctxt env0 ctxt ; ctxt_msgs <- do_ctxt env0 ctxt ;
addWarn (vcat (msg : ctxt_to_use ctxt_msgs)) } addWarn (vcat (msg : ctxt_to_use ctxt_msgs)) }
......
...@@ -1006,7 +1006,8 @@ f foo = foo { x = 6 } ...@@ -1006,7 +1006,8 @@ f foo = foo { x = 6 }
<para>If you would like GHC to check that every top-level <para>If you would like GHC to check that every top-level
function/value has a type signature, use the function/value has a type signature, use the
<option>-fwarn-missing-signatures</option> option. This <option>-fwarn-missing-signatures</option> option. As part of
the warning GHC also reports the inferred type. The
option is off by default.</para> option is off by default.</para>
</listitem> </listitem>
</varlistentry> </varlistentry>
......
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