- upp_uses (m, mv, has_orphans, whats_imported)
- = hsep [ptext SLIT("import"), pprModuleName m,
- int mv, pp_orphan,
- upp_import_versions whats_imported
- ] <> semi
- where
- pp_orphan | has_orphans = ptext SLIT("!")
- | otherwise = empty
-
- -- 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)
- = dcolon <+> hsep [ hsep [ppr_unqual_name n, int v] | (n,v) <- sort_versions nvs ]
-
-ifaceModuleDeps if_hdl [] = return ()
-ifaceModuleDeps if_hdl mod_deps
- = let
- lines = map ppr_mod_dep mod_deps
- ppr_mod_dep (mod, contains_orphans)
- | contains_orphans = pprModuleName mod <+> ptext SLIT("!")
- | otherwise = pprModuleName mod
- in
- printForIface if_hdl (ptext SLIT("__depends") <+> vcat lines <> ptext SLIT(" ;")) >>
- hPutStr if_hdl "\n"
-
-ifaceExports if_hdl [] = return ()
-ifaceExports if_hdl avails
- = hPutCol if_hdl do_one_module (fmToList export_fm)
+ 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) = splitSigmaTy (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 }
+
+ | 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 = 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
+ | isImplicitId id = so_far
+ | otherwise = iface_sig : so_far