+ returnTc (EmptyMonoBinds, emptyLIE, poly_ids)
+ ) $
+
+ -- TYPECHECK THE BINDINGS
+ tcMonoBinds mbind tc_ty_sigs is_rec `thenTc` \ (mbind', lie_req, binder_names, mono_ids) ->
+ let
+ tau_tvs = foldr (unionVarSet . tyVarsOfType . idType) emptyVarSet mono_ids
+ in
+
+ -- GENERALISE
+ tcAddSrcLoc (minimum (map getSrcLoc binder_names)) $
+ tcAddErrCtxt (genCtxt binder_names) $
+ generalise binder_names mbind tau_tvs lie_req tc_ty_sigs
+ `thenTc` \ (tc_tyvars_to_gen, lie_free, dict_binds, dict_ids) ->
+
+
+ -- ZONK THE GENERALISED TYPE VARIABLES TO REAL TyVars
+ -- This commits any unbound kind variables to boxed kind, by unification
+ -- It's important that the final quanfified type variables
+ -- are fully zonked, *including boxity*, because they'll be
+ -- included in the forall types of the polymorphic Ids.
+ -- At calls of these Ids we'll instantiate fresh type variables from
+ -- them, and we use their boxity then.
+ mapNF_Tc zonkTcTyVarToTyVar tc_tyvars_to_gen `thenNF_Tc` \ real_tyvars_to_gen ->
+
+ -- ZONK THE Ids
+ -- It's important that the dict Ids are zonked, including the boxity set
+ -- in the previous step, because they are later used to form the type of
+ -- the polymorphic thing, and forall-types must be zonked so far as
+ -- their bound variables are concerned
+ mapNF_Tc zonkId dict_ids `thenNF_Tc` \ zonked_dict_ids ->
+ mapNF_Tc zonkId mono_ids `thenNF_Tc` \ zonked_mono_ids ->
+
+ -- CHECK FOR BOGUS UNLIFTED BINDINGS
+ checkUnliftedBinds top_lvl is_rec real_tyvars_to_gen mbind zonked_mono_ids `thenTc_`
+
+ -- BUILD THE POLYMORPHIC RESULT IDs
+ let
+ exports = zipWith mk_export binder_names zonked_mono_ids
+ dict_tys = map idType zonked_dict_ids
+
+ inlines = mkNameSet [name | InlineSig name _ loc <- inline_sigs]
+ no_inlines = listToFM ([(name, IMustNotBeINLINEd False phase) | NoInlineSig name phase loc <- inline_sigs] ++
+ [(name, IMustNotBeINLINEd True phase) | InlineSig name phase loc <- inline_sigs, maybeToBool phase])
+ -- "INLINE n foo" means inline foo, but not until at least phase n
+ -- "NOINLINE n foo" means don't inline foo until at least phase n, and even
+ -- then only if it is small enough etc.
+ -- "NOINLINE foo" means don't inline foo ever, which we signal with a (IMustNotBeINLINEd Nothing)
+ -- See comments in CoreUnfold.blackListed for the Authorised Version
+
+ mk_export binder_name zonked_mono_id
+ = (tyvars,
+ attachNoInlinePrag no_inlines poly_id,
+ zonked_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, new_poly_id)
+
+ new_poly_id = mkLocalId binder_name poly_ty
+ poly_ty = mkForAllTys real_tyvars_to_gen
+ $ mkFunTys dict_tys
+ $ idType zonked_mono_id
+ -- 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
+
+ traceTc (text "binding:" <+> ppr ((zonked_dict_ids, dict_binds),
+ exports, [idType poly_id | (_, poly_id, _) <- exports])) `thenTc_`
+
+ -- BUILD RESULTS
+ returnTc (
+ AbsBinds real_tyvars_to_gen
+ zonked_dict_ids
+ exports
+ inlines
+ (dict_binds `andMonoBinds` mbind'),
+ lie_free,
+ [poly_id | (_, poly_id, _) <- exports]