+We need to take a little care if the field has a polymorphic type:
+
+ data R = R { f :: forall a. a->a }
+
+Then we want
+
+ f :: forall a. R -> a -> a
+ f = /\ a \ r = case r of
+ R f -> f a
+
+(not f :: R -> forall a. a->a, which gives the type inference mechanism
+problems at call sites)
+
+Similarly for newtypes
+
+ newtype N = MkN { unN :: forall a. a->a }
+
+ unN :: forall a. N -> a -> a
+ unN = /\a -> \n:N -> coerce (a->a) n
+
+\begin{code}
+mkRecordSelId tycon field_label unpack_id unpackUtf8_id
+ -- Assumes that all fields with the same field label have the same type
+ --
+ -- Annoyingly, we have to pass in the unpackCString# Id, because
+ -- we can't conjure it up out of thin air
+ = sel_id
+ where
+ sel_id = mkGlobalId (RecordSelId field_label) (fieldLabelName field_label) selector_ty info
+ field_ty = fieldLabelType field_label
+ data_cons = tyConDataCons tycon
+ tyvars = tyConTyVars tycon -- These scope over the types in
+ -- the FieldLabels of constructors of this type
+ data_ty = mkTyConApp tycon tyvar_tys
+ tyvar_tys = mkTyVarTys tyvars
+
+ tycon_theta = tyConTheta tycon -- The context on the data decl
+ -- eg data (Eq a, Ord b) => T a b = ...
+ dict_tys = [mkPredTy pred | pred <- tycon_theta,
+ needed_dict pred]
+ needed_dict pred = or [ tcEqPred pred p
+ | (DataAlt dc, _, _) <- the_alts, p <- dataConTheta dc]
+ n_dict_tys = length dict_tys
+
+ (field_tyvars,field_theta,field_tau) = tcSplitSigmaTy field_ty
+ field_dict_tys = map mkPredTy field_theta
+ n_field_dict_tys = length field_dict_tys
+ -- If the field has a universally quantified type we have to
+ -- be a bit careful. Suppose we have
+ -- data R = R { op :: forall a. Foo a => a -> a }
+ -- Then we can't give op the type
+ -- op :: R -> forall a. Foo a => a -> a
+ -- because the typechecker doesn't understand foralls to the
+ -- right of an arrow. The "right" type to give it is
+ -- op :: forall a. Foo a => R -> a -> a
+ -- But then we must generate the right unfolding too:
+ -- op = /\a -> \dfoo -> \ r ->
+ -- case r of
+ -- R op -> op a dfoo
+ -- Note that this is exactly the type we'd infer from a user defn
+ -- op (R op) = op
+
+ -- Very tiresomely, the selectors are (unnecessarily!) overloaded over
+ -- just the dictionaries in the types of the constructors that contain
+ -- the relevant field. Urgh.
+ -- NB: this code relies on the fact that DataCons are quantified over
+ -- the identical type variables as their parent TyCon
+
+ selector_ty :: Type
+ selector_ty = mkForAllTys tyvars $ mkForAllTys field_tyvars $
+ mkFunTys dict_tys $ mkFunTys field_dict_tys $
+ mkFunTy data_ty field_tau
+
+ arity = 1 + n_dict_tys + n_field_dict_tys
+
+ (strict_sig, rhs_w_str) = dmdAnalTopRhs sel_rhs
+ -- Use the demand analyser to work out strictness.
+ -- With all this unpackery it's not easy!
+
+ info = noCafNoTyGenIdInfo
+ `setCafInfo` caf_info
+ `setArityInfo` arity
+ `setUnfoldingInfo` mkTopUnfolding rhs_w_str
+ `setNewStrictnessInfo` Just strict_sig
+
+ -- Allocate Ids. We do it a funny way round because field_dict_tys is
+ -- almost always empty. Also note that we use length_tycon_theta
+ -- rather than n_dict_tys, because the latter gives an infinite loop:
+ -- n_dict tys depends on the_alts, which depens on arg_ids, which depends
+ -- on arity, which depends on n_dict tys. Sigh! Mega sigh!
+ field_dict_base = length tycon_theta + 1
+ dict_id_base = field_dict_base + n_field_dict_tys
+ field_base = dict_id_base + 1
+ dict_ids = mkTemplateLocalsNum 1 dict_tys
+ field_dict_ids = mkTemplateLocalsNum field_dict_base field_dict_tys
+ data_id = mkTemplateLocal dict_id_base data_ty
+