Commit 5f349fe2 authored by Simon Peyton Jones's avatar Simon Peyton Jones

Improve pretty-printing of types

In this commit
   commit 6c0f10fa
   Author: Ben Gamari <bgamari.foss@gmail.com>
   Date:   Sun Nov 13 16:17:37 2016 -0500

    Kill Type pretty-printer

we switched to pretty-printing a type by converting it to an
IfaceType and pretty printing that.  Very good.

This patch fixes two things

* The new story is terrible for debug-printing with -ddump-tc-trace,
  because all the extra info in an open type was discarded ty the
  conversion to IfaceType.

  This patch adds IfaceTcTyVar to IfaceType, to carry a TcTyVar in
  debug situations.  Quite an easy change, happily.  These things
  never show up in interface files.

* Now that we are going via IfaceType, it's essential to tidy before
  converting; otherwise
     forall k_23 k_34. blah
  is printed as
     forall k k. blah
  which is very unhelpful.  Again this only shows up in debug
  printing.
parent 12eff239
......@@ -617,7 +617,8 @@ rnIfaceIdDetails (IfRecSelId (Right decl) b) = IfRecSelId <$> fmap Right (rnIfac
rnIfaceIdDetails details = pure details
rnIfaceType :: Rename IfaceType
rnIfaceType (IfaceTyVar n) = pure (IfaceTyVar n)
rnIfaceType (IfaceTcTyVar n) = pure (IfaceTcTyVar n)
rnIfaceType (IfaceTyVar n) = pure (IfaceTyVar n)
rnIfaceType (IfaceAppTy t1 t2)
= IfaceAppTy <$> rnIfaceType t1 <*> rnIfaceType t2
rnIfaceType (IfaceLitTy l) = return (IfaceLitTy l)
......
......@@ -62,7 +62,6 @@ import Fingerprint
import Binary
import BooleanFormula ( BooleanFormula, pprBooleanFormula, isTrue )
import Var( TyVarBndr(..) )
import Type ( TyPrec(..) )
import TyCon ( Role (..), Injectivity(..), HowAbstract(..) )
import StaticFlags (opt_PprStyle_Debug)
import Util( filterOut, filterByList )
......@@ -1286,6 +1285,7 @@ freeNamesIfTcArgs (ITC_Invis k ks) = freeNamesIfKind k &&& freeNamesIfTcArgs ks
freeNamesIfTcArgs ITC_Nil = emptyNameSet
freeNamesIfType :: IfaceType -> NameSet
freeNamesIfType (IfaceTcTyVar _) = emptyNameSet
freeNamesIfType (IfaceTyVar _) = emptyNameSet
freeNamesIfType (IfaceAppTy s t) = freeNamesIfType s &&& freeNamesIfType t
freeNamesIfType (IfaceTyConApp tc ts) = freeNamesIfTc tc &&& freeNamesIfTcArgs ts
......
......@@ -110,7 +110,8 @@ data IfaceOneShot -- See Note [Preserve OneShotInfo] in CoreTicy
type IfaceKind = IfaceType
data IfaceType -- A kind of universal type, used for types and kinds
= IfaceTyVar IfLclName -- Type/coercion variable only, not tycon
= IfaceTcTyVar TyVar -- See Note [TcTyVars in IfaceType]
| IfaceTyVar IfLclName -- Type/coercion variable only, not tycon
| IfaceLitTy IfaceTyLit
| IfaceAppTy IfaceType IfaceType
| IfaceFunTy IfaceType IfaceType
......@@ -185,10 +186,28 @@ data IfaceTyConSort = IfaceNormalTyCon -- ^ a regular tycon
-- details.
deriving (Eq)
{-
{- Note [TcTyVars in IfaceType]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Nowadays (since Nov 16) we pretty-print a Type by converting to an
IfaceType and pretty printing that. This eliminates a lot of
pretty-print duplication, and it matches what we do with
pretty-printing TyThings.
It works fine for closed types, but when printing debug traces (e.g.
when using -ddump-tc-trace) we print a lot of /open/ types. These
types are full of TcTyVars, and it's absolutely crucial to print them
in their full glory, with their unique, TcTyVarDetails etc.
So we simply embed a TcTyVar in IfaceType with the IfaceTcTyVar constructor.
Note that:
* We never expect to serialise an IfaceTcTyVar into an interface file, nor
to deserialise one. IfaceTcTyVar is used only in the "convert to IfaceType
and then pretty-print" pipeline.
Note [Equality predicates in IfaceType]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
GHC has several varieties of type equality (see Note [The equality types story]
in TysPrim for details) which all must be rendered with different surface syntax
during pretty-printing. Which syntax we use depends upon,
......@@ -356,6 +375,7 @@ substIfaceType :: IfaceTySubst -> IfaceType -> IfaceType
substIfaceType env ty
= go ty
where
go (IfaceTcTyVar tv) = IfaceTcTyVar tv
go (IfaceTyVar tv) = substIfaceTyVar env tv
go (IfaceAppTy t1 t2) = IfaceAppTy (go t1) (go t2)
go (IfaceFunTy t1 t2) = IfaceFunTy (go t1) (go t2)
......@@ -453,6 +473,8 @@ extendIfRnEnv2 IRV2 { ifenvL = lenv
-- See Note [No kind check in ifaces]
eqIfaceType :: IfRnEnv2 -> IfaceType -> IfaceType -> Bool
eqIfaceType _ (IfaceTcTyVar tv1) (IfaceTcTyVar tv2)
= tv1 == tv2 -- Should not happen
eqIfaceType env (IfaceTyVar tv1) (IfaceTyVar tv2) =
case (rnIfOccL env tv1, rnIfOccR env tv2) of
(Just v1, Just v2) -> v1 == v2
......@@ -645,7 +667,8 @@ pprIfaceType = eliminateRuntimeRep (ppr_ty TopPrec)
pprParendIfaceType = eliminateRuntimeRep (ppr_ty TyConPrec)
ppr_ty :: TyPrec -> IfaceType -> SDoc
ppr_ty _ (IfaceTyVar tyvar) = ppr tyvar
ppr_ty _ (IfaceTcTyVar tyvar) = ppr tyvar -- This is the main reson for IfaceTcTyVar!
ppr_ty _ (IfaceTyVar tyvar) = ppr tyvar -- See Note [TcTyVars in IfaceType]
ppr_ty ctxt_prec (IfaceTyConApp tc tys) = pprTyTcApp ctxt_prec tc tys
ppr_ty _ (IfaceTupleTy i p tys) = pprTuple i p tys
ppr_ty _ (IfaceLitTy n) = pprIfaceTyLit n
......@@ -1304,6 +1327,9 @@ pprIfaceContext [pred] = ppr_ty TyOpPrec pred
pprIfaceContext preds = parens (fsep (punctuate comma (map ppr preds)))
instance Binary IfaceType where
put_ _ (IfaceTcTyVar tv)
= pprPanic "Can't serialise IfaceTcTyVar" (ppr tv)
put_ bh (IfaceForAllTy aa ab) = do
putByte bh 0
put_ bh aa
......
......@@ -1099,6 +1099,7 @@ tcIfaceType :: IfaceType -> IfL Type
tcIfaceType = go
where
go (IfaceTyVar n) = TyVarTy <$> tcIfaceTyVar n
go (IfaceTcTyVar n) = pprPanic "tcIfaceType:IfaceTcTyVar" (ppr n)
go (IfaceAppTy t1 t2) = AppTy <$> go t1 <*> go t2
go (IfaceLitTy l) = LitTy <$> tcIfaceTyLit l
go (IfaceFunTy t1 t2) = FunTy <$> go t1 <*> go t2
......
......@@ -106,17 +106,17 @@ toIfaceKind = toIfaceType
---------------------
toIfaceType :: Type -> IfaceType
-- Synonyms are retained in the interface type
toIfaceType (TyVarTy tv) = IfaceTyVar (toIfaceTyVar tv)
-- | isTcTyVar tv = IfaceTyVar (toIfaceTyVar tv `appendFS` consFS '_' (mkFastString (showSDocUnsafe (ppr (getUnique tv)))))
-- | otherwise
toIfaceType (AppTy t1 t2) = IfaceAppTy (toIfaceType t1) (toIfaceType t2)
toIfaceType (LitTy n) = IfaceLitTy (toIfaceTyLit n)
toIfaceType (ForAllTy b t) = IfaceForAllTy (toIfaceForAllBndr b) (toIfaceType t)
toIfaceType (TyVarTy tv) -- See Note [TcTyVars in IfaceType] in IfaceType
| isTcTyVar tv = IfaceTcTyVar tv
| otherwise = IfaceTyVar (toIfaceTyVar tv)
toIfaceType (AppTy t1 t2) = IfaceAppTy (toIfaceType t1) (toIfaceType t2)
toIfaceType (LitTy n) = IfaceLitTy (toIfaceTyLit n)
toIfaceType (ForAllTy b t) = IfaceForAllTy (toIfaceForAllBndr b) (toIfaceType t)
toIfaceType (FunTy t1 t2)
| isPredTy t1 = IfaceDFunTy (toIfaceType t1) (toIfaceType t2)
| otherwise = IfaceFunTy (toIfaceType t1) (toIfaceType t2)
toIfaceType (CastTy ty co) = IfaceCastTy (toIfaceType ty) (toIfaceCoercion co)
toIfaceType (CoercionTy co) = IfaceCoercionTy (toIfaceCoercion co)
| isPredTy t1 = IfaceDFunTy (toIfaceType t1) (toIfaceType t2)
| otherwise = IfaceFunTy (toIfaceType t1) (toIfaceType t2)
toIfaceType (CastTy ty co) = IfaceCastTy (toIfaceType ty) (toIfaceCoercion co)
toIfaceType (CoercionTy co) = IfaceCoercionTy (toIfaceCoercion co)
toIfaceType (TyConApp tc tys)
-- tuples
......
......@@ -2384,8 +2384,8 @@ Anyway, that's the current story, and it is used consistently for Type and HsTyp
------------------
pprType, pprParendType :: Type -> SDoc
pprType = pprIfaceType . toIfaceType
pprParendType = pprParendIfaceType . toIfaceType
pprType = pprIfaceType . tidyToIfaceType
pprParendType = pprParendIfaceType . tidyToIfaceType
pprTyLit :: TyLit -> SDoc
pprTyLit = pprIfaceTyLit . toIfaceTyLit
......@@ -2394,16 +2394,21 @@ pprKind, pprParendKind :: Kind -> SDoc
pprKind = pprType
pprParendKind = pprParendType
tidyToIfaceType :: Type -> IfaceType
-- It's vital to tidy before converting to an IfaceType
-- or nested binders will become indistinguishable!
tidyToIfaceType = toIfaceType . tidyTopType
------------
pprClassPred :: Class -> [Type] -> SDoc
pprClassPred clas tys = pprTypeApp (classTyCon clas) tys
------------
pprTheta :: ThetaType -> SDoc
pprTheta = pprIfaceContext . map toIfaceType
pprTheta = pprIfaceContext . map tidyToIfaceType
pprThetaArrowTy :: ThetaType -> SDoc
pprThetaArrowTy = pprIfaceContextArr . map toIfaceType
pprThetaArrowTy = pprIfaceContextArr . map tidyToIfaceType
------------------
instance Outputable Type where
......@@ -2415,7 +2420,7 @@ instance Outputable TyLit where
------------------
pprSigmaType :: Type -> SDoc
pprSigmaType = pprIfaceSigmaType . toIfaceType
pprSigmaType = pprIfaceSigmaType . tidyToIfaceType
pprForAll :: [TyVarBinder] -> SDoc
pprForAll tvs = pprIfaceForAll (map toIfaceForAllBndr tvs)
......@@ -2428,13 +2433,21 @@ pprTvBndrs :: [TyVarBinder] -> SDoc
pprTvBndrs tvs = sep (map pprTvBndr tvs)
pprTvBndr :: TyVarBinder -> SDoc
pprTvBndr = pprIfaceTvBndr True . toIfaceTvBndr . binderVar
pprTvBndr = pprTyVar . binderVar
pprTyVars :: [TyVar] -> SDoc
pprTyVars tvs = sep (map pprTyVar tvs)
pprTyVar :: TyVar -> SDoc
pprTyVar = pprIfaceTvBndr True . toIfaceTvBndr
-- Print a type variable binder with its kind (but not if *)
-- Here we do not go via IfaceType, becuase the duplication with
-- pprIfaceTvBndr is minimal, and the loss of uniques etc in
-- debug printing is disastrous
pprTyVar tv
| isLiftedTypeKind kind = ppr tv
| otherwise = parens (ppr tv <+> dcolon <+> ppr kind)
where
kind = tyVarKind tv
instance Outputable TyBinder where
ppr (Anon ty) = text "[anon]" <+> ppr ty
......
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