import TcEnv ( tcExtendLocalValEnv,
newSpecPragmaId, newLocalId
)
-import TcSimplify ( tcSimplifyInfer, tcSimplifyInferCheck, tcSimplifyCheck, tcSimplifyToDicts )
+import TcSimplify ( tcSimplifyInfer, tcSimplifyInferCheck, tcSimplifyCheck, tcSimplifyRestricted, tcSimplifyToDicts )
import TcMonoType ( tcHsSigType, checkSigTyVars,
TcSigInfo(..), tcTySig, maybeSig, sigCtxt
)
import TcUnify ( unifyTauTy, unifyTauTyLists )
import CoreFVs ( idFreeTyVars )
-import Id ( mkVanillaId, setInlinePragma )
+import Id ( mkLocalId, setInlinePragma )
import Var ( idType, idName )
import IdInfo ( InlinePragInfo(..) )
import Name ( Name, getOccName, getSrcLoc )
poly_ids = map mk_dummy binder_names
mk_dummy name = case maybeSig tc_ty_sigs name of
Just (TySigInfo _ poly_id _ _ _ _ _ _) -> poly_id -- Signature
- Nothing -> mkVanillaId name forall_a_a -- No signature
+ Nothing -> mkLocalId name forall_a_a -- No signature
in
returnTc (EmptyMonoBinds, emptyLIE, poly_ids)
) $
(sig_tyvars, sig_poly_id)
Nothing -> (real_tyvars_to_gen, new_poly_id)
- new_poly_id = mkVanillaId binder_name poly_ty
+ new_poly_id = mkLocalId binder_name poly_ty
poly_ty = mkForAllTys real_tyvars_to_gen
$ mkFunTys dict_tys
$ idType zonked_mono_id
-- at all.
in
+ traceTc (text "binding:" <+> ppr ((zonked_dict_ids, dict_binds),
+ exports, [idType poly_id | (_, poly_id, _) <- exports])) `thenTc_`
+
-- BUILD RESULTS
returnTc (
- -- pprTrace "binding.." (ppr ((zonked_dict_ids, dict_binds),
- -- exports, [idType poly_id | (_, poly_id, _) <- exports])) $
AbsBinds real_tyvars_to_gen
zonked_dict_ids
exports
-----------------------
| null sigs
= -- INFERENCE CASE: Unrestricted group, no type signatures
- tcSimplifyInfer doc
- tau_tvs lie_req
+ tcSimplifyInfer doc tau_tvs lie_req
-----------------------
| otherwise
-- Now simplify with exactly that set of tyvars
-- We have to squash those Methods
- tcSimplifyCheck doc final_forall_tvs [] lie_req `thenTc` \ (lie_free, binds) ->
+ tcSimplifyRestricted doc final_forall_tvs [] lie_req `thenTc` \ (lie_free, binds) ->
returnTc (final_forall_tvs, lie_free, binds, [])
tysig_names = [name | (TySigInfo name _ _ _ _ _ _ _) <- sigs]
- doc | null sigs = ptext SLIT("banding(s) for") <+> pprBinders binder_names
- | otherwise = ptext SLIT("type signature(s) for") <+> pprBinders binder_names
+ doc = ptext SLIT("type signature(s) for") <+> pprBinders binder_names
-----------------------
-- CHECK THAT ALL THE SIGNATURE CONTEXTS ARE UNIFIABLE
ptext SLIT("that falls under the monomorphism restriction")])
-- Used in error messages
-pprBinders bndrs = braces (pprWithCommas ppr bndrs)
+pprBinders bndrs = pprWithCommas ppr bndrs
\end{code}