Commit cd290fc8 authored by simonpj@microsoft.com's avatar simonpj@microsoft.com
Browse files

Add the function TypeRep.pprTypeApp, and use it

  pprTypeApp :: SDoc -> [Type] -> SDoc
  pprTypeApp pp tys = hang pp 2 (sep (map pprParendType tys))
parent 604afcb5
......@@ -142,7 +142,8 @@ module GHC (
instanceDFunId, pprInstance, pprInstanceHdr,
-- ** Types and Kinds
Type, dropForAlls, splitForAllTys, funResultTy, pprParendType,
Type, dropForAlls, splitForAllTys, funResultTy,
pprParendType, pprTypeApp,
Kind,
PredType,
ThetaType, pprThetaArrow,
......@@ -189,6 +190,7 @@ import RdrName ( plusGlobalRdrEnv, Provenance(..),
import HscMain ( hscParseIdentifier, hscStmt, hscTcExpr, hscKcType )
import Name ( nameOccName )
import Type ( tidyType )
import Var ( varName )
import VarEnv ( emptyTidyEnv )
import GHC.Exts ( unsafeCoerce# )
......@@ -218,14 +220,14 @@ import RdrName ( GlobalRdrEnv, GlobalRdrElt(..), RdrName(..),
import HsSyn
import Type ( Kind, Type, dropForAlls, PredType, ThetaType,
pprThetaArrow, pprParendType, splitForAllTys,
funResultTy )
pprTypeApp, funResultTy )
import Id ( Id, idType, isImplicitId, isDeadBinder,
isExportedId, isLocalId, isGlobalId,
isRecordSelector, recordSelectorFieldLabel,
isPrimOpId, isFCallId, isClassOpId_maybe,
isDataConWorkId, idDataCon,
isBottomingId )
import Var ( TyVar, varName )
import Var ( TyVar )
import TysPrim ( alphaTyVars )
import TyCon ( TyCon, isClassTyCon, isSynTyCon, isNewTyCon,
isPrimTyCon, isFunTyCon, isOpenTyCon, tyConArity,
......
......@@ -158,7 +158,7 @@ pprDataConDecl exts gadt_style show_label dataCon
-- printing out the dataCon as a type signature, in GADT style
pp_tau = foldr add pp_res_ty tys_w_strs
pp_res_ty = ppr_bndr tyCon <+> hsep (map GHC.pprParendType res_tys)
pp_res_ty = GHC.pprTypeApp (ppr_bndr tyCon) res_tys
add (str,ty) pp_ty = pprBangTy str ty <+> arrow <+> pp_ty
pprParendBangTy (strict,ty)
......
......@@ -686,7 +686,7 @@ wrongThingErr expected thing name
ptext SLIT("used as a") <+> text expected)
famInstNotFound tycon tys what
= failWithTc (msg <+> quotes (ppr tycon <+> hsep (map pprParendType tys)))
= failWithTc (msg <+> quotes (pprTypeApp (ppr tycon) tys))
where
msg = ptext $ if length what > 1
then SLIT("More than one family instance for")
......
......@@ -122,7 +122,7 @@ module TcType (
tcTyVarsOfType, tcTyVarsOfTypes, exactTyVarsOfType, exactTyVarsOfTypes,
pprKind, pprParendKind,
pprType, pprParendType, pprTyThingCategory,
pprType, pprParendType, pprTypeApp, pprTyThingCategory,
pprPred, pprTheta, pprThetaArrow, pprClassPred
) where
......
......@@ -46,13 +46,19 @@ import Maybe
\begin{code}
data FamInst
= FamInst { fi_fam :: Name -- Family name
-- INVARIANT: fi_fam = case tyConFamInst_maybe fi_tycon of
-- Just (tc, tys) -> tc
-- Used for "rough matching"; same idea as for class instances
, fi_tcs :: [Maybe Name] -- Top of type args
-- INVARIANT: fi_tcs = roughMatchTcs is_tys
-- Used for "proper matching"; ditto
, fi_tvs :: TyVarSet -- Template tyvars for full match
, fi_tys :: [Type] -- Full arg types
-- INVARIANT: fi_tvs = tyConTyVars fi_tycon
-- fi_tys = case tyConFamInst_maybe fi_tycon of
-- Just (_, tys) -> tys
, fi_tycon :: TyCon -- Representation tycon
}
......@@ -82,8 +88,7 @@ pprFamInstHdr :: FamInst -> SDoc
pprFamInstHdr (FamInst {fi_fam = fam, fi_tys = tys, fi_tycon = tycon})
= pprTyConSort <+> pprHead
where
pprHead = parenSymOcc (getOccName fam) (ppr fam) <+>
sep (map pprParendType tys)
pprHead = pprTypeApp (parenSymOcc (getOccName fam) (ppr fam)) tys
pprTyConSort | isDataTyCon tycon = ptext SLIT("data instance")
| isNewTyCon tycon = ptext SLIT("newtype instance")
| isSynTyCon tycon = ptext SLIT("type instance")
......
......@@ -95,7 +95,7 @@ module Type (
substPred, substTyVar, substTyVars, substTyVarBndr, deShadowTy, lookupTyVar,
-- Pretty-printing
pprType, pprParendType, pprTyThingCategory, pprForAll,
pprType, pprParendType, pprTypeApp, pprTyThingCategory, pprForAll,
pprPred, pprTheta, pprThetaArrow, pprClassPred, pprKind, pprParendKind
) where
......@@ -611,11 +611,14 @@ tyConOrigHead tycon = case tyConFamInst_maybe tycon of
Just famInst -> famInst
-- Pretty prints a tycon, using the family instance in case of a
-- representation tycon.
pprSourceTyCon tycon | Just (repTyCon, tys) <- tyConFamInst_maybe tycon =
ppr $ repTyCon `TyConApp` tys -- can't be FunTyCon
| otherwise =
ppr tycon
-- representation tycon. For example
-- e.g. data T [a] = ...
-- In that case we want to print `T [a]', where T is the family TyCon
pprSourceTyCon tycon
| Just (repTyCon, tys) <- tyConFamInst_maybe tycon
= ppr $ repTyCon `TyConApp` tys -- can't be FunTyCon
| otherwise
= ppr tycon
\end{code}
......
......@@ -15,7 +15,8 @@ module TypeRep (
funTyCon,
-- Pretty-printing
pprType, pprParendType, pprTyThingCategory,
pprType, pprParendType, pprTypeApp,
pprTyThingCategory,
pprPred, pprTheta, pprForAll, pprThetaArrow, pprClassPred,
-- Kinds
......@@ -432,6 +433,9 @@ pprType, pprParendType :: Type -> SDoc
pprType ty = ppr_type TopPrec ty
pprParendType ty = ppr_type TyConPrec ty
pprTypeApp :: SDoc -> [Type] -> SDoc
pprTypeApp pp tys = hang pp 2 (sep (map pprParendType tys))
------------------
pprPred :: PredType -> SDoc
pprPred (ClassP cls tys) = pprClassPred cls tys
......@@ -439,8 +443,7 @@ pprPred (IParam ip ty) = ppr ip <> dcolon <> pprType ty
pprPred (EqPred ty1 ty2) = sep [ppr ty1, nest 2 (ptext SLIT("~")), ppr ty2]
pprClassPred :: Class -> [Type] -> SDoc
pprClassPred clas tys = parenSymOcc (getOccName clas) (ppr clas)
<+> sep (map pprParendType tys)
pprClassPred clas tys = pprTypeApp (parenSymOcc (getOccName clas) (ppr clas)) tys
pprTheta :: ThetaType -> SDoc
pprTheta theta = parens (sep (punctuate comma (map pprPred theta)))
......@@ -520,8 +523,7 @@ ppr_tc_app p tc tys
| isTupleTyCon tc && tyConArity tc == length tys
= tupleParens (tupleTyConBoxity tc) (sep (punctuate comma (map pprType tys)))
| otherwise
= maybeParen p TyConPrec $
ppr_tc tc <+> sep (map (ppr_type TyConPrec) tys)
= maybeParen p TyConPrec (pprTypeApp (ppr_tc tc) tys)
ppr_tc :: TyCon -> SDoc
ppr_tc tc = parenSymOcc (getOccName tc) (pp_nt_debug <> ppr tc)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment