+
+ -- GENERALISE
+ -- (it seems a bit crude to have to do getLIE twice,
+ -- but I can't see a better way just now)
+ addSrcLoc (minimum (map getSrcLoc binder_names)) $
+ addErrCtxt (genCtxt binder_names) $
+ getLIE (generalise binder_names mbind tau_tvs lie_req tc_ty_sigs)
+ `thenM` \ ((tc_tyvars_to_gen, dict_binds, dict_ids), lie_free) ->
+
+
+ -- 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.
+ mappM zonkTcTyVarToTyVar tc_tyvars_to_gen `thenM` \ 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
+ mappM zonkId dict_ids `thenM` \ zonked_dict_ids ->
+ mappM zonkId mono_ids `thenM` \ zonked_mono_ids ->
+
+ -- BUILD THE POLYMORPHIC RESULT IDs
+ let
+ exports = zipWith mk_export binder_names zonked_mono_ids
+ poly_ids = [poly_id | (_, poly_id, _) <- exports]
+ dict_tys = map idType zonked_dict_ids
+
+ inlines = mkNameSet [name | InlineSig True name _ loc <- sigs]
+ -- Any INLINE sig (regardless of phase control)
+ -- makes the RHS look small
+ inline_phases = listToFM [(name, phase) | InlineSig _ name phase _ <- sigs,
+ not (isAlwaysActive phase)]
+ -- Set the IdInfo field to control the inline phase
+ -- AlwaysActive is the default, so don't bother with them
+
+ mk_export binder_name zonked_mono_id
+ = (tyvars,
+ attachInlinePhase inline_phases 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, map idType poly_ids)) `thenM_`
+
+ -- Check for an unlifted, non-overloaded group
+ -- In that case we must make extra checks
+ if any (isUnLiftedType . idType) zonked_mono_ids && null zonked_dict_ids
+ then -- Some bindings are unlifted
+ checkUnliftedBinds top_lvl is_rec real_tyvars_to_gen mbind `thenM_`
+
+ extendLIEs lie_req `thenM_`
+ returnM (
+ AbsBinds [] [] exports inlines mbind',
+ -- Do not generate even any x=y bindings
+ poly_ids
+ )
+
+ else -- The normal case
+ extendLIEs lie_free `thenM_`
+ returnM (
+ AbsBinds real_tyvars_to_gen
+ zonked_dict_ids
+ exports
+ inlines
+ (dict_binds `andMonoBinds` mbind'),
+ poly_ids