X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fiface%2FIfaceType.lhs;h=c97e16eef266c288f8503eec2261f95c0e5867ad;hb=edc0bafd3fcd01b85a2e8894e5dfe149eb0e0857;hp=8af258adbdd34f60f5457e5a01a9954e5b6e6e0e;hpb=49c98d143c382a1341e1046f5ca00819a25691ba;p=ghc-hetmet.git diff --git a/compiler/iface/IfaceType.lhs b/compiler/iface/IfaceType.lhs index 8af258a..c97e16e 100644 --- a/compiler/iface/IfaceType.lhs +++ b/compiler/iface/IfaceType.lhs @@ -7,7 +7,9 @@ This module defines interface types and binders \begin{code} module IfaceType ( - IfaceType(..), IfaceKind, IfacePredType(..), IfaceTyCon(..), + IfExtName, IfLclName, + + IfaceType(..), IfaceKind, IfacePredType(..), IfaceTyCon(..), IfaceContext, IfaceBndr(..), IfaceTvBndr, IfaceIdBndr, IfaceCoercion, ifaceTyConName, @@ -23,15 +25,12 @@ module IfaceType ( ) where -#include "HsVersions.h" - import TypeRep import TyCon +import Id import Var import TysWiredIn -import OccName import Name -import Module import BasicTypes import Outputable import FastString @@ -44,20 +43,24 @@ import FastString %************************************************************************ \begin{code} +type IfLclName = FastString -- A local name in iface syntax + +type IfExtName = Name -- An External or WiredIn Name can appear in IfaceSyn + -- (However Internal or System Names never should) + data IfaceBndr -- Local (non-top-level) binders = IfaceIdBndr {-# UNPACK #-} !IfaceIdBndr | IfaceTvBndr {-# UNPACK #-} !IfaceTvBndr -type IfaceIdBndr = (FastString, IfaceType) -type IfaceTvBndr = (FastString, IfaceKind) +type IfaceIdBndr = (IfLclName, IfaceType) +type IfaceTvBndr = (IfLclName, IfaceKind) ------------------------------- -type IfaceKind = IfaceType -- Re-use the Kind type, but no KindVars in it - +type IfaceKind = IfaceType type IfaceCoercion = IfaceType data IfaceType - = IfaceTyVar FastString -- Type variable only, not tycon + = IfaceTyVar IfLclName -- Type variable only, not tycon | IfaceAppTy IfaceType IfaceType | IfaceForAllTy IfaceTvBndr IfaceType | IfacePredTy IfacePredType @@ -66,37 +69,49 @@ data IfaceType | IfaceFunTy IfaceType IfaceType data IfacePredType -- NewTypes are handled as ordinary TyConApps - = IfaceClassP Name [IfaceType] + = IfaceClassP IfExtName [IfaceType] | IfaceIParam (IPName OccName) IfaceType | IfaceEqPred IfaceType IfaceType type IfaceContext = [IfacePredType] --- NB: If you add a data constructor, remember to add a case to --- IfaceSyn.eqIfTc! data IfaceTyCon -- Abbreviations for common tycons with known names - = IfaceTc Name -- The common case + = IfaceTc IfExtName -- The common case | IfaceIntTc | IfaceBoolTc | IfaceCharTc | IfaceListTc | IfacePArrTc | IfaceTupTc Boxity Arity + | IfaceAnyTc IfaceKind -- Used for AnyTyCon (see Note [Any Types] in TysPrim) + -- other than 'Any :: *' itself | IfaceLiftedTypeKindTc | IfaceOpenTypeKindTc | IfaceUnliftedTypeKindTc | IfaceUbxTupleKindTc | IfaceArgTypeKindTc -ifaceTyConName :: IfaceTyCon -> Name -ifaceTyConName IfaceIntTc = intTyConName -ifaceTyConName IfaceBoolTc = boolTyConName -ifaceTyConName IfaceCharTc = charTyConName -ifaceTyConName IfaceListTc = listTyConName -ifaceTyConName IfacePArrTc = parrTyConName -ifaceTyConName (IfaceTupTc bx ar) = getName (tupleTyCon bx ar) +ifaceTyConName :: IfaceTyCon -> IfExtName +ifaceTyConName IfaceIntTc = intTyConName +ifaceTyConName IfaceBoolTc = boolTyConName +ifaceTyConName IfaceCharTc = charTyConName +ifaceTyConName IfaceListTc = listTyConName +ifaceTyConName IfacePArrTc = parrTyConName +ifaceTyConName (IfaceTupTc bx ar) = getName (tupleTyCon bx ar) ifaceTyConName IfaceLiftedTypeKindTc = liftedTypeKindTyConName ifaceTyConName IfaceOpenTypeKindTc = openTypeKindTyConName ifaceTyConName IfaceUnliftedTypeKindTc = unliftedTypeKindTyConName ifaceTyConName IfaceUbxTupleKindTc = ubxTupleKindTyConName ifaceTyConName IfaceArgTypeKindTc = argTypeKindTyConName -ifaceTyConName (IfaceTc ext) = ext +ifaceTyConName (IfaceTc ext) = ext +ifaceTyConName (IfaceAnyTc k) = pprPanic "ifaceTyConName" (ppr k) + -- Note [The Name of an IfaceAnyTc] \end{code} +Note [The Name of an IfaceAnyTc] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +It isn't easy to get the Name of an IfaceAnyTc in a pure way. What you +really need to do is to transform it to a TyCon, and get the Name of that. +But doing so needs the monad because there's an IfaceKind inside, and we +need a Kind. + +In fact, ifaceTyConName is only used for instances and rules, and we don't +expect to instantiate those at these (internal-ish) Any types, so rather +than solve this potential problem now, I'm going to defer it until it happens! %************************************************************************ %* * @@ -140,13 +155,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 @@ -163,6 +180,7 @@ instance Outputable IfaceBndr where pprIfaceBndrs :: [IfaceBndr] -> SDoc pprIfaceBndrs bs = sep (map ppr bs) +pprIfaceIdBndr :: (IfLclName, IfaceType) -> SDoc pprIfaceIdBndr (name, ty) = hsep [ppr name, dcolon, ppr ty] pprIfaceTvBndr :: IfaceTvBndr -> SDoc @@ -178,14 +196,7 @@ pprIfaceTvBndrs tyvars = hsep (map pprIfaceTvBndr tyvars) \begin{code} --------------------------------- instance Outputable IfaceType where - ppr ty = pprIfaceTypeForUser ty - -pprIfaceTypeForUser ::IfaceType -> SDoc --- Drop top-level for-alls; if that's not what you want, use pprIfaceType dire -pprIfaceTypeForUser ty - = pprIfaceForAllPart [] theta (pprIfaceType tau) - where - (_tvs, theta, tau) = splitIfaceSigmaTy ty + ppr ty = pprIfaceType ty pprIfaceType, pprParendIfaceType ::IfaceType -> SDoc pprIfaceType = ppr_ty tOP_PREC @@ -193,9 +204,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) @@ -223,13 +234,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 @@ -244,26 +256,31 @@ 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) instance Outputable IfaceTyCon where - ppr (IfaceTc ext) = ppr ext - ppr other_tc = ppr (ifaceTyConName other_tc) + ppr (IfaceAnyTc k) = ptext (sLit "Any") <> pprParendIfaceType k + -- We can't easily get the Name of an IfaceAnyTc + -- (see Note [The Name of an IfaceAnyTc]) + -- so we fake it. It's only for debug printing! + ppr other_tc = ppr (ifaceTyConName other_tc) ------------------- 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 <+> darrow +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} %************************************************************************ @@ -274,14 +291,19 @@ pabrackets p = ptext SLIT("[:") <> p <> ptext SLIT(":]") \begin{code} ---------------- +toIfaceTvBndr :: TyVar -> (IfLclName, IfaceType) toIfaceTvBndr tyvar = (occNameFS (getOccName tyvar), toIfaceKind (tyVarKind tyvar)) +toIfaceIdBndr :: Id -> (IfLclName, IfaceType) toIfaceIdBndr id = (occNameFS (getOccName id), toIfaceType (idType id)) +toIfaceTvBndrs :: [TyVar] -> [(IfLclName, 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 --------------------- @@ -299,8 +321,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 @@ -313,6 +333,7 @@ toIfaceType (NoteTy other_note ty) = toIfaceTyCon :: TyCon -> IfaceTyCon toIfaceTyCon tc | isTupleTyCon tc = IfaceTupTc (tupleTyConBoxity tc) (tyConArity tc) + | isAnyTyCon tc = IfaceAnyTc (toIfaceKind (tyConKind tc)) | otherwise = toIfaceTyCon_name (tyConName tc) toIfaceTyCon_name :: Name -> IfaceTyCon @@ -324,7 +345,8 @@ toIfaceTyCon_name nm toIfaceWiredInTyCon :: TyCon -> Name -> IfaceTyCon toIfaceWiredInTyCon tc nm - | isTupleTyCon tc = IfaceTupTc (tupleTyConBoxity tc) (tyConArity tc) + | isTupleTyCon tc = IfaceTupTc (tupleTyConBoxity tc) (tyConArity tc) + | isAnyTyCon tc = IfaceAnyTc (toIfaceKind (tyConKind tc)) | nm == intTyConName = IfaceIntTc | nm == boolTyConName = IfaceBoolTc | nm == charTyConName = IfaceCharTc @@ -338,9 +360,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) =