X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fiface%2FIfaceType.lhs;h=e6049aa54097bed2fd91dcb9b4dd998d72281a9c;hb=cae75f82226638691cfa1e85fc168f4b65ddce4d;hp=5528a1b64f5b462728a558de855969172055a465;hpb=7fc749a43b4b6b85d234fa95d4928648259584f4;p=ghc-hetmet.git diff --git a/compiler/iface/IfaceType.lhs b/compiler/iface/IfaceType.lhs index 5528a1b..e6049aa 100644 --- a/compiler/iface/IfaceType.lhs +++ b/compiler/iface/IfaceType.lhs @@ -6,13 +6,6 @@ This module defines interface types and binders \begin{code} -{-# OPTIONS -w #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and fix --- any warnings in the module. See --- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings --- for details - module IfaceType ( IfaceType(..), IfaceKind, IfacePredType(..), IfaceTyCon(..), IfaceContext, IfaceBndr(..), IfaceTvBndr, IfaceIdBndr, IfaceCoercion, @@ -30,8 +23,6 @@ module IfaceType ( ) where -#include "HsVersions.h" - import TypeRep import TyCon import Var @@ -145,13 +136,15 @@ The precedence levels are: \end{description} \begin{code} -tOP_PREC = (0 :: Int) -- type in ParseIface.y -fUN_PREC = (1 :: Int) -- btype in ParseIface.y -tYCON_PREC = (2 :: Int) -- atype in ParseIface.y +tOP_PREC, fUN_PREC, tYCON_PREC :: Int +tOP_PREC = 0 -- type in ParseIface.y +fUN_PREC = 1 -- btype in ParseIface.y +tYCON_PREC = 2 -- atype in ParseIface.y noParens :: SDoc -> SDoc noParens pp = pp +maybeParen :: Int -> Int -> SDoc -> SDoc maybeParen ctxt_prec inner_prec pretty | ctxt_prec < inner_prec = pretty | otherwise = parens pretty @@ -168,6 +161,7 @@ instance Outputable IfaceBndr where pprIfaceBndrs :: [IfaceBndr] -> SDoc pprIfaceBndrs bs = sep (map ppr bs) +pprIfaceIdBndr :: (FastString, IfaceType) -> SDoc pprIfaceIdBndr (name, ty) = hsep [ppr name, dcolon, ppr ty] pprIfaceTvBndr :: IfaceTvBndr -> SDoc @@ -191,9 +185,9 @@ pprParendIfaceType = ppr_ty tYCON_PREC ppr_ty :: Int -> IfaceType -> SDoc -ppr_ty ctxt_prec (IfaceTyVar tyvar) = ppr tyvar +ppr_ty _ (IfaceTyVar tyvar) = ppr tyvar ppr_ty ctxt_prec (IfaceTyConApp tc tys) = ppr_tc_app ctxt_prec tc tys -ppr_ty ctxt_prec (IfacePredTy st) = ppr st +ppr_ty _ (IfacePredTy st) = ppr st -- Function types ppr_ty ctxt_prec (IfaceFunTy ty1 ty2) @@ -221,13 +215,14 @@ pprIfaceForAllPart tvs ctxt doc = sep [ppr_tvs, pprIfaceContext ctxt, doc] where ppr_tvs | null tvs = empty - | otherwise = ptext SLIT("forall") <+> pprIfaceTvBndrs tvs <> dot + | otherwise = ptext (sLit "forall") <+> pprIfaceTvBndrs tvs <> dot ------------------- -ppr_tc_app ctxt_prec tc [] = ppr_tc tc -ppr_tc_app ctxt_prec IfaceListTc [ty] = brackets (pprIfaceType ty) -ppr_tc_app ctxt_prec IfacePArrTc [ty] = pabrackets (pprIfaceType ty) -ppr_tc_app ctxt_prec (IfaceTupTc bx arity) tys +ppr_tc_app :: Int -> IfaceTyCon -> [IfaceType] -> SDoc +ppr_tc_app _ tc [] = ppr_tc tc +ppr_tc_app _ IfaceListTc [ty] = brackets (pprIfaceType ty) +ppr_tc_app _ IfacePArrTc [ty] = pabrackets (pprIfaceType ty) +ppr_tc_app _ (IfaceTupTc bx arity) tys | arity == length tys = tupleParens bx (sep (punctuate comma (map pprIfaceType tys))) ppr_tc_app ctxt_prec tc tys @@ -242,7 +237,7 @@ ppr_tc tc = ppr tc ------------------- instance Outputable IfacePredType where -- Print without parens - ppr (IfaceEqPred ty1 ty2)= hsep [ppr ty1, ptext SLIT(":=:"), ppr ty2] + ppr (IfaceEqPred ty1 ty2)= hsep [ppr ty1, ptext (sLit ":=:"), ppr ty2] ppr (IfaceIParam ip ty) = hsep [ppr ip, dcolon, ppr ty] ppr (IfaceClassP cls ts) = parenSymOcc (getOccName cls) (ppr cls) <+> sep (map pprParendIfaceType ts) @@ -255,13 +250,15 @@ instance Outputable IfaceTyCon where pprIfaceContext :: IfaceContext -> SDoc -- Prints "(C a, D b) =>", including the arrow pprIfaceContext [] = empty -pprIfaceContext theta = ppr_preds theta <+> ptext SLIT("=>") +pprIfaceContext theta = ppr_preds theta <+> ptext (sLit "=>") +ppr_preds :: [IfacePredType] -> SDoc ppr_preds [pred] = ppr pred -- No parens ppr_preds preds = parens (sep (punctuate comma (map ppr preds))) ------------------- -pabrackets p = ptext SLIT("[:") <> p <> ptext SLIT(":]") +pabrackets :: SDoc -> SDoc +pabrackets p = ptext (sLit "[:") <> p <> ptext (sLit ":]") \end{code} %************************************************************************ @@ -272,14 +269,19 @@ pabrackets p = ptext SLIT("[:") <> p <> ptext SLIT(":]") \begin{code} ---------------- +toIfaceTvBndr :: TyVar -> (FastString, IfaceType) toIfaceTvBndr tyvar = (occNameFS (getOccName tyvar), toIfaceKind (tyVarKind tyvar)) +toIfaceIdBndr :: Id -> (FastString, IfaceType) toIfaceIdBndr id = (occNameFS (getOccName id), toIfaceType (idType id)) +toIfaceTvBndrs :: [TyVar] -> [(FastString, IfaceType)] toIfaceTvBndrs tyvars = map toIfaceTvBndr tyvars +toIfaceBndr :: Var -> IfaceBndr toIfaceBndr var | isId var = IfaceIdBndr (toIfaceIdBndr var) | otherwise = IfaceTvBndr (toIfaceTvBndr var) +toIfaceKind :: Type -> IfaceType toIfaceKind = toIfaceType --------------------- @@ -297,8 +299,6 @@ toIfaceType (ForAllTy tv t) = IfaceForAllTy (toIfaceTvBndr tv) (toIfaceType t) toIfaceType (PredTy st) = IfacePredTy (toIfacePred st) -toIfaceType (NoteTy other_note ty) = - toIfaceType ty ---------------- -- A little bit of (perhaps optional) trickiness here. When @@ -336,9 +336,11 @@ toIfaceWiredInTyCon tc nm | otherwise = IfaceTc nm ---------------- +toIfaceTypes :: [Type] -> [IfaceType] toIfaceTypes ts = map toIfaceType ts ---------------- +toIfacePred :: PredType -> IfacePredType toIfacePred (ClassP cls ts) = IfaceClassP (getName cls) (toIfaceTypes ts) toIfacePred (IParam ip t) =