diff options
| -rw-r--r-- | compiler/backpack/RnModIface.hs | 3 | ||||
| -rw-r--r-- | compiler/iface/IfaceSyn.hs | 2 | ||||
| -rw-r--r-- | compiler/iface/IfaceType.hs | 34 | ||||
| -rw-r--r-- | compiler/iface/TcIface.hs | 1 | ||||
| -rw-r--r-- | compiler/iface/ToIface.hs | 20 | ||||
| -rw-r--r-- | compiler/types/TyCoRep.hs | 27 |
6 files changed, 64 insertions, 23 deletions
diff --git a/compiler/backpack/RnModIface.hs b/compiler/backpack/RnModIface.hs index e70254243f..4861628764 100644 --- a/compiler/backpack/RnModIface.hs +++ b/compiler/backpack/RnModIface.hs @@ -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) diff --git a/compiler/iface/IfaceSyn.hs b/compiler/iface/IfaceSyn.hs index 4a5672a7c1..cb5e3a7d05 100644 --- a/compiler/iface/IfaceSyn.hs +++ b/compiler/iface/IfaceSyn.hs @@ -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 diff --git a/compiler/iface/IfaceType.hs b/compiler/iface/IfaceType.hs index a797b9e88e..dbca426cbe 100644 --- a/compiler/iface/IfaceType.hs +++ b/compiler/iface/IfaceType.hs @@ -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 diff --git a/compiler/iface/TcIface.hs b/compiler/iface/TcIface.hs index 98a5f2768c..1b0fdf890f 100644 --- a/compiler/iface/TcIface.hs +++ b/compiler/iface/TcIface.hs @@ -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 diff --git a/compiler/iface/ToIface.hs b/compiler/iface/ToIface.hs index 7e892b68c7..8de3e3ea9b 100644 --- a/compiler/iface/ToIface.hs +++ b/compiler/iface/ToIface.hs @@ -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 diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs index 9979853f6b..488b669ae5 100644 --- a/compiler/types/TyCoRep.hs +++ b/compiler/types/TyCoRep.hs @@ -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 |