-%************************************************************************
-%* *
-\subsection{Converting from Type to HsType}
-%* *
-%************************************************************************
-
-@toHsType@ converts from a Type to a HsType, making the latter look as
-user-friendly as possible. Notably, it uses synonyms where possible, and
-expresses overloaded functions using the '=>' context part of a HsForAllTy.
-
-\begin{code}
-toHsTyVar :: TyVar -> HsTyVarBndr RdrName
-toHsTyVar tv = IfaceTyVar (toRdrName tv) (tyVarKind tv)
-
-toHsTyVars tvs = map toHsTyVar tvs
-
-toHsType :: Type -> HsType RdrName
-toHsType ty = toHsType' (unUsgTy ty)
- -- For now we just discard the usage
--- = case splitUsgTy ty of
--- (usg, tau) -> HsUsgTy (toHsUsg usg) (toHsType' tau)
-
-toHsType' :: Type -> HsType RdrName
--- Called after the usage is stripped off
--- This function knows the representation of types
-toHsType' (TyVarTy tv) = HsTyVar (toRdrName tv)
-toHsType' (FunTy arg res) = HsFunTy (toHsType arg) (toHsType res)
-toHsType' (AppTy fun arg) = HsAppTy (toHsType fun) (toHsType arg)
-
-toHsType' (NoteTy (SynNote ty) _) = toHsType ty -- Use synonyms if possible!!
-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 (toRdrName tc) (tupleTyConBoxity tc)) tys'
- | tc `hasKey` listTyConKey = HsListTy (head tys')
- | otherwise = generic_case
- where
- generic_case = foldl HsAppTy (HsTyVar (toRdrName 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)
-
-
-toHsPred (Class cls tys) = HsPClass (toRdrName cls) (map toHsType tys)
-toHsPred (IParam n ty) = HsPIParam (toRdrName n) (toHsType ty)
-
-toHsContext :: ClassContext -> HsContext RdrName
-toHsContext cxt = [HsPClass (toRdrName cls) (map toHsType tys) | (cls,tys) <- cxt]
-
-toHsUsg UsOnce = HsUsOnce
-toHsUsg UsMany = HsUsMany
-toHsUsg (UsVar v) = HsUsVar (toRdrName v)
-
-toHsFDs :: [FunDep TyVar] -> [FunDep RdrName]
-toHsFDs fds = [(map toRdrName ns, map toRdrName ms) | (ns,ms) <- fds]
-\end{code}
-
-
-%************************************************************************
-%* *
-\subsection{Comparison}
-%* *
-%************************************************************************
-
-\begin{code}
-instance Ord a => Eq (HsType a) where
- -- The Ord is needed because we keep a
- -- finite map of variables to variables
- (==) a b = eq_hsType emptyEqHsEnv a b
-
-instance Ord a => Eq (HsPred a) where
- (==) a b = eq_hsPred emptyEqHsEnv a b
-
-eqWithHsTyVars :: Ord name =>
- [HsTyVarBndr name] -> [HsTyVarBndr name]
- -> (EqHsEnv name -> Bool) -> Bool
-eqWithHsTyVars = eq_hsTyVars emptyEqHsEnv
-\end{code}
-
-\begin{code}
-type EqHsEnv n = FiniteMap n n
--- Tracks the mapping from L-variables to R-variables
-
-eq_hsVar :: Ord n => EqHsEnv n -> n -> n -> Bool
-eq_hsVar env n1 n2 = case lookupFM env n1 of
- Just n1 -> n1 == n2
- Nothing -> n1 == n2
-
-extendEqHsEnv env n1 n2
- | n1 == n2 = env
- | otherwise = addToFM env n1 n2
-
-emptyEqHsEnv :: EqHsEnv n
-emptyEqHsEnv = emptyFM
-\end{code}
-
-We do define a specialised equality for these \tr{*Type} types; used
-in checking interfaces.