- -- Importing the whole module is indicated by an empty list
- upp_import_versions Everything = empty
-
- -- For imported versions we do print the version number
- upp_import_versions (Specifically nvs)
- = hsep [ hsep [ppr_unqual_name n, int v] | (n,v) <- sort_versions nvs ]
-
-ifaceInstanceModules if_hdl [] = return ()
-ifaceInstanceModules if_hdl imods
- = let sorted = sortLt (<) imods
- lines = map (\m -> ptext SLIT("__instimport ") <> pprModule m <>
- ptext SLIT(" ;")) sorted
- in
- printForIface if_hdl (vcat lines) >>
- hPutStr if_hdl "\n"
-
-ifaceExports if_hdl [] = return ()
-ifaceExports if_hdl avails
- = hPutCol if_hdl do_one_module (fmToList export_fm)
+\begin{code}
+ifaceTyCls :: TyThing -> [RenamedTyClDecl] -> [RenamedTyClDecl]
+ifaceTyCls (AClass clas) so_far
+ = cls_decl : so_far
+ where
+ cls_decl = ClassDecl { tcdCtxt = toHsContext sc_theta,
+ tcdName = getName clas,
+ tcdTyVars = toHsTyVars clas_tyvars,
+ tcdFDs = toHsFDs clas_fds,
+ tcdSigs = map toClassOpSig op_stuff,
+ tcdMeths = Nothing,
+ tcdSysNames = sys_names,
+ tcdLoc = noSrcLoc }
+
+ (clas_tyvars, clas_fds, sc_theta, sc_sels, op_stuff) = classExtraBigSig clas
+ tycon = classTyCon clas
+ data_con = head (tyConDataCons tycon)
+ sys_names = mkClassDeclSysNames (getName tycon, getName data_con,
+ getName (dataConId data_con), map getName sc_sels)
+
+ toClassOpSig (sel_id, def_meth)
+ = ASSERT(sel_tyvars == clas_tyvars)
+ ClassOpSig (getName sel_id) def_meth' (toHsType op_ty) noSrcLoc
+ where
+ (sel_tyvars, _, op_ty) = tcSplitSigmaTy (idType sel_id)
+ def_meth' = case def_meth of
+ NoDefMeth -> NoDefMeth
+ GenDefMeth -> GenDefMeth
+ DefMeth id -> DefMeth (getName id)
+
+ifaceTyCls (ATyCon tycon) so_far
+ | isClassTyCon tycon = so_far
+ | otherwise = ty_decl : so_far
+ where
+ ty_decl | isSynTyCon tycon
+ = TySynonym { tcdName = getName tycon,
+ tcdTyVars = toHsTyVars tyvars,
+ tcdSynRhs = toHsType syn_ty,
+ tcdLoc = noSrcLoc }
+
+ | isAlgTyCon tycon
+ = TyData { tcdND = new_or_data,
+ tcdCtxt = toHsContext (tyConTheta tycon),
+ tcdName = getName tycon,
+ tcdTyVars = toHsTyVars tyvars,
+ tcdCons = map ifaceConDecl (tyConDataCons tycon),
+ tcdNCons = tyConFamilySize tycon,
+ tcdDerivs = Nothing,
+ tcdSysNames = map getName (tyConGenIds tycon),
+ tcdLoc = noSrcLoc }
+
+ | isForeignTyCon tycon
+ = ForeignType { tcdName = getName tycon,
+ tcdFoType = DNType, -- The only case at present
+ tcdLoc = noSrcLoc }
+
+ | 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) (getName (dataConId data_con))
+ (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 = drop (length ex_theta) (dataConStrictMarks data_con)
+ -- The 'drop' is because dataConStrictMarks
+ -- includes the existential dictionaries
+ details | null field_labels
+ = ASSERT( tycon == tycon1 && tyvars == tyvars1 )
+ VanillaCon (zipWith BangType strict_marks (map toHsType arg_tys))
+
+ | otherwise
+ = RecCon (zipWith mk_field strict_marks field_labels)
+
+ mk_field strict_mark field_label
+ = ([getName field_label], BangType strict_mark (toHsType (fieldLabelType field_label)))
+
+ifaceTyCls (AnId id) so_far
+ | isImplicitId id = so_far
+ | otherwise = iface_sig : so_far