\section[TcBinds]{TcBinds}
\begin{code}
-module TcBinds ( tcBindsAndThen, tcTopBindsAndThen,
+module TcBinds ( tcBindsAndThen, tcTopBindsAndThen, bindInstsOfLocalFuns,
tcPragmaSigs, checkSigTyVars, tcBindWithSigs,
sigCtxt, TcSigInfo(..) ) where
import HsSyn ( HsExpr(..), HsBinds(..), MonoBinds(..), Sig(..), InPat(..),
collectMonoBinders, andMonoBinds
)
-import RnHsSyn ( RenamedHsBinds, RenamedSig(..),
- RenamedMonoBinds
- )
+import RnHsSyn ( RenamedHsBinds, RenamedSig, RenamedMonoBinds )
import TcHsSyn ( TcHsBinds, TcMonoBinds,
TcIdOcc(..), TcIdBndr,
tcIdType
-- The tyvars_not_to_gen are free in the environment, and hence
-- candidates for generalisation, but sometimes the monomorphism
-- restriction means we can't generalise them nevertheless
- getTyVarsToGen is_unrestricted mono_id_tys lie `thenTc` \ (tyvars_not_to_gen, tyvars_to_gen) ->
+ getTyVarsToGen is_unrestricted mono_id_tys lie `thenNF_Tc` \ (tyvars_not_to_gen, tyvars_to_gen) ->
-- DEAL WITH TYPE VARIABLE KINDS
-- **** This step can do unification => keep other zonking after this ****
- mapTc defaultUncommittedTyVar (tyVarSetToList tyvars_to_gen) `thenTc` \ real_tyvars_to_gen_list ->
+ mapTc defaultUncommittedTyVar (tyVarSetToList tyvars_to_gen) `thenTc` \ real_tyvars_to_gen_list ->
let
real_tyvars_to_gen = mkTyVarSet real_tyvars_to_gen_list
-- It's important that the final list
--
-- Also NB that tcSimplify takes zonked tyvars as its arg, hence we pass
-- real_tyvars_to_gen
- --
in
-- SIMPLIFY THE LIE
mk_export binder_name mono_id zonked_mono_id_ty
= (tyvars, TcId (replaceIdInfo poly_id (prag_info_fn binder_name)), TcId mono_id)
where
- (tyvars, poly_id) = case maybeSig tc_ty_sigs binder_name of
- Just (TySigInfo _ sig_poly_id sig_tyvars _ _ _) -> (sig_tyvars, sig_poly_id)
- Nothing -> (real_tyvars_to_gen_list, new_poly_id)
+ (tyvars, poly_id) =
+ case maybeSig tc_ty_sigs binder_name of
+ Just (TySigInfo _ sig_poly_id sig_tyvars _ _ _) -> (sig_tyvars, sig_poly_id)
+ Nothing -> (real_tyvars_to_gen_list, new_poly_id)
new_poly_id = mkUserId binder_name poly_ty
- poly_ty = mkForAllTys real_tyvars_to_gen_list $ mkFunTys dict_tys $ zonked_mono_id_ty
- -- It's important to build a fully-zonked poly_ty, because
- -- we'll slurp out its free type variables when extending the
- -- local environment (tcExtendLocalValEnv); if it's not zonked
- -- it appears to have free tyvars that aren't actually free at all.
+ poly_ty = mkForAllTys real_tyvars_to_gen_list $ mkFunTys dict_tys zonked_mono_id_ty
+ -- It's important to build a fully-zonked poly_ty, because
+ -- we'll slurp out its free type variables when extending the
+ -- local environment (tcExtendLocalValEnv); if it's not zonked
+ -- it appears to have free tyvars that aren't actually free at all.
in
-- BUILD RESULTS
in
if is_unrestricted
then
- returnTc (emptyTyVarSet, tyvars_to_gen)
+ returnNF_Tc (emptyTyVarSet, tyvars_to_gen)
else
+ -- This recover and discard-errs is to avoid duplicate error
+ -- messages; this, after all, is an "extra" call to tcSimplify
+ recoverNF_Tc (returnNF_Tc (emptyTyVarSet, tyvars_to_gen)) $
+ discardErrsTc $
+
tcSimplify (text "getTVG") NotTopLevel tyvars_to_gen lie `thenTc` \ (_, _, constrained_dicts) ->
let
-- ASSERT: dicts_sig is already zonked!
tcPragmaSig (InlineSig name loc)
= returnTc (Just (name, setInlinePragInfo IWantToBeINLINEd), EmptyMonoBinds, emptyLIE)
+tcPragmaSig (NoInlineSig name loc)
+ = returnTc (Just (name, setInlinePragInfo IDontWantToBeINLINEd), EmptyMonoBinds, emptyLIE)
+
tcPragmaSig (SpecSig name poly_ty maybe_spec_name src_loc)
= -- SPECIALISE f :: forall b. theta => tau = g
tcAddSrcLoc src_loc $
tcExpr (HsVar name) sig_ty `thenTc` \ (spec_expr, spec_lie) ->
case maybe_spec_name of
- Nothing -> -- Just specialise "f" by building a pecPragmaId binding
+ Nothing -> -- Just specialise "f" by building a SpecPragmaId binding
-- It is the thing that makes sure we don't prematurely
-- dead-code-eliminate the binding we are really interested in.
newSpecPragmaId name sig_ty `thenNF_Tc` \ spec_id ->