+ -- TYPECHECK THE BINDINGS
+ tcMonoBinds mbind binder_names mono_ids tc_ty_sigs `thenTc` \ (mbind', lie) ->
+
+ -- CHECK THAT THE SIGNATURES MATCH
+ -- (must do this before getTyVarsToGen)
+ checkSigMatch tc_ty_sigs `thenTc` \ sig_theta ->
+
+ -- COMPUTE VARIABLES OVER WHICH TO QUANTIFY, namely tyvars_to_gen
+ -- 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) ->
+
+ -- DEAL WITH TYPE VARIABLE KINDS
+ 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
+ -- (real_tyvars_to_gen and real_tyvars_to_gen_list) is fully
+ -- zonked, *including boxity*, because they'll be included in the forall types of
+ -- the polymorphic Ids, and instances of these Ids will be generated from them.
+ --
+ -- Also NB that tcSimplify takes zonked tyvars as its arg, hence we pass
+ -- real_tyvars_to_gen
+ --
+ -- **** This step can do unification => keep other zonking after this ****
+ in
+
+ -- SIMPLIFY THE LIE
+ tcExtendGlobalTyVars tyvars_not_to_gen (
+ if null tc_ty_sigs then
+ -- No signatures, so just simplify the lie
+ -- NB: no signatures => no polymorphic recursion, so no
+ -- need to use mono_lies (which will be empty anyway)
+ tcSimplify real_tyvars_to_gen lie `thenTc` \ (lie_free, dict_binds, lie_bound) ->
+ returnTc (lie_free, dict_binds, map instToId (bagToList lie_bound))
+
+ else
+ zonkTcTheta sig_theta `thenNF_Tc` \ sig_theta' ->
+ newDicts SignatureOrigin sig_theta' `thenNF_Tc` \ (dicts_sig, dict_ids) ->
+ -- It's important that sig_theta is zonked, because
+ -- dict_id is later used to form the type of the polymorphic thing,
+ -- and forall-types must be zonked so far as their bound variables
+ -- are concerned
+
+ let
+ -- The "givens" is the stuff available. We get that from
+ -- the context of the type signature, BUT ALSO the mono_lie
+ -- so that polymorphic recursion works right (see comments at end of fn)
+ givens = dicts_sig `plusLIE` mono_lie
+ in
+
+ -- Check that the needed dicts can be expressed in
+ -- terms of the signature ones
+ tcAddErrCtxt (sigsCtxt tysig_names) $
+ tcSimplifyAndCheck real_tyvars_to_gen givens lie `thenTc` \ (lie_free, dict_binds) ->
+ returnTc (lie_free, dict_binds, dict_ids)
+
+ ) `thenTc` \ (lie_free, dict_binds, dicts_bound) ->
+
+ ASSERT( not (any (isUnboxedTypeKind . tyVarKind) real_tyvars_to_gen_list) )
+ -- The instCantBeGeneralised stuff in tcSimplify should have
+ -- already raised an error if we're trying to generalise an unboxed tyvar
+ -- (NB: unboxed tyvars are always introduced along with a class constraint)
+ -- and it's better done there because we have more precise origin information.
+ -- That's why we just use an ASSERT here.
+
+ -- BUILD THE POLYMORPHIC RESULT IDs
+ mapNF_Tc zonkTcType mono_id_tys `thenNF_Tc` \ zonked_mono_id_types ->
+ let
+ exports = zipWith3 mk_export binder_names mono_ids zonked_mono_id_types
+ dict_tys = map tcIdType dicts_bound
+
+ mk_export binder_name mono_id zonked_mono_id_ty
+ | maybeToBool maybe_sig = (sig_tyvars, TcId sig_poly_id, TcId mono_id)
+ | otherwise = (real_tyvars_to_gen_list, TcId poly_id, TcId mono_id)
+ where
+ maybe_sig = maybeSig tc_ty_sigs binder_name
+ Just (TySigInfo _ sig_poly_id sig_tyvars _ _ _) = maybe_sig
+ poly_id = mkUserId binder_name poly_ty (prag_info_fn binder_name)
+ 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
+ returnTc (
+ AbsBinds real_tyvars_to_gen_list
+ dicts_bound
+ exports
+ (dict_binds `AndMonoBinds` mbind'),
+ lie_free,
+ [poly_id | (_, TcId poly_id, _) <- exports]
+ )