+ sel_id = mkId (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 = [mkDictTy cls tys | (cls, tys) <- tycon_theta,
+ needed_dict (cls, tys)]
+ needed_dict pred = or [ pred `elem` (dataConTheta dc)
+ | (DataAlt dc, _, _) <- the_alts]
+ n_dict_tys = length dict_tys
+
+ (field_tyvars,field_theta,field_tau) = splitSigmaTy 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 => a -> a
+ -- But then we must generat 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
+ info = mkIdInfo (RecordSelId field_label) caf_info
+ `setArityInfo` exactArity arity