+ifaceTyCls :: TyThing -> [RenamedTyClDecl] -> [RenamedTyClDecl]
+ifaceTyCls (AClass clas) so_far
+ = cls_decl : so_far
+ where
+ cls_decl = ClassDecl (toHsContext sc_theta)
+ (getName clas)
+ (toHsTyVars clas_tyvars)
+ (toHsFDs clas_fds)
+ (map toClassOpSig op_stuff)
+ EmptyMonoBinds
+ [] noSrcLoc
+
+ (clas_tyvars, clas_fds, sc_theta, _, op_stuff) = classExtraBigSig clas
+
+ toClassOpSig (sel_id, def_meth)
+ = ASSERT(sel_tyvars == clas_tyvars)
+ ClassOpSig (getName sel_id) (Just def_meth') (toHsType op_ty) noSrcLoc
+ where
+ (sel_tyvars, _, op_ty) = splitSigmaTy (idType sel_id)
+ def_meth' = case def_meth of
+ NoDefMeth -> NoDefMeth
+ GenDefMeth -> GenDefMeth
+ DefMeth id -> DefMeth (getName id)
+
+ifaceTyCls (ATyCon tycon) so_far
+ = ty_decl : so_far
+
+ where
+ ty_decl | isSynTyCon tycon
+ = TySynonym (getName tycon)(toHsTyVars tyvars)
+ (toHsType syn_ty) noSrcLoc
+
+ | isAlgTyCon tycon
+ = TyData new_or_data (toHsContext (tyConTheta tycon))
+ (getName tycon)
+ (toHsTyVars tyvars)
+ (map ifaceConDecl (tyConDataCons tycon))
+ (tyConFamilySize tycon)
+ Nothing noSrcLoc (panic "gen1") (panic "gen2")
+
+ | otherwise = pprPanic "ifaceTyCls" (ppr tycon)
+
+ tyvars = tyConTyVars tycon
+ (_, syn_ty) = getSynTyConDefn tycon
+ new_or_data | isNewTyCon tycon = NewType
+ | otherwise = DataType
+
+ ifaceConDecl data_con
+ = ConDecl (getName data_con) (error "ifaceConDecl")
+ (toHsTyVars ex_tyvars)
+ (toHsContext ex_theta)
+ details noSrcLoc
+ where
+ (tyvars1, _, ex_tyvars, ex_theta, arg_tys, tycon1) = dataConSig data_con
+ field_labels = dataConFieldLabels data_con
+ strict_marks = dataConStrictMarks data_con
+ details | null field_labels
+ = ASSERT( tycon == tycon1 && tyvars == tyvars1 )
+ VanillaCon (zipWith mk_bang_ty strict_marks arg_tys)
+
+ | otherwise
+ = RecCon (zipWith mk_field strict_marks field_labels)
+
+ mk_bang_ty NotMarkedStrict ty = Unbanged (toHsType ty)
+ mk_bang_ty (MarkedUnboxed _ _) ty = Unpacked (toHsType ty)
+ mk_bang_ty MarkedStrict ty = Banged (toHsType ty)
+
+ mk_field strict_mark field_label
+ = ([getName field_label], mk_bang_ty strict_mark (fieldLabelType field_label))
+
+ifaceTyCls (AnId id) so_far
+ | omitIfaceSigForId id = so_far
+ | otherwise = iface_sig : so_far
+ where
+ iface_sig = IfaceSig (getName id) (toHsType id_type) hs_idinfo noSrcLoc
+
+ id_type = idType id
+ id_info = idInfo id
+
+ hs_idinfo | opt_OmitInterfacePragmas = []
+ | otherwise = arity_hsinfo ++ caf_hsinfo ++ cpr_hsinfo ++
+ strict_hsinfo ++ wrkr_hsinfo ++ unfold_hsinfo
+
+ ------------ Arity --------------
+ arity_hsinfo = case arityInfo id_info of
+ a@(ArityExactly n) -> [HsArity a]
+ other -> []
+
+ ------------ Caf Info --------------
+ caf_hsinfo = case cafInfo id_info of
+ NoCafRefs -> [HsNoCafRefs]
+ otherwise -> []
+
+ ------------ CPR Info --------------
+ cpr_hsinfo = case cprInfo id_info of
+ ReturnsCPR -> [HsCprInfo]
+ NoCPRInfo -> []
+
+ ------------ Strictness --------------
+ strict_hsinfo = case strictnessInfo id_info of
+ NoStrictnessInfo -> []
+ info -> [HsStrictness info]
+
+
+ ------------ Worker --------------
+ wrkr_hsinfo = case workerInfo id_info of
+ HasWorker work_id wrap_arity -> [HsWorker (getName work_id)]
+ NoWorker -> []
+
+ ------------ Unfolding --------------
+ unfold_info = unfoldingInfo id_info
+ inline_prag = inlinePragInfo id_info
+ rhs = unfoldingTemplate unfold_info
+ unfold_hsinfo | neverUnfold unfold_info = []
+ | otherwise = [HsUnfold inline_prag (toUfExpr rhs)]