+\begin{code}
+toHsTyVar :: TyVar -> HsTyVarBndr Name
+toHsTyVar tv = IfaceTyVar (getName tv) (tyVarKind tv)
+
+toHsTyVars tvs = map toHsTyVar tvs
+
+toHsType :: Type -> HsType Name
+-- This function knows the representation of types
+toHsType (TyVarTy tv) = HsTyVar (getName tv)
+toHsType (FunTy arg res) = HsFunTy (toHsType arg) (toHsType res)
+toHsType (AppTy fun arg) = HsAppTy (toHsType fun) (toHsType arg)
+
+toHsType (NoteTy (SynNote syn_ty) real_ty)
+ | syn_matches = toHsType syn_ty -- Use synonyms if possible!!
+ | otherwise =
+#ifdef DEBUG
+ pprTrace "WARNING: synonym info lost in .hi file for " (ppr syn_ty) $
+#endif
+ toHsType real_ty -- but drop it if not.
+ where
+ syn_matches = ty_from_syn == real_ty
+
+ TyConApp syn_tycon tyargs = syn_ty
+ (tyvars,ty) = getSynTyConDefn syn_tycon
+ ty_from_syn = substTy (mkTyVarSubst tyvars tyargs) ty
+
+ -- We only use the type synonym in the file if this doesn't cause
+ -- us to lose important information. This matters for usage
+ -- annotations. It's an issue if some of the args to the synonym
+ -- have arrows in them, or if the synonym's RHS has an arrow; for
+ -- example, with nofib/real/ebnf2ps/ in Parsers.using.
+
+ -- **! It would be nice if when this test fails we could still
+ -- write the synonym in as a Note, so we don't lose the info for
+ -- error messages, but it's too much work for right now.
+ -- KSW 2000-07.
+
+toHsType (NoteTy _ ty) = toHsType ty
+
+toHsType (PredTy p) = HsPredTy (toHsPred p)
+
+toHsType ty@(TyConApp tc tys) -- Must be saturated because toHsType's arg is of kind *
+ | not saturated = generic_case
+ | isTupleTyCon tc = HsTupleTy (HsTupCon (getName tc) (tupleTyConBoxity tc) (tyConArity tc)) tys'
+ | tc `hasKey` listTyConKey = HsListTy (head tys')
+ | tc `hasKey` usOnceTyConKey = hsUsOnce_Name -- must print !, . unqualified
+ | tc `hasKey` usManyTyConKey = hsUsMany_Name -- must print !, . unqualified
+ | otherwise = generic_case
+ where
+ generic_case = foldl HsAppTy (HsTyVar (getName tc)) tys'
+ tys' = map toHsType tys
+ saturated = length tys == tyConArity tc
+
+toHsType ty@(ForAllTy _ _) = case splitSigmaTy ty of
+ (tvs, preds, tau) -> HsForAllTy (Just (map toHsTyVar tvs))
+ (map toHsPred preds)
+ (toHsType tau)
+
+toHsType (UsageTy u ty) = HsUsageTy (toHsType u) (toHsType ty)
+ -- **! consider dropping usMany annotations ToDo KSW 2000-10
+
+
+toHsPred (Class cls tys) = HsPClass (getName cls) (map toHsType tys)
+toHsPred (IParam n ty) = HsPIParam (getName n) (toHsType ty)
+
+toHsContext :: ClassContext -> HsContext Name
+toHsContext cxt = [HsPClass (getName cls) (map toHsType tys) | (cls,tys) <- cxt]
+
+toHsFDs :: [FunDep TyVar] -> [FunDep Name]
+toHsFDs fds = [(map getName ns, map getName ms) | (ns,ms) <- fds]