1{- 2(c) The University of Glasgow 2006 3(c) The GRASP/AQUA Project, Glasgow University, 1993-1998 4 5 6This module defines interface types and binders 7-} 8 9{-# LANGUAGE CPP, FlexibleInstances, BangPatterns #-} 10{-# LANGUAGE MultiWayIf #-} 11{-# LANGUAGE TupleSections #-} 12{-# LANGUAGE LambdaCase #-} 13 -- FlexibleInstances for Binary (DefMethSpec IfaceType) 14 15module IfaceType ( 16 IfExtName, IfLclName, 17 18 IfaceType(..), IfacePredType, IfaceKind, IfaceCoercion(..), 19 IfaceMCoercion(..), 20 IfaceUnivCoProv(..), 21 IfaceTyCon(..), IfaceTyConInfo(..), IfaceTyConSort(..), 22 IfaceTyLit(..), IfaceAppArgs(..), 23 IfaceContext, IfaceBndr(..), IfaceOneShot(..), IfaceLamBndr, 24 IfaceTvBndr, IfaceIdBndr, IfaceTyConBinder, 25 IfaceForAllBndr, ArgFlag(..), AnonArgFlag(..), 26 ForallVisFlag(..), ShowForAllFlag(..), 27 mkIfaceForAllTvBndr, 28 mkIfaceTyConKind, 29 30 ifForAllBndrVar, ifForAllBndrName, ifaceBndrName, 31 ifTyConBinderVar, ifTyConBinderName, 32 33 -- Equality testing 34 isIfaceLiftedTypeKind, 35 36 -- Conversion from IfaceAppArgs to IfaceTypes/ArgFlags 37 appArgsIfaceTypes, appArgsIfaceTypesArgFlags, 38 39 -- Printing 40 SuppressBndrSig(..), 41 UseBndrParens(..), 42 pprIfaceType, pprParendIfaceType, pprPrecIfaceType, 43 pprIfaceContext, pprIfaceContextArr, 44 pprIfaceIdBndr, pprIfaceLamBndr, pprIfaceTvBndr, pprIfaceTyConBinders, 45 pprIfaceBndrs, pprIfaceAppArgs, pprParendIfaceAppArgs, 46 pprIfaceForAllPart, pprIfaceForAllPartMust, pprIfaceForAll, 47 pprIfaceSigmaType, pprIfaceTyLit, 48 pprIfaceCoercion, pprParendIfaceCoercion, 49 splitIfaceSigmaTy, pprIfaceTypeApp, pprUserIfaceForAll, 50 pprIfaceCoTcApp, pprTyTcApp, pprIfacePrefixApp, 51 isIfaceTauType, 52 53 suppressIfaceInvisibles, 54 stripIfaceInvisVars, 55 stripInvisArgs, 56 57 mkIfaceTySubst, substIfaceTyVar, substIfaceAppArgs, inDomIfaceTySubst 58 ) where 59 60#include "GhclibHsVersions.h" 61 62import GhcPrelude 63 64import {-# SOURCE #-} TysWiredIn ( coercibleTyCon, heqTyCon 65 , liftedRepDataConTyCon, tupleTyConName ) 66import {-# SOURCE #-} Type ( isRuntimeRepTy ) 67 68import DynFlags 69import TyCon hiding ( pprPromotionQuote ) 70import CoAxiom 71import Var 72import PrelNames 73import Name 74import BasicTypes 75import Binary 76import Outputable 77import FastString 78import FastStringEnv 79import Util 80 81import Data.Maybe( isJust ) 82import qualified Data.Semigroup as Semi 83import Control.DeepSeq 84 85{- 86************************************************************************ 87* * 88 Local (nested) binders 89* * 90************************************************************************ 91-} 92 93type IfLclName = FastString -- A local name in iface syntax 94 95type IfExtName = Name -- An External or WiredIn Name can appear in IfaceSyn 96 -- (However Internal or System Names never should) 97 98data IfaceBndr -- Local (non-top-level) binders 99 = IfaceIdBndr {-# UNPACK #-} !IfaceIdBndr 100 | IfaceTvBndr {-# UNPACK #-} !IfaceTvBndr 101 102type IfaceIdBndr = (IfLclName, IfaceType) 103type IfaceTvBndr = (IfLclName, IfaceKind) 104 105ifaceTvBndrName :: IfaceTvBndr -> IfLclName 106ifaceTvBndrName (n,_) = n 107 108ifaceIdBndrName :: IfaceIdBndr -> IfLclName 109ifaceIdBndrName (n,_) = n 110 111ifaceBndrName :: IfaceBndr -> IfLclName 112ifaceBndrName (IfaceTvBndr bndr) = ifaceTvBndrName bndr 113ifaceBndrName (IfaceIdBndr bndr) = ifaceIdBndrName bndr 114 115ifaceBndrType :: IfaceBndr -> IfaceType 116ifaceBndrType (IfaceIdBndr (_, t)) = t 117ifaceBndrType (IfaceTvBndr (_, t)) = t 118 119type IfaceLamBndr = (IfaceBndr, IfaceOneShot) 120 121data IfaceOneShot -- See Note [Preserve OneShotInfo] in CoreTicy 122 = IfaceNoOneShot -- and Note [The oneShot function] in MkId 123 | IfaceOneShot 124 125 126{- 127%************************************************************************ 128%* * 129 IfaceType 130%* * 131%************************************************************************ 132-} 133 134------------------------------- 135type IfaceKind = IfaceType 136 137-- | A kind of universal type, used for types and kinds. 138-- 139-- Any time a 'Type' is pretty-printed, it is first converted to an 'IfaceType' 140-- before being printed. See Note [Pretty printing via IfaceSyn] in PprTyThing 141data IfaceType 142 = IfaceFreeTyVar TyVar -- See Note [Free tyvars in IfaceType] 143 | IfaceTyVar IfLclName -- Type/coercion variable only, not tycon 144 | IfaceLitTy IfaceTyLit 145 | IfaceAppTy IfaceType IfaceAppArgs 146 -- See Note [Suppressing invisible arguments] for 147 -- an explanation of why the second field isn't 148 -- IfaceType, analogous to AppTy. 149 | IfaceFunTy AnonArgFlag IfaceType IfaceType 150 | IfaceForAllTy IfaceForAllBndr IfaceType 151 | IfaceTyConApp IfaceTyCon IfaceAppArgs -- Not necessarily saturated 152 -- Includes newtypes, synonyms, tuples 153 | IfaceCastTy IfaceType IfaceCoercion 154 | IfaceCoercionTy IfaceCoercion 155 156 | IfaceTupleTy -- Saturated tuples (unsaturated ones use IfaceTyConApp) 157 TupleSort -- What sort of tuple? 158 PromotionFlag -- A bit like IfaceTyCon 159 IfaceAppArgs -- arity = length args 160 -- For promoted data cons, the kind args are omitted 161 162type IfacePredType = IfaceType 163type IfaceContext = [IfacePredType] 164 165data IfaceTyLit 166 = IfaceNumTyLit Integer 167 | IfaceStrTyLit FastString 168 deriving (Eq) 169 170type IfaceTyConBinder = VarBndr IfaceBndr TyConBndrVis 171type IfaceForAllBndr = VarBndr IfaceBndr ArgFlag 172 173-- | Make an 'IfaceForAllBndr' from an 'IfaceTvBndr'. 174mkIfaceForAllTvBndr :: ArgFlag -> IfaceTvBndr -> IfaceForAllBndr 175mkIfaceForAllTvBndr vis var = Bndr (IfaceTvBndr var) vis 176 177-- | Build the 'tyConKind' from the binders and the result kind. 178-- Keep in sync with 'mkTyConKind' in types/TyCon. 179mkIfaceTyConKind :: [IfaceTyConBinder] -> IfaceKind -> IfaceKind 180mkIfaceTyConKind bndrs res_kind = foldr mk res_kind bndrs 181 where 182 mk :: IfaceTyConBinder -> IfaceKind -> IfaceKind 183 mk (Bndr tv (AnonTCB af)) k = IfaceFunTy af (ifaceBndrType tv) k 184 mk (Bndr tv (NamedTCB vis)) k = IfaceForAllTy (Bndr tv vis) k 185 186-- | Stores the arguments in a type application as a list. 187-- See @Note [Suppressing invisible arguments]@. 188data IfaceAppArgs 189 = IA_Nil 190 | IA_Arg IfaceType -- The type argument 191 192 ArgFlag -- The argument's visibility. We store this here so 193 -- that we can: 194 -- 195 -- 1. Avoid pretty-printing invisible (i.e., specified 196 -- or inferred) arguments when 197 -- -fprint-explicit-kinds isn't enabled, or 198 -- 2. When -fprint-explicit-kinds *is*, enabled, print 199 -- specified arguments in @(...) and inferred 200 -- arguments in @{...}. 201 202 IfaceAppArgs -- The rest of the arguments 203 204instance Semi.Semigroup IfaceAppArgs where 205 IA_Nil <> xs = xs 206 IA_Arg ty argf rest <> xs = IA_Arg ty argf (rest Semi.<> xs) 207 208instance Monoid IfaceAppArgs where 209 mempty = IA_Nil 210 mappend = (Semi.<>) 211 212-- Encodes type constructors, kind constructors, 213-- coercion constructors, the lot. 214-- We have to tag them in order to pretty print them 215-- properly. 216data IfaceTyCon = IfaceTyCon { ifaceTyConName :: IfExtName 217 , ifaceTyConInfo :: IfaceTyConInfo } 218 deriving (Eq) 219 220-- | The various types of TyCons which have special, built-in syntax. 221data IfaceTyConSort = IfaceNormalTyCon -- ^ a regular tycon 222 223 | IfaceTupleTyCon !Arity !TupleSort 224 -- ^ e.g. @(a, b, c)@ or @(#a, b, c#)@. 225 -- The arity is the tuple width, not the tycon arity 226 -- (which is twice the width in the case of unboxed 227 -- tuples). 228 229 | IfaceSumTyCon !Arity 230 -- ^ e.g. @(a | b | c)@ 231 232 | IfaceEqualityTyCon 233 -- ^ A heterogeneous equality TyCon 234 -- (i.e. eqPrimTyCon, eqReprPrimTyCon, heqTyCon) 235 -- that is actually being applied to two types 236 -- of the same kind. This affects pretty-printing 237 -- only: see Note [Equality predicates in IfaceType] 238 deriving (Eq) 239 240{- Note [Free tyvars in IfaceType] 241~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 242Nowadays (since Nov 16, 2016) we pretty-print a Type by converting to 243an IfaceType and pretty printing that. This eliminates a lot of 244pretty-print duplication, and it matches what we do with pretty- 245printing TyThings. See Note [Pretty printing via IfaceSyn] in PprTyThing. 246 247It works fine for closed types, but when printing debug traces (e.g. 248when using -ddump-tc-trace) we print a lot of /open/ types. These 249types are full of TcTyVars, and it's absolutely crucial to print them 250in their full glory, with their unique, TcTyVarDetails etc. 251 252So we simply embed a TyVar in IfaceType with the IfaceFreeTyVar constructor. 253Note that: 254 255* We never expect to serialise an IfaceFreeTyVar into an interface file, nor 256 to deserialise one. IfaceFreeTyVar is used only in the "convert to IfaceType 257 and then pretty-print" pipeline. 258 259We do the same for covars, naturally. 260 261Note [Equality predicates in IfaceType] 262~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 263GHC has several varieties of type equality (see Note [The equality types story] 264in TysPrim for details). In an effort to avoid confusing users, we suppress 265the differences during pretty printing unless certain flags are enabled. 266Here is how each equality predicate* is printed in homogeneous and 267heterogeneous contexts, depending on which combination of the 268-fprint-explicit-kinds and -fprint-equality-relations flags is used: 269 270-------------------------------------------------------------------------------------------- 271| Predicate | Neither flag | -fprint-explicit-kinds | 272|-------------------------------|----------------------------|-----------------------------| 273| a ~ b (homogeneous) | a ~ b | (a :: Type) ~ (b :: Type) | 274| a ~~ b, homogeneously | a ~ b | (a :: Type) ~ (b :: Type) | 275| a ~~ b, heterogeneously | a ~~ c | (a :: Type) ~~ (c :: k) | 276| a ~# b, homogeneously | a ~ b | (a :: Type) ~ (b :: Type) | 277| a ~# b, heterogeneously | a ~~ c | (a :: Type) ~~ (c :: k) | 278| Coercible a b (homogeneous) | Coercible a b | Coercible @Type a b | 279| a ~R# b, homogeneously | Coercible a b | Coercible @Type a b | 280| a ~R# b, heterogeneously | a ~R# b | (a :: Type) ~R# (c :: k) | 281|-------------------------------|----------------------------|-----------------------------| 282| Predicate | -fprint-equality-relations | Both flags | 283|-------------------------------|----------------------------|-----------------------------| 284| a ~ b (homogeneous) | a ~ b | (a :: Type) ~ (b :: Type) | 285| a ~~ b, homogeneously | a ~~ b | (a :: Type) ~~ (b :: Type) | 286| a ~~ b, heterogeneously | a ~~ c | (a :: Type) ~~ (c :: k) | 287| a ~# b, homogeneously | a ~# b | (a :: Type) ~# (b :: Type) | 288| a ~# b, heterogeneously | a ~# c | (a :: Type) ~# (c :: k) | 289| Coercible a b (homogeneous) | Coercible a b | Coercible @Type a b | 290| a ~R# b, homogeneously | a ~R# b | (a :: Type) ~R# (b :: Type) | 291| a ~R# b, heterogeneously | a ~R# b | (a :: Type) ~R# (c :: k) | 292-------------------------------------------------------------------------------------------- 293 294(* There is no heterogeneous, representational, lifted equality counterpart 295to (~~). There could be, but there seems to be no use for it.) 296 297This table adheres to the following rules: 298 299A. With -fprint-equality-relations, print the true equality relation. 300B. Without -fprint-equality-relations: 301 i. If the equality is representational and homogeneous, use Coercible. 302 ii. Otherwise, if the equality is representational, use ~R#. 303 iii. If the equality is nominal and homogeneous, use ~. 304 iv. Otherwise, if the equality is nominal, use ~~. 305C. With -fprint-explicit-kinds, print kinds on both sides of an infix operator, 306 as above; or print the kind with Coercible. 307D. Without -fprint-explicit-kinds, don't print kinds. 308 309A hetero-kinded equality is used homogeneously when it is applied to two 310identical kinds. Unfortunately, determining this from an IfaceType isn't 311possible since we can't see through type synonyms. Consequently, we need to 312record whether this particular application is homogeneous in IfaceTyConSort 313for the purposes of pretty-printing. 314 315See Note [The equality types story] in TysPrim. 316-} 317 318data IfaceTyConInfo -- Used to guide pretty-printing 319 -- and to disambiguate D from 'D (they share a name) 320 = IfaceTyConInfo { ifaceTyConIsPromoted :: PromotionFlag 321 , ifaceTyConSort :: IfaceTyConSort } 322 deriving (Eq) 323 324data IfaceMCoercion 325 = IfaceMRefl 326 | IfaceMCo IfaceCoercion 327 328data IfaceCoercion 329 = IfaceReflCo IfaceType 330 | IfaceGReflCo Role IfaceType (IfaceMCoercion) 331 | IfaceFunCo Role IfaceCoercion IfaceCoercion 332 | IfaceTyConAppCo Role IfaceTyCon [IfaceCoercion] 333 | IfaceAppCo IfaceCoercion IfaceCoercion 334 | IfaceForAllCo IfaceBndr IfaceCoercion IfaceCoercion 335 | IfaceCoVarCo IfLclName 336 | IfaceAxiomInstCo IfExtName BranchIndex [IfaceCoercion] 337 | IfaceAxiomRuleCo IfLclName [IfaceCoercion] 338 -- There are only a fixed number of CoAxiomRules, so it suffices 339 -- to use an IfaceLclName to distinguish them. 340 -- See Note [Adding built-in type families] in TcTypeNats 341 | IfaceUnivCo IfaceUnivCoProv Role IfaceType IfaceType 342 | IfaceSymCo IfaceCoercion 343 | IfaceTransCo IfaceCoercion IfaceCoercion 344 | IfaceNthCo Int IfaceCoercion 345 | IfaceLRCo LeftOrRight IfaceCoercion 346 | IfaceInstCo IfaceCoercion IfaceCoercion 347 | IfaceKindCo IfaceCoercion 348 | IfaceSubCo IfaceCoercion 349 | IfaceFreeCoVar CoVar -- See Note [Free tyvars in IfaceType] 350 | IfaceHoleCo CoVar -- ^ See Note [Holes in IfaceCoercion] 351 352data IfaceUnivCoProv 353 = IfaceUnsafeCoerceProv 354 | IfacePhantomProv IfaceCoercion 355 | IfaceProofIrrelProv IfaceCoercion 356 | IfacePluginProv String 357 358{- Note [Holes in IfaceCoercion] 359~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 360When typechecking fails the typechecker will produce a HoleCo to stand 361in place of the unproven assertion. While we generally don't want to 362let these unproven assertions leak into interface files, we still need 363to be able to pretty-print them as we use IfaceType's pretty-printer 364to render Types. For this reason IfaceCoercion has a IfaceHoleCo 365constructor; however, we fails when asked to serialize to a 366IfaceHoleCo to ensure that they don't end up in an interface file. 367 368 369%************************************************************************ 370%* * 371 Functions over IFaceTypes 372* * 373************************************************************************ 374-} 375 376ifaceTyConHasKey :: IfaceTyCon -> Unique -> Bool 377ifaceTyConHasKey tc key = ifaceTyConName tc `hasKey` key 378 379isIfaceLiftedTypeKind :: IfaceKind -> Bool 380isIfaceLiftedTypeKind (IfaceTyConApp tc IA_Nil) 381 = isLiftedTypeKindTyConName (ifaceTyConName tc) 382isIfaceLiftedTypeKind (IfaceTyConApp tc 383 (IA_Arg (IfaceTyConApp ptr_rep_lifted IA_Nil) 384 Required IA_Nil)) 385 = tc `ifaceTyConHasKey` tYPETyConKey 386 && ptr_rep_lifted `ifaceTyConHasKey` liftedRepDataConKey 387isIfaceLiftedTypeKind _ = False 388 389splitIfaceSigmaTy :: IfaceType -> ([IfaceForAllBndr], [IfacePredType], IfaceType) 390-- Mainly for printing purposes 391-- 392-- Here we split nested IfaceSigmaTy properly. 393-- 394-- @ 395-- forall t. T t => forall m a b. M m => (a -> m b) -> t a -> m (t b) 396-- @ 397-- 398-- If you called @splitIfaceSigmaTy@ on this type: 399-- 400-- @ 401-- ([t, m, a, b], [T t, M m], (a -> m b) -> t a -> m (t b)) 402-- @ 403splitIfaceSigmaTy ty 404 = case (bndrs, theta) of 405 ([], []) -> (bndrs, theta, tau) 406 _ -> let (bndrs', theta', tau') = splitIfaceSigmaTy tau 407 in (bndrs ++ bndrs', theta ++ theta', tau') 408 where 409 (bndrs, rho) = split_foralls ty 410 (theta, tau) = split_rho rho 411 412 split_foralls (IfaceForAllTy bndr ty) 413 = case split_foralls ty of { (bndrs, rho) -> (bndr:bndrs, rho) } 414 split_foralls rho = ([], rho) 415 416 split_rho (IfaceFunTy InvisArg ty1 ty2) 417 = case split_rho ty2 of { (ps, tau) -> (ty1:ps, tau) } 418 split_rho tau = ([], tau) 419 420suppressIfaceInvisibles :: DynFlags -> [IfaceTyConBinder] -> [a] -> [a] 421suppressIfaceInvisibles dflags tys xs 422 | gopt Opt_PrintExplicitKinds dflags = xs 423 | otherwise = suppress tys xs 424 where 425 suppress _ [] = [] 426 suppress [] a = a 427 suppress (k:ks) (x:xs) 428 | isInvisibleTyConBinder k = suppress ks xs 429 | otherwise = x : suppress ks xs 430 431stripIfaceInvisVars :: DynFlags -> [IfaceTyConBinder] -> [IfaceTyConBinder] 432stripIfaceInvisVars dflags tyvars 433 | gopt Opt_PrintExplicitKinds dflags = tyvars 434 | otherwise = filterOut isInvisibleTyConBinder tyvars 435 436-- | Extract an 'IfaceBndr' from an 'IfaceForAllBndr'. 437ifForAllBndrVar :: IfaceForAllBndr -> IfaceBndr 438ifForAllBndrVar = binderVar 439 440-- | Extract the variable name from an 'IfaceForAllBndr'. 441ifForAllBndrName :: IfaceForAllBndr -> IfLclName 442ifForAllBndrName fab = ifaceBndrName (ifForAllBndrVar fab) 443 444-- | Extract an 'IfaceBndr' from an 'IfaceTyConBinder'. 445ifTyConBinderVar :: IfaceTyConBinder -> IfaceBndr 446ifTyConBinderVar = binderVar 447 448-- | Extract the variable name from an 'IfaceTyConBinder'. 449ifTyConBinderName :: IfaceTyConBinder -> IfLclName 450ifTyConBinderName tcb = ifaceBndrName (ifTyConBinderVar tcb) 451 452ifTypeIsVarFree :: IfaceType -> Bool 453-- Returns True if the type definitely has no variables at all 454-- Just used to control pretty printing 455ifTypeIsVarFree ty = go ty 456 where 457 go (IfaceTyVar {}) = False 458 go (IfaceFreeTyVar {}) = False 459 go (IfaceAppTy fun args) = go fun && go_args args 460 go (IfaceFunTy _ arg res) = go arg && go res 461 go (IfaceForAllTy {}) = False 462 go (IfaceTyConApp _ args) = go_args args 463 go (IfaceTupleTy _ _ args) = go_args args 464 go (IfaceLitTy _) = True 465 go (IfaceCastTy {}) = False -- Safe 466 go (IfaceCoercionTy {}) = False -- Safe 467 468 go_args IA_Nil = True 469 go_args (IA_Arg arg _ args) = go arg && go_args args 470 471{- Note [Substitution on IfaceType] 472~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 473Substitutions on IfaceType are done only during pretty-printing to 474construct the result type of a GADT, and does not deal with binders 475(eg IfaceForAll), so it doesn't need fancy capture stuff. -} 476 477type IfaceTySubst = FastStringEnv IfaceType -- Note [Substitution on IfaceType] 478 479mkIfaceTySubst :: [(IfLclName,IfaceType)] -> IfaceTySubst 480-- See Note [Substitution on IfaceType] 481mkIfaceTySubst eq_spec = mkFsEnv eq_spec 482 483inDomIfaceTySubst :: IfaceTySubst -> IfaceTvBndr -> Bool 484-- See Note [Substitution on IfaceType] 485inDomIfaceTySubst subst (fs, _) = isJust (lookupFsEnv subst fs) 486 487substIfaceType :: IfaceTySubst -> IfaceType -> IfaceType 488-- See Note [Substitution on IfaceType] 489substIfaceType env ty 490 = go ty 491 where 492 go (IfaceFreeTyVar tv) = IfaceFreeTyVar tv 493 go (IfaceTyVar tv) = substIfaceTyVar env tv 494 go (IfaceAppTy t ts) = IfaceAppTy (go t) (substIfaceAppArgs env ts) 495 go (IfaceFunTy af t1 t2) = IfaceFunTy af (go t1) (go t2) 496 go ty@(IfaceLitTy {}) = ty 497 go (IfaceTyConApp tc tys) = IfaceTyConApp tc (substIfaceAppArgs env tys) 498 go (IfaceTupleTy s i tys) = IfaceTupleTy s i (substIfaceAppArgs env tys) 499 go (IfaceForAllTy {}) = pprPanic "substIfaceType" (ppr ty) 500 go (IfaceCastTy ty co) = IfaceCastTy (go ty) (go_co co) 501 go (IfaceCoercionTy co) = IfaceCoercionTy (go_co co) 502 503 go_mco IfaceMRefl = IfaceMRefl 504 go_mco (IfaceMCo co) = IfaceMCo $ go_co co 505 506 go_co (IfaceReflCo ty) = IfaceReflCo (go ty) 507 go_co (IfaceGReflCo r ty mco) = IfaceGReflCo r (go ty) (go_mco mco) 508 go_co (IfaceFunCo r c1 c2) = IfaceFunCo r (go_co c1) (go_co c2) 509 go_co (IfaceTyConAppCo r tc cos) = IfaceTyConAppCo r tc (go_cos cos) 510 go_co (IfaceAppCo c1 c2) = IfaceAppCo (go_co c1) (go_co c2) 511 go_co (IfaceForAllCo {}) = pprPanic "substIfaceCoercion" (ppr ty) 512 go_co (IfaceFreeCoVar cv) = IfaceFreeCoVar cv 513 go_co (IfaceCoVarCo cv) = IfaceCoVarCo cv 514 go_co (IfaceHoleCo cv) = IfaceHoleCo cv 515 go_co (IfaceAxiomInstCo a i cos) = IfaceAxiomInstCo a i (go_cos cos) 516 go_co (IfaceUnivCo prov r t1 t2) = IfaceUnivCo (go_prov prov) r (go t1) (go t2) 517 go_co (IfaceSymCo co) = IfaceSymCo (go_co co) 518 go_co (IfaceTransCo co1 co2) = IfaceTransCo (go_co co1) (go_co co2) 519 go_co (IfaceNthCo n co) = IfaceNthCo n (go_co co) 520 go_co (IfaceLRCo lr co) = IfaceLRCo lr (go_co co) 521 go_co (IfaceInstCo c1 c2) = IfaceInstCo (go_co c1) (go_co c2) 522 go_co (IfaceKindCo co) = IfaceKindCo (go_co co) 523 go_co (IfaceSubCo co) = IfaceSubCo (go_co co) 524 go_co (IfaceAxiomRuleCo n cos) = IfaceAxiomRuleCo n (go_cos cos) 525 526 go_cos = map go_co 527 528 go_prov IfaceUnsafeCoerceProv = IfaceUnsafeCoerceProv 529 go_prov (IfacePhantomProv co) = IfacePhantomProv (go_co co) 530 go_prov (IfaceProofIrrelProv co) = IfaceProofIrrelProv (go_co co) 531 go_prov (IfacePluginProv str) = IfacePluginProv str 532 533substIfaceAppArgs :: IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs 534substIfaceAppArgs env args 535 = go args 536 where 537 go IA_Nil = IA_Nil 538 go (IA_Arg ty arg tys) = IA_Arg (substIfaceType env ty) arg (go tys) 539 540substIfaceTyVar :: IfaceTySubst -> IfLclName -> IfaceType 541substIfaceTyVar env tv 542 | Just ty <- lookupFsEnv env tv = ty 543 | otherwise = IfaceTyVar tv 544 545 546{- 547************************************************************************ 548* * 549 Functions over IfaceAppArgs 550* * 551************************************************************************ 552-} 553 554stripInvisArgs :: DynFlags -> IfaceAppArgs -> IfaceAppArgs 555stripInvisArgs dflags tys 556 | gopt Opt_PrintExplicitKinds dflags = tys 557 | otherwise = suppress_invis tys 558 where 559 suppress_invis c 560 = case c of 561 IA_Nil -> IA_Nil 562 IA_Arg t argf ts 563 | isVisibleArgFlag argf 564 -> IA_Arg t argf $ suppress_invis ts 565 -- Keep recursing through the remainder of the arguments, as it's 566 -- possible that there are remaining invisible ones. 567 -- See the "In type declarations" section of Note [VarBndrs, 568 -- TyCoVarBinders, TyConBinders, and visibility] in TyCoRep. 569 | otherwise 570 -> suppress_invis ts 571 572appArgsIfaceTypes :: IfaceAppArgs -> [IfaceType] 573appArgsIfaceTypes IA_Nil = [] 574appArgsIfaceTypes (IA_Arg t _ ts) = t : appArgsIfaceTypes ts 575 576appArgsIfaceTypesArgFlags :: IfaceAppArgs -> [(IfaceType, ArgFlag)] 577appArgsIfaceTypesArgFlags IA_Nil = [] 578appArgsIfaceTypesArgFlags (IA_Arg t a ts) 579 = (t, a) : appArgsIfaceTypesArgFlags ts 580 581ifaceVisAppArgsLength :: IfaceAppArgs -> Int 582ifaceVisAppArgsLength = go 0 583 where 584 go !n IA_Nil = n 585 go n (IA_Arg _ argf rest) 586 | isVisibleArgFlag argf = go (n+1) rest 587 | otherwise = go n rest 588 589{- 590Note [Suppressing invisible arguments] 591~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 592We use the IfaceAppArgs data type to specify which of the arguments to a type 593should be displayed when pretty-printing, under the control of 594-fprint-explicit-kinds. 595See also Type.filterOutInvisibleTypes. 596For example, given 597 598 T :: forall k. (k->*) -> k -> * -- Ordinary kind polymorphism 599 'Just :: forall k. k -> 'Maybe k -- Promoted 600 601we want 602 603 T * Tree Int prints as T Tree Int 604 'Just * prints as Just * 605 606For type constructors (IfaceTyConApp), IfaceAppArgs is a quite natural fit, 607since the corresponding Core constructor: 608 609 data Type 610 = ... 611 | TyConApp TyCon [Type] 612 613Already puts all of its arguments into a list. So when converting a Type to an 614IfaceType (see toIfaceAppArgsX in ToIface), we simply use the kind of the TyCon 615(which is cached) to guide the process of converting the argument Types into an 616IfaceAppArgs list. 617 618We also want this behavior for IfaceAppTy, since given: 619 620 data Proxy (a :: k) 621 f :: forall (t :: forall a. a -> Type). Proxy Type (t Bool True) 622 623We want to print the return type as `Proxy (t True)` without the use of 624-fprint-explicit-kinds (#15330). Accomplishing this is trickier than in the 625tycon case, because the corresponding Core constructor for IfaceAppTy: 626 627 data Type 628 = ... 629 | AppTy Type Type 630 631Only stores one argument at a time. Therefore, when converting an AppTy to an 632IfaceAppTy (in toIfaceTypeX in ToIface), we: 633 6341. Flatten the chain of AppTys down as much as possible 6352. Use typeKind to determine the function Type's kind 6363. Use this kind to guide the process of converting the argument Types into an 637 IfaceAppArgs list. 638 639By flattening the arguments like this, we obtain two benefits: 640 641(a) We can reuse the same machinery to pretty-print IfaceTyConApp arguments as 642 we do IfaceTyApp arguments, which means that we only need to implement the 643 logic to filter out invisible arguments once. 644(b) Unlike for tycons, finding the kind of a type in general (through typeKind) 645 is not a constant-time operation, so by flattening the arguments first, we 646 decrease the number of times we have to call typeKind. 647 648Note [Pretty-printing invisible arguments] 649~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 650Note [Suppressing invisible arguments] is all about how to avoid printing 651invisible arguments when the -fprint-explicit-kinds flag is disables. Well, 652what about when it's enabled? Then we can and should print invisible kind 653arguments, and this Note explains how we do it. 654 655As two running examples, consider the following code: 656 657 {-# LANGUAGE PolyKinds #-} 658 data T1 a 659 data T2 (a :: k) 660 661When displaying these types (with -fprint-explicit-kinds on), we could just 662do the following: 663 664 T1 k a 665 T2 k a 666 667That certainly gets the job done. But it lacks a crucial piece of information: 668is the `k` argument inferred or specified? To communicate this, we use visible 669kind application syntax to distinguish the two cases: 670 671 T1 @{k} a 672 T2 @k a 673 674Here, @{k} indicates that `k` is an inferred argument, and @k indicates that 675`k` is a specified argument. (See 676Note [VarBndrs, TyCoVarBinders, TyConBinders, and visibility] in TyCoRep for 677a lengthier explanation on what "inferred" and "specified" mean.) 678 679************************************************************************ 680* * 681 Pretty-printing 682* * 683************************************************************************ 684-} 685 686if_print_coercions :: SDoc -- ^ if printing coercions 687 -> SDoc -- ^ otherwise 688 -> SDoc 689if_print_coercions yes no 690 = sdocWithDynFlags $ \dflags -> 691 getPprStyle $ \style -> 692 if gopt Opt_PrintExplicitCoercions dflags 693 || dumpStyle style || debugStyle style 694 then yes 695 else no 696 697pprIfaceInfixApp :: PprPrec -> SDoc -> SDoc -> SDoc -> SDoc 698pprIfaceInfixApp ctxt_prec pp_tc pp_ty1 pp_ty2 699 = maybeParen ctxt_prec opPrec $ 700 sep [pp_ty1, pp_tc <+> pp_ty2] 701 702pprIfacePrefixApp :: PprPrec -> SDoc -> [SDoc] -> SDoc 703pprIfacePrefixApp ctxt_prec pp_fun pp_tys 704 | null pp_tys = pp_fun 705 | otherwise = maybeParen ctxt_prec appPrec $ 706 hang pp_fun 2 (sep pp_tys) 707 708isIfaceTauType :: IfaceType -> Bool 709isIfaceTauType (IfaceForAllTy _ _) = False 710isIfaceTauType (IfaceFunTy InvisArg _ _) = False 711isIfaceTauType _ = True 712 713-- ----------------------------- Printing binders ------------------------------------ 714 715instance Outputable IfaceBndr where 716 ppr (IfaceIdBndr bndr) = pprIfaceIdBndr bndr 717 ppr (IfaceTvBndr bndr) = char '@' <+> pprIfaceTvBndr bndr (SuppressBndrSig False) 718 (UseBndrParens False) 719 720pprIfaceBndrs :: [IfaceBndr] -> SDoc 721pprIfaceBndrs bs = sep (map ppr bs) 722 723pprIfaceLamBndr :: IfaceLamBndr -> SDoc 724pprIfaceLamBndr (b, IfaceNoOneShot) = ppr b 725pprIfaceLamBndr (b, IfaceOneShot) = ppr b <> text "[OneShot]" 726 727pprIfaceIdBndr :: IfaceIdBndr -> SDoc 728pprIfaceIdBndr (name, ty) = parens (ppr name <+> dcolon <+> ppr ty) 729 730{- Note [Suppressing binder signatures] 731~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 732When printing the binders in a 'forall', we want to keep the kind annotations: 733 734 forall (a :: k). blah 735 ^^^^ 736 good 737 738On the other hand, when we print the binders of a data declaration in :info, 739the kind information would be redundant due to the standalone kind signature: 740 741 type F :: Symbol -> Type 742 type F (s :: Symbol) = blah 743 ^^^^^^^^^ 744 redundant 745 746Here we'd like to omit the kind annotation: 747 748 type F :: Symbol -> Type 749 type F s = blah 750-} 751 752-- | Do we want to suppress kind annotations on binders? 753-- See Note [Suppressing binder signatures] 754newtype SuppressBndrSig = SuppressBndrSig Bool 755 756newtype UseBndrParens = UseBndrParens Bool 757 758pprIfaceTvBndr :: IfaceTvBndr -> SuppressBndrSig -> UseBndrParens -> SDoc 759pprIfaceTvBndr (tv, ki) (SuppressBndrSig suppress_sig) (UseBndrParens use_parens) 760 | suppress_sig = ppr tv 761 | isIfaceLiftedTypeKind ki = ppr tv 762 | otherwise = maybe_parens (ppr tv <+> dcolon <+> ppr ki) 763 where 764 maybe_parens | use_parens = parens 765 | otherwise = id 766 767pprIfaceTyConBinders :: SuppressBndrSig -> [IfaceTyConBinder] -> SDoc 768pprIfaceTyConBinders suppress_sig = sep . map go 769 where 770 go :: IfaceTyConBinder -> SDoc 771 go (Bndr (IfaceIdBndr bndr) _) = pprIfaceIdBndr bndr 772 go (Bndr (IfaceTvBndr bndr) vis) = 773 -- See Note [Pretty-printing invisible arguments] 774 case vis of 775 AnonTCB VisArg -> ppr_bndr (UseBndrParens True) 776 AnonTCB InvisArg -> char '@' <> braces (ppr_bndr (UseBndrParens False)) 777 -- The above case is rare. (See Note [AnonTCB InvisArg] in TyCon.) 778 -- Should we print these differently? 779 NamedTCB Required -> ppr_bndr (UseBndrParens True) 780 NamedTCB Specified -> char '@' <> ppr_bndr (UseBndrParens True) 781 NamedTCB Inferred -> char '@' <> braces (ppr_bndr (UseBndrParens False)) 782 where 783 ppr_bndr = pprIfaceTvBndr bndr suppress_sig 784 785instance Binary IfaceBndr where 786 put_ bh (IfaceIdBndr aa) = do 787 putByte bh 0 788 put_ bh aa 789 put_ bh (IfaceTvBndr ab) = do 790 putByte bh 1 791 put_ bh ab 792 get bh = do 793 h <- getByte bh 794 case h of 795 0 -> do aa <- get bh 796 return (IfaceIdBndr aa) 797 _ -> do ab <- get bh 798 return (IfaceTvBndr ab) 799 800instance Binary IfaceOneShot where 801 put_ bh IfaceNoOneShot = do 802 putByte bh 0 803 put_ bh IfaceOneShot = do 804 putByte bh 1 805 get bh = do 806 h <- getByte bh 807 case h of 808 0 -> do return IfaceNoOneShot 809 _ -> do return IfaceOneShot 810 811-- ----------------------------- Printing IfaceType ------------------------------------ 812 813--------------------------------- 814instance Outputable IfaceType where 815 ppr ty = pprIfaceType ty 816 817pprIfaceType, pprParendIfaceType :: IfaceType -> SDoc 818pprIfaceType = pprPrecIfaceType topPrec 819pprParendIfaceType = pprPrecIfaceType appPrec 820 821pprPrecIfaceType :: PprPrec -> IfaceType -> SDoc 822-- We still need `eliminateRuntimeRep`, since the `pprPrecIfaceType` maybe 823-- called from other places, besides `:type` and `:info`. 824pprPrecIfaceType prec ty = eliminateRuntimeRep (ppr_ty prec) ty 825 826ppr_sigma :: PprPrec -> IfaceType -> SDoc 827ppr_sigma ctxt_prec ty 828 = maybeParen ctxt_prec funPrec (pprIfaceSigmaType ShowForAllMust ty) 829 830ppr_ty :: PprPrec -> IfaceType -> SDoc 831ppr_ty ctxt_prec ty@(IfaceForAllTy {}) = ppr_sigma ctxt_prec ty 832ppr_ty ctxt_prec ty@(IfaceFunTy InvisArg _ _) = ppr_sigma ctxt_prec ty 833 834ppr_ty _ (IfaceFreeTyVar tyvar) = ppr tyvar -- This is the main reason for IfaceFreeTyVar! 835ppr_ty _ (IfaceTyVar tyvar) = ppr tyvar -- See Note [TcTyVars in IfaceType] 836ppr_ty ctxt_prec (IfaceTyConApp tc tys) = pprTyTcApp ctxt_prec tc tys 837ppr_ty ctxt_prec (IfaceTupleTy i p tys) = pprTuple ctxt_prec i p tys 838ppr_ty _ (IfaceLitTy n) = pprIfaceTyLit n 839 -- Function types 840ppr_ty ctxt_prec (IfaceFunTy _ ty1 ty2) -- Should be VisArg 841 = -- We don't want to lose synonyms, so we mustn't use splitFunTys here. 842 maybeParen ctxt_prec funPrec $ 843 sep [ppr_ty funPrec ty1, sep (ppr_fun_tail ty2)] 844 where 845 ppr_fun_tail (IfaceFunTy VisArg ty1 ty2) 846 = (arrow <+> ppr_ty funPrec ty1) : ppr_fun_tail ty2 847 ppr_fun_tail other_ty 848 = [arrow <+> pprIfaceType other_ty] 849 850ppr_ty ctxt_prec (IfaceAppTy t ts) 851 = if_print_coercions 852 ppr_app_ty 853 ppr_app_ty_no_casts 854 where 855 ppr_app_ty = 856 sdocWithDynFlags $ \dflags -> 857 pprIfacePrefixApp ctxt_prec 858 (ppr_ty funPrec t) 859 (map (ppr_app_arg appPrec) (tys_wo_kinds dflags)) 860 861 tys_wo_kinds dflags = appArgsIfaceTypesArgFlags $ stripInvisArgs dflags ts 862 863 -- Strip any casts from the head of the application 864 ppr_app_ty_no_casts = 865 case t of 866 IfaceCastTy head _ -> ppr_ty ctxt_prec (mk_app_tys head ts) 867 _ -> ppr_app_ty 868 869 mk_app_tys :: IfaceType -> IfaceAppArgs -> IfaceType 870 mk_app_tys (IfaceTyConApp tc tys1) tys2 = 871 IfaceTyConApp tc (tys1 `mappend` tys2) 872 mk_app_tys t1 tys2 = IfaceAppTy t1 tys2 873 874ppr_ty ctxt_prec (IfaceCastTy ty co) 875 = if_print_coercions 876 (parens (ppr_ty topPrec ty <+> text "|>" <+> ppr co)) 877 (ppr_ty ctxt_prec ty) 878 879ppr_ty ctxt_prec (IfaceCoercionTy co) 880 = if_print_coercions 881 (ppr_co ctxt_prec co) 882 (text "<>") 883 884{- Note [Defaulting RuntimeRep variables] 885~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 886RuntimeRep variables are considered by many (most?) users to be little 887more than syntactic noise. When the notion was introduced there was a 888signficant and understandable push-back from those with pedagogy in 889mind, which argued that RuntimeRep variables would throw a wrench into 890nearly any teach approach since they appear in even the lowly ($) 891function's type, 892 893 ($) :: forall (w :: RuntimeRep) a (b :: TYPE w). (a -> b) -> a -> b 894 895which is significantly less readable than its non RuntimeRep-polymorphic type of 896 897 ($) :: (a -> b) -> a -> b 898 899Moreover, unboxed types don't appear all that often in run-of-the-mill 900Haskell programs, so it makes little sense to make all users pay this 901syntactic overhead. 902 903For this reason it was decided that we would hide RuntimeRep variables 904for now (see #11549). We do this by defaulting all type variables of 905kind RuntimeRep to LiftedRep. This is done in a pass right before 906pretty-printing (defaultRuntimeRepVars, controlled by 907-fprint-explicit-runtime-reps) 908 909This applies to /quantified/ variables like 'w' above. What about 910variables that are /free/ in the type being printed, which certainly 911happens in error messages. Suppose (#16074) we are reporting a 912mismatch between two skolems 913 (a :: RuntimeRep) ~ (b :: RuntimeRep) 914We certainly don't want to say "Can't match LiftedRep ~ LiftedRep"! 915 916But if we are printing the type 917 (forall (a :: Type r). blah 918we do want to turn that (free) r into LiftedRep, so it prints as 919 (forall a. blah) 920 921Conclusion: keep track of whether we we are in the kind of a 922binder; ohly if so, convert free RuntimeRep variables to LiftedRep. 923-} 924 925-- | Default 'RuntimeRep' variables to 'LiftedPtr'. e.g. 926-- 927-- @ 928-- ($) :: forall (r :: GHC.Types.RuntimeRep) a (b :: TYPE r). 929-- (a -> b) -> a -> b 930-- @ 931-- 932-- turns in to, 933-- 934-- @ ($) :: forall a (b :: *). (a -> b) -> a -> b @ 935-- 936-- We do this to prevent RuntimeRep variables from incurring a significant 937-- syntactic overhead in otherwise simple type signatures (e.g. ($)). See 938-- Note [Defaulting RuntimeRep variables] and #11549 for further discussion. 939-- 940defaultRuntimeRepVars :: IfaceType -> IfaceType 941defaultRuntimeRepVars ty = go False emptyFsEnv ty 942 where 943 go :: Bool -- True <=> Inside the kind of a binder 944 -> FastStringEnv () -- Set of enclosing forall-ed RuntimeRep variables 945 -> IfaceType -- (replace them with LiftedRep) 946 -> IfaceType 947 go ink subs (IfaceForAllTy (Bndr (IfaceTvBndr (var, var_kind)) argf) ty) 948 | isRuntimeRep var_kind 949 , isInvisibleArgFlag argf -- Don't default *visible* quantification 950 -- or we get the mess in #13963 951 = let subs' = extendFsEnv subs var () 952 -- Record that we should replace it with LiftedRep, 953 -- and recurse, discarding the forall 954 in go ink subs' ty 955 956 go ink subs (IfaceForAllTy bndr ty) 957 = IfaceForAllTy (go_ifacebndr subs bndr) (go ink subs ty) 958 959 go _ subs ty@(IfaceTyVar tv) 960 | tv `elemFsEnv` subs 961 = IfaceTyConApp liftedRep IA_Nil 962 | otherwise 963 = ty 964 965 go in_kind _ ty@(IfaceFreeTyVar tv) 966 -- See Note [Defaulting RuntimeRep variables], about free vars 967 | in_kind && Type.isRuntimeRepTy (tyVarKind tv) 968 = IfaceTyConApp liftedRep IA_Nil 969 | otherwise 970 = ty 971 972 go ink subs (IfaceTyConApp tc tc_args) 973 = IfaceTyConApp tc (go_args ink subs tc_args) 974 975 go ink subs (IfaceTupleTy sort is_prom tc_args) 976 = IfaceTupleTy sort is_prom (go_args ink subs tc_args) 977 978 go ink subs (IfaceFunTy af arg res) 979 = IfaceFunTy af (go ink subs arg) (go ink subs res) 980 981 go ink subs (IfaceAppTy t ts) 982 = IfaceAppTy (go ink subs t) (go_args ink subs ts) 983 984 go ink subs (IfaceCastTy x co) 985 = IfaceCastTy (go ink subs x) co 986 987 go _ _ ty@(IfaceLitTy {}) = ty 988 go _ _ ty@(IfaceCoercionTy {}) = ty 989 990 go_ifacebndr :: FastStringEnv () -> IfaceForAllBndr -> IfaceForAllBndr 991 go_ifacebndr subs (Bndr (IfaceIdBndr (n, t)) argf) 992 = Bndr (IfaceIdBndr (n, go True subs t)) argf 993 go_ifacebndr subs (Bndr (IfaceTvBndr (n, t)) argf) 994 = Bndr (IfaceTvBndr (n, go True subs t)) argf 995 996 go_args :: Bool -> FastStringEnv () -> IfaceAppArgs -> IfaceAppArgs 997 go_args _ _ IA_Nil = IA_Nil 998 go_args ink subs (IA_Arg ty argf args) 999 = IA_Arg (go ink subs ty) argf (go_args ink subs args) 1000 1001 liftedRep :: IfaceTyCon 1002 liftedRep = IfaceTyCon dc_name (IfaceTyConInfo IsPromoted IfaceNormalTyCon) 1003 where dc_name = getName liftedRepDataConTyCon 1004 1005 isRuntimeRep :: IfaceType -> Bool 1006 isRuntimeRep (IfaceTyConApp tc _) = 1007 tc `ifaceTyConHasKey` runtimeRepTyConKey 1008 isRuntimeRep _ = False 1009 1010eliminateRuntimeRep :: (IfaceType -> SDoc) -> IfaceType -> SDoc 1011eliminateRuntimeRep f ty 1012 = sdocWithDynFlags $ \dflags -> 1013 getPprStyle $ \sty -> 1014 if userStyle sty && not (gopt Opt_PrintExplicitRuntimeReps dflags) 1015 then f (defaultRuntimeRepVars ty) 1016 else f ty 1017 1018instance Outputable IfaceAppArgs where 1019 ppr tca = pprIfaceAppArgs tca 1020 1021pprIfaceAppArgs, pprParendIfaceAppArgs :: IfaceAppArgs -> SDoc 1022pprIfaceAppArgs = ppr_app_args topPrec 1023pprParendIfaceAppArgs = ppr_app_args appPrec 1024 1025ppr_app_args :: PprPrec -> IfaceAppArgs -> SDoc 1026ppr_app_args ctx_prec = go 1027 where 1028 go :: IfaceAppArgs -> SDoc 1029 go IA_Nil = empty 1030 go (IA_Arg t argf ts) = ppr_app_arg ctx_prec (t, argf) <+> go ts 1031 1032-- See Note [Pretty-printing invisible arguments] 1033ppr_app_arg :: PprPrec -> (IfaceType, ArgFlag) -> SDoc 1034ppr_app_arg ctx_prec (t, argf) = 1035 sdocWithDynFlags $ \dflags -> 1036 let print_kinds = gopt Opt_PrintExplicitKinds dflags 1037 in case argf of 1038 Required -> ppr_ty ctx_prec t 1039 Specified | print_kinds 1040 -> char '@' <> ppr_ty appPrec t 1041 Inferred | print_kinds 1042 -> char '@' <> braces (ppr_ty topPrec t) 1043 _ -> empty 1044 1045------------------- 1046pprIfaceForAllPart :: [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc 1047pprIfaceForAllPart tvs ctxt sdoc 1048 = ppr_iface_forall_part ShowForAllWhen tvs ctxt sdoc 1049 1050-- | Like 'pprIfaceForAllPart', but always uses an explicit @forall@. 1051pprIfaceForAllPartMust :: [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc 1052pprIfaceForAllPartMust tvs ctxt sdoc 1053 = ppr_iface_forall_part ShowForAllMust tvs ctxt sdoc 1054 1055pprIfaceForAllCoPart :: [(IfLclName, IfaceCoercion)] -> SDoc -> SDoc 1056pprIfaceForAllCoPart tvs sdoc 1057 = sep [ pprIfaceForAllCo tvs, sdoc ] 1058 1059ppr_iface_forall_part :: ShowForAllFlag 1060 -> [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc 1061ppr_iface_forall_part show_forall tvs ctxt sdoc 1062 = sep [ case show_forall of 1063 ShowForAllMust -> pprIfaceForAll tvs 1064 ShowForAllWhen -> pprUserIfaceForAll tvs 1065 , pprIfaceContextArr ctxt 1066 , sdoc] 1067 1068-- | Render the "forall ... ." or "forall ... ->" bit of a type. 1069pprIfaceForAll :: [IfaceForAllBndr] -> SDoc 1070pprIfaceForAll [] = empty 1071pprIfaceForAll bndrs@(Bndr _ vis : _) 1072 = sep [ add_separator (forAllLit <+> fsep docs) 1073 , pprIfaceForAll bndrs' ] 1074 where 1075 (bndrs', docs) = ppr_itv_bndrs bndrs vis 1076 1077 add_separator stuff = case vis of 1078 Required -> stuff <+> arrow 1079 _inv -> stuff <> dot 1080 1081 1082-- | Render the ... in @(forall ... .)@ or @(forall ... ->)@. 1083-- Returns both the list of not-yet-rendered binders and the doc. 1084-- No anonymous binders here! 1085ppr_itv_bndrs :: [IfaceForAllBndr] 1086 -> ArgFlag -- ^ visibility of the first binder in the list 1087 -> ([IfaceForAllBndr], [SDoc]) 1088ppr_itv_bndrs all_bndrs@(bndr@(Bndr _ vis) : bndrs) vis1 1089 | vis `sameVis` vis1 = let (bndrs', doc) = ppr_itv_bndrs bndrs vis1 in 1090 (bndrs', pprIfaceForAllBndr bndr : doc) 1091 | otherwise = (all_bndrs, []) 1092ppr_itv_bndrs [] _ = ([], []) 1093 1094pprIfaceForAllCo :: [(IfLclName, IfaceCoercion)] -> SDoc 1095pprIfaceForAllCo [] = empty 1096pprIfaceForAllCo tvs = text "forall" <+> pprIfaceForAllCoBndrs tvs <> dot 1097 1098pprIfaceForAllCoBndrs :: [(IfLclName, IfaceCoercion)] -> SDoc 1099pprIfaceForAllCoBndrs bndrs = hsep $ map pprIfaceForAllCoBndr bndrs 1100 1101pprIfaceForAllBndr :: IfaceForAllBndr -> SDoc 1102pprIfaceForAllBndr bndr = 1103 case bndr of 1104 Bndr (IfaceTvBndr tv) Inferred -> 1105 sdocWithDynFlags $ \dflags -> 1106 if gopt Opt_PrintExplicitForalls dflags 1107 then braces $ pprIfaceTvBndr tv suppress_sig (UseBndrParens False) 1108 else pprIfaceTvBndr tv suppress_sig (UseBndrParens True) 1109 Bndr (IfaceTvBndr tv) _ -> 1110 pprIfaceTvBndr tv suppress_sig (UseBndrParens True) 1111 Bndr (IfaceIdBndr idv) _ -> pprIfaceIdBndr idv 1112 where 1113 -- See Note [Suppressing binder signatures] in IfaceType 1114 suppress_sig = SuppressBndrSig False 1115 1116pprIfaceForAllCoBndr :: (IfLclName, IfaceCoercion) -> SDoc 1117pprIfaceForAllCoBndr (tv, kind_co) 1118 = parens (ppr tv <+> dcolon <+> pprIfaceCoercion kind_co) 1119 1120-- | Show forall flag 1121-- 1122-- Unconditionally show the forall quantifier with ('ShowForAllMust') 1123-- or when ('ShowForAllWhen') the names used are free in the binder 1124-- or when compiling with -fprint-explicit-foralls. 1125data ShowForAllFlag = ShowForAllMust | ShowForAllWhen 1126 1127pprIfaceSigmaType :: ShowForAllFlag -> IfaceType -> SDoc 1128pprIfaceSigmaType show_forall ty 1129 = eliminateRuntimeRep ppr_fn ty 1130 where 1131 ppr_fn iface_ty = 1132 let (tvs, theta, tau) = splitIfaceSigmaTy iface_ty 1133 in ppr_iface_forall_part show_forall tvs theta (ppr tau) 1134 1135pprUserIfaceForAll :: [IfaceForAllBndr] -> SDoc 1136pprUserIfaceForAll tvs 1137 = sdocWithDynFlags $ \dflags -> 1138 -- See Note [When to print foralls] in this module. 1139 ppWhen (any tv_has_kind_var tvs 1140 || any tv_is_required tvs 1141 || gopt Opt_PrintExplicitForalls dflags) $ 1142 pprIfaceForAll tvs 1143 where 1144 tv_has_kind_var (Bndr (IfaceTvBndr (_,kind)) _) 1145 = not (ifTypeIsVarFree kind) 1146 tv_has_kind_var _ = False 1147 1148 tv_is_required = isVisibleArgFlag . binderArgFlag 1149 1150{- 1151Note [When to print foralls] 1152~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1153We opt to explicitly pretty-print `forall`s if any of the following 1154criteria are met: 1155 11561. -fprint-explicit-foralls is on. 1157 11582. A bound type variable has a polymorphic kind. E.g., 1159 1160 forall k (a::k). Proxy a -> Proxy a 1161 1162 Since a's kind mentions a variable k, we print the foralls. 1163 11643. A bound type variable is a visible argument (#14238). 1165 Suppose we are printing the kind of: 1166 1167 T :: forall k -> k -> Type 1168 1169 The "forall k ->" notation means that this kind argument is required. 1170 That is, it must be supplied at uses of T. E.g., 1171 1172 f :: T (Type->Type) Monad -> Int 1173 1174 So we print an explicit "T :: forall k -> k -> Type", 1175 because omitting it and printing "T :: k -> Type" would be 1176 utterly misleading. 1177 1178 See Note [VarBndrs, TyCoVarBinders, TyConBinders, and visibility] 1179 in TyCoRep. 1180 1181N.B. Until now (Aug 2018) we didn't check anything for coercion variables. 1182 1183Note [Printing foralls in type family instances] 1184~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1185We use the same criteria as in Note [When to print foralls] to determine 1186whether a type family instance should be pretty-printed with an explicit 1187`forall`. Example: 1188 1189 type family Foo (a :: k) :: k where 1190 Foo Maybe = [] 1191 Foo (a :: Type) = Int 1192 Foo a = a 1193 1194Without -fprint-explicit-foralls enabled, this will be pretty-printed as: 1195 1196type family Foo (a :: k) :: k where 1197 Foo Maybe = [] 1198 Foo a = Int 1199 forall k (a :: k). Foo a = a 1200 1201Note that only the third equation has an explicit forall, since it has a type 1202variable with a non-Type kind. (If -fprint-explicit-foralls were enabled, then 1203the second equation would be preceded with `forall a.`.) 1204 1205There is one tricky point in the implementation: what visibility 1206do we give the type variables in a type family instance? Type family instances 1207only store type *variables*, not type variable *binders*, and only the latter 1208has visibility information. We opt to default the visibility of each of these 1209type variables to Specified because users can't ever instantiate these 1210variables manually, so the choice of visibility is only relevant to 1211pretty-printing. (This is why the `k` in `forall k (a :: k). ...` above is 1212printed the way it is, even though it wasn't written explicitly in the 1213original source code.) 1214 1215We adopt the same strategy for data family instances. Example: 1216 1217 data family DF (a :: k) 1218 data instance DF '[a, b] = DFList 1219 1220That data family instance is pretty-printed as: 1221 1222 data instance forall j (a :: j) (b :: j). DF '[a, b] = DFList 1223 1224This is despite that the representation tycon for this data instance (call it 1225$DF:List) actually has different visibilities for its binders. 1226However, the visibilities of these binders are utterly irrelevant to the 1227programmer, who cares only about the specificity of variables in `DF`'s type, 1228not $DF:List's type. Therefore, we opt to pretty-print all variables in data 1229family instances as Specified. 1230 1231Note [Printing promoted type constructors] 1232~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1233Consider this GHCi session (#14343) 1234 > _ :: Proxy '[ 'True ] 1235 error: 1236 Found hole: _ :: Proxy '['True] 1237 1238This would be bad, because the '[' looks like a character literal. 1239Solution: in type-level lists and tuples, add a leading space 1240if the first type is itself promoted. See pprSpaceIfPromotedTyCon. 1241-} 1242 1243 1244------------------- 1245 1246-- | Prefix a space if the given 'IfaceType' is a promoted 'TyCon'. 1247-- See Note [Printing promoted type constructors] 1248pprSpaceIfPromotedTyCon :: IfaceType -> SDoc -> SDoc 1249pprSpaceIfPromotedTyCon (IfaceTyConApp tyCon _) 1250 = case ifaceTyConIsPromoted (ifaceTyConInfo tyCon) of 1251 IsPromoted -> (space <>) 1252 _ -> id 1253pprSpaceIfPromotedTyCon _ 1254 = id 1255 1256-- See equivalent function in TyCoRep.hs 1257pprIfaceTyList :: PprPrec -> IfaceType -> IfaceType -> SDoc 1258-- Given a type-level list (t1 ': t2), see if we can print 1259-- it in list notation [t1, ...]. 1260-- Precondition: Opt_PrintExplicitKinds is off 1261pprIfaceTyList ctxt_prec ty1 ty2 1262 = case gather ty2 of 1263 (arg_tys, Nothing) 1264 -> char '\'' <> brackets (pprSpaceIfPromotedTyCon ty1 (fsep 1265 (punctuate comma (map (ppr_ty topPrec) (ty1:arg_tys))))) 1266 (arg_tys, Just tl) 1267 -> maybeParen ctxt_prec funPrec $ hang (ppr_ty funPrec ty1) 1268 2 (fsep [ colon <+> ppr_ty funPrec ty | ty <- arg_tys ++ [tl]]) 1269 where 1270 gather :: IfaceType -> ([IfaceType], Maybe IfaceType) 1271 -- (gather ty) = (tys, Nothing) means ty is a list [t1, .., tn] 1272 -- = (tys, Just tl) means ty is of form t1:t2:...tn:tl 1273 gather (IfaceTyConApp tc tys) 1274 | tc `ifaceTyConHasKey` consDataConKey 1275 , IA_Arg _ argf (IA_Arg ty1 Required (IA_Arg ty2 Required IA_Nil)) <- tys 1276 , isInvisibleArgFlag argf 1277 , (args, tl) <- gather ty2 1278 = (ty1:args, tl) 1279 | tc `ifaceTyConHasKey` nilDataConKey 1280 = ([], Nothing) 1281 gather ty = ([], Just ty) 1282 1283pprIfaceTypeApp :: PprPrec -> IfaceTyCon -> IfaceAppArgs -> SDoc 1284pprIfaceTypeApp prec tc args = pprTyTcApp prec tc args 1285 1286pprTyTcApp :: PprPrec -> IfaceTyCon -> IfaceAppArgs -> SDoc 1287pprTyTcApp ctxt_prec tc tys = 1288 sdocWithDynFlags $ \dflags -> 1289 getPprStyle $ \style -> 1290 pprTyTcApp' ctxt_prec tc tys dflags style 1291 1292pprTyTcApp' :: PprPrec -> IfaceTyCon -> IfaceAppArgs 1293 -> DynFlags -> PprStyle -> SDoc 1294pprTyTcApp' ctxt_prec tc tys dflags style 1295 | ifaceTyConName tc `hasKey` ipClassKey 1296 , IA_Arg (IfaceLitTy (IfaceStrTyLit n)) 1297 Required (IA_Arg ty Required IA_Nil) <- tys 1298 = maybeParen ctxt_prec funPrec 1299 $ char '?' <> ftext n <> text "::" <> ppr_ty topPrec ty 1300 1301 | IfaceTupleTyCon arity sort <- ifaceTyConSort info 1302 , not (debugStyle style) 1303 , arity == ifaceVisAppArgsLength tys 1304 = pprTuple ctxt_prec sort (ifaceTyConIsPromoted info) tys 1305 1306 | IfaceSumTyCon arity <- ifaceTyConSort info 1307 = pprSum arity (ifaceTyConIsPromoted info) tys 1308 1309 | tc `ifaceTyConHasKey` consDataConKey 1310 , not (gopt Opt_PrintExplicitKinds dflags) 1311 , IA_Arg _ argf (IA_Arg ty1 Required (IA_Arg ty2 Required IA_Nil)) <- tys 1312 , isInvisibleArgFlag argf 1313 = pprIfaceTyList ctxt_prec ty1 ty2 1314 1315 | tc `ifaceTyConHasKey` tYPETyConKey 1316 , IA_Arg (IfaceTyConApp rep IA_Nil) Required IA_Nil <- tys 1317 , rep `ifaceTyConHasKey` liftedRepDataConKey 1318 = kindType 1319 1320 | otherwise 1321 = getPprDebug $ \dbg -> 1322 if | not dbg && tc `ifaceTyConHasKey` errorMessageTypeErrorFamKey 1323 -- Suppress detail unles you _really_ want to see 1324 -> text "(TypeError ...)" 1325 1326 | Just doc <- ppr_equality ctxt_prec tc (appArgsIfaceTypes tys) 1327 -> doc 1328 1329 | otherwise 1330 -> ppr_iface_tc_app ppr_app_arg ctxt_prec tc tys_wo_kinds 1331 where 1332 info = ifaceTyConInfo tc 1333 tys_wo_kinds = appArgsIfaceTypesArgFlags $ stripInvisArgs dflags tys 1334 1335-- | Pretty-print a type-level equality. 1336-- Returns (Just doc) if the argument is a /saturated/ application 1337-- of eqTyCon (~) 1338-- eqPrimTyCon (~#) 1339-- eqReprPrimTyCon (~R#) 1340-- heqTyCon (~~) 1341-- 1342-- See Note [Equality predicates in IfaceType] 1343-- and Note [The equality types story] in TysPrim 1344ppr_equality :: PprPrec -> IfaceTyCon -> [IfaceType] -> Maybe SDoc 1345ppr_equality ctxt_prec tc args 1346 | hetero_eq_tc 1347 , [k1, k2, t1, t2] <- args 1348 = Just $ print_equality (k1, k2, t1, t2) 1349 1350 | hom_eq_tc 1351 , [k, t1, t2] <- args 1352 = Just $ print_equality (k, k, t1, t2) 1353 1354 | otherwise 1355 = Nothing 1356 where 1357 homogeneous = tc_name `hasKey` eqTyConKey -- (~) 1358 || hetero_tc_used_homogeneously 1359 where 1360 hetero_tc_used_homogeneously 1361 = case ifaceTyConSort $ ifaceTyConInfo tc of 1362 IfaceEqualityTyCon -> True 1363 _other -> False 1364 -- True <=> a heterogeneous equality whose arguments 1365 -- are (in this case) of the same kind 1366 1367 tc_name = ifaceTyConName tc 1368 pp = ppr_ty 1369 hom_eq_tc = tc_name `hasKey` eqTyConKey -- (~) 1370 hetero_eq_tc = tc_name `hasKey` eqPrimTyConKey -- (~#) 1371 || tc_name `hasKey` eqReprPrimTyConKey -- (~R#) 1372 || tc_name `hasKey` heqTyConKey -- (~~) 1373 nominal_eq_tc = tc_name `hasKey` heqTyConKey -- (~~) 1374 || tc_name `hasKey` eqPrimTyConKey -- (~#) 1375 print_equality args = 1376 sdocWithDynFlags $ \dflags -> 1377 getPprStyle $ \style -> 1378 print_equality' args style dflags 1379 1380 print_equality' (ki1, ki2, ty1, ty2) style dflags 1381 | -- If -fprint-equality-relations is on, just print the original TyCon 1382 print_eqs 1383 = ppr_infix_eq (ppr tc) 1384 1385 | -- Homogeneous use of heterogeneous equality (ty1 ~~ ty2) 1386 -- or unlifted equality (ty1 ~# ty2) 1387 nominal_eq_tc, homogeneous 1388 = ppr_infix_eq (text "~") 1389 1390 | -- Heterogeneous use of unlifted equality (ty1 ~# ty2) 1391 not homogeneous 1392 = ppr_infix_eq (ppr heqTyCon) 1393 1394 | -- Homogeneous use of representational unlifted equality (ty1 ~R# ty2) 1395 tc_name `hasKey` eqReprPrimTyConKey, homogeneous 1396 = let ki | print_kinds = [pp appPrec ki1] 1397 | otherwise = [] 1398 in pprIfacePrefixApp ctxt_prec (ppr coercibleTyCon) 1399 (ki ++ [pp appPrec ty1, pp appPrec ty2]) 1400 1401 -- The other cases work as you'd expect 1402 | otherwise 1403 = ppr_infix_eq (ppr tc) 1404 where 1405 ppr_infix_eq :: SDoc -> SDoc 1406 ppr_infix_eq eq_op = pprIfaceInfixApp ctxt_prec eq_op 1407 (pp_ty_ki ty1 ki1) (pp_ty_ki ty2 ki2) 1408 where 1409 pp_ty_ki ty ki 1410 | print_kinds 1411 = parens (pp topPrec ty <+> dcolon <+> pp opPrec ki) 1412 | otherwise 1413 = pp opPrec ty 1414 1415 print_kinds = gopt Opt_PrintExplicitKinds dflags 1416 print_eqs = gopt Opt_PrintEqualityRelations dflags || 1417 dumpStyle style || debugStyle style 1418 1419 1420pprIfaceCoTcApp :: PprPrec -> IfaceTyCon -> [IfaceCoercion] -> SDoc 1421pprIfaceCoTcApp ctxt_prec tc tys = 1422 ppr_iface_tc_app (\prec (co, _) -> ppr_co prec co) ctxt_prec tc 1423 (map (, Required) tys) 1424 -- We are trying to re-use ppr_iface_tc_app here, which requires its 1425 -- arguments to be accompanied by visibilities. But visibility is 1426 -- irrelevant when printing coercions, so just default everything to 1427 -- Required. 1428 1429-- | Pretty-prints an application of a type constructor to some arguments 1430-- (whose visibilities are known). This is polymorphic (over @a@) since we use 1431-- this function to pretty-print two different things: 1432-- 1433-- 1. Types (from `pprTyTcApp'`) 1434-- 1435-- 2. Coercions (from 'pprIfaceCoTcApp') 1436ppr_iface_tc_app :: (PprPrec -> (a, ArgFlag) -> SDoc) 1437 -> PprPrec -> IfaceTyCon -> [(a, ArgFlag)] -> SDoc 1438ppr_iface_tc_app pp _ tc [ty] 1439 | tc `ifaceTyConHasKey` listTyConKey = pprPromotionQuote tc <> brackets (pp topPrec ty) 1440 1441ppr_iface_tc_app pp ctxt_prec tc tys 1442 | tc `ifaceTyConHasKey` liftedTypeKindTyConKey 1443 = kindType 1444 1445 | not (isSymOcc (nameOccName (ifaceTyConName tc))) 1446 = pprIfacePrefixApp ctxt_prec (ppr tc) (map (pp appPrec) tys) 1447 1448 | [ ty1@(_, Required) 1449 , ty2@(_, Required) ] <- tys 1450 -- Infix, two visible arguments (we know nothing of precedence though). 1451 -- Don't apply this special case if one of the arguments is invisible, 1452 -- lest we print something like (@LiftedRep -> @LiftedRep) (#15941). 1453 = pprIfaceInfixApp ctxt_prec (ppr tc) 1454 (pp opPrec ty1) (pp opPrec ty2) 1455 1456 | otherwise 1457 = pprIfacePrefixApp ctxt_prec (parens (ppr tc)) (map (pp appPrec) tys) 1458 1459pprSum :: Arity -> PromotionFlag -> IfaceAppArgs -> SDoc 1460pprSum _arity is_promoted args 1461 = -- drop the RuntimeRep vars. 1462 -- See Note [Unboxed tuple RuntimeRep vars] in TyCon 1463 let tys = appArgsIfaceTypes args 1464 args' = drop (length tys `div` 2) tys 1465 in pprPromotionQuoteI is_promoted 1466 <> sumParens (pprWithBars (ppr_ty topPrec) args') 1467 1468pprTuple :: PprPrec -> TupleSort -> PromotionFlag -> IfaceAppArgs -> SDoc 1469pprTuple ctxt_prec sort promoted args = 1470 case promoted of 1471 IsPromoted 1472 -> let tys = appArgsIfaceTypes args 1473 args' = drop (length tys `div` 2) tys 1474 spaceIfPromoted = case args' of 1475 arg0:_ -> pprSpaceIfPromotedTyCon arg0 1476 _ -> id 1477 in ppr_tuple_app args' $ 1478 pprPromotionQuoteI IsPromoted <> 1479 tupleParens sort (spaceIfPromoted (pprWithCommas pprIfaceType args')) 1480 1481 NotPromoted 1482 | ConstraintTuple <- sort 1483 , IA_Nil <- args 1484 -> maybeParen ctxt_prec sigPrec $ 1485 text "() :: Constraint" 1486 1487 | otherwise 1488 -> -- drop the RuntimeRep vars. 1489 -- See Note [Unboxed tuple RuntimeRep vars] in TyCon 1490 let tys = appArgsIfaceTypes args 1491 args' = case sort of 1492 UnboxedTuple -> drop (length tys `div` 2) tys 1493 _ -> tys 1494 in 1495 ppr_tuple_app args' $ 1496 pprPromotionQuoteI promoted <> 1497 tupleParens sort (pprWithCommas pprIfaceType args') 1498 where 1499 ppr_tuple_app :: [IfaceType] -> SDoc -> SDoc 1500 ppr_tuple_app args_wo_runtime_reps ppr_args_w_parens 1501 -- Special-case unary boxed tuples so that they are pretty-printed as 1502 -- `Unit x`, not `(x)` 1503 | [_] <- args_wo_runtime_reps 1504 , BoxedTuple <- sort 1505 = let unit_tc_info = IfaceTyConInfo promoted IfaceNormalTyCon 1506 unit_tc = IfaceTyCon (tupleTyConName sort 1) unit_tc_info in 1507 pprPrecIfaceType ctxt_prec $ IfaceTyConApp unit_tc args 1508 | otherwise 1509 = ppr_args_w_parens 1510 1511pprIfaceTyLit :: IfaceTyLit -> SDoc 1512pprIfaceTyLit (IfaceNumTyLit n) = integer n 1513pprIfaceTyLit (IfaceStrTyLit n) = text (show n) 1514 1515pprIfaceCoercion, pprParendIfaceCoercion :: IfaceCoercion -> SDoc 1516pprIfaceCoercion = ppr_co topPrec 1517pprParendIfaceCoercion = ppr_co appPrec 1518 1519ppr_co :: PprPrec -> IfaceCoercion -> SDoc 1520ppr_co _ (IfaceReflCo ty) = angleBrackets (ppr ty) <> ppr_role Nominal 1521ppr_co _ (IfaceGReflCo r ty IfaceMRefl) 1522 = angleBrackets (ppr ty) <> ppr_role r 1523ppr_co ctxt_prec (IfaceGReflCo r ty (IfaceMCo co)) 1524 = ppr_special_co ctxt_prec 1525 (text "GRefl" <+> ppr r <+> pprParendIfaceType ty) [co] 1526ppr_co ctxt_prec (IfaceFunCo r co1 co2) 1527 = maybeParen ctxt_prec funPrec $ 1528 sep (ppr_co funPrec co1 : ppr_fun_tail co2) 1529 where 1530 ppr_fun_tail (IfaceFunCo r co1 co2) 1531 = (arrow <> ppr_role r <+> ppr_co funPrec co1) : ppr_fun_tail co2 1532 ppr_fun_tail other_co 1533 = [arrow <> ppr_role r <+> pprIfaceCoercion other_co] 1534 1535ppr_co _ (IfaceTyConAppCo r tc cos) 1536 = parens (pprIfaceCoTcApp topPrec tc cos) <> ppr_role r 1537ppr_co ctxt_prec (IfaceAppCo co1 co2) 1538 = maybeParen ctxt_prec appPrec $ 1539 ppr_co funPrec co1 <+> pprParendIfaceCoercion co2 1540ppr_co ctxt_prec co@(IfaceForAllCo {}) 1541 = maybeParen ctxt_prec funPrec $ 1542 pprIfaceForAllCoPart tvs (pprIfaceCoercion inner_co) 1543 where 1544 (tvs, inner_co) = split_co co 1545 1546 split_co (IfaceForAllCo (IfaceTvBndr (name, _)) kind_co co') 1547 = let (tvs, co'') = split_co co' in ((name,kind_co):tvs,co'') 1548 split_co (IfaceForAllCo (IfaceIdBndr (name, _)) kind_co co') 1549 = let (tvs, co'') = split_co co' in ((name,kind_co):tvs,co'') 1550 split_co co' = ([], co') 1551 1552-- Why these three? See Note [TcTyVars in IfaceType] 1553ppr_co _ (IfaceFreeCoVar covar) = ppr covar 1554ppr_co _ (IfaceCoVarCo covar) = ppr covar 1555ppr_co _ (IfaceHoleCo covar) = braces (ppr covar) 1556 1557ppr_co ctxt_prec (IfaceUnivCo IfaceUnsafeCoerceProv r ty1 ty2) 1558 = maybeParen ctxt_prec appPrec $ 1559 text "UnsafeCo" <+> ppr r <+> 1560 pprParendIfaceType ty1 <+> pprParendIfaceType ty2 1561 1562ppr_co _ (IfaceUnivCo prov role ty1 ty2) 1563 = text "Univ" <> (parens $ 1564 sep [ ppr role <+> pprIfaceUnivCoProv prov 1565 , dcolon <+> ppr ty1 <> comma <+> ppr ty2 ]) 1566 1567ppr_co ctxt_prec (IfaceInstCo co ty) 1568 = maybeParen ctxt_prec appPrec $ 1569 text "Inst" <+> pprParendIfaceCoercion co 1570 <+> pprParendIfaceCoercion ty 1571 1572ppr_co ctxt_prec (IfaceAxiomRuleCo tc cos) 1573 = maybeParen ctxt_prec appPrec $ ppr tc <+> parens (interpp'SP cos) 1574 1575ppr_co ctxt_prec (IfaceAxiomInstCo n i cos) 1576 = ppr_special_co ctxt_prec (ppr n <> brackets (ppr i)) cos 1577ppr_co ctxt_prec (IfaceSymCo co) 1578 = ppr_special_co ctxt_prec (text "Sym") [co] 1579ppr_co ctxt_prec (IfaceTransCo co1 co2) 1580 = maybeParen ctxt_prec opPrec $ 1581 ppr_co opPrec co1 <+> semi <+> ppr_co opPrec co2 1582ppr_co ctxt_prec (IfaceNthCo d co) 1583 = ppr_special_co ctxt_prec (text "Nth:" <> int d) [co] 1584ppr_co ctxt_prec (IfaceLRCo lr co) 1585 = ppr_special_co ctxt_prec (ppr lr) [co] 1586ppr_co ctxt_prec (IfaceSubCo co) 1587 = ppr_special_co ctxt_prec (text "Sub") [co] 1588ppr_co ctxt_prec (IfaceKindCo co) 1589 = ppr_special_co ctxt_prec (text "Kind") [co] 1590 1591ppr_special_co :: PprPrec -> SDoc -> [IfaceCoercion] -> SDoc 1592ppr_special_co ctxt_prec doc cos 1593 = maybeParen ctxt_prec appPrec 1594 (sep [doc, nest 4 (sep (map pprParendIfaceCoercion cos))]) 1595 1596ppr_role :: Role -> SDoc 1597ppr_role r = underscore <> pp_role 1598 where pp_role = case r of 1599 Nominal -> char 'N' 1600 Representational -> char 'R' 1601 Phantom -> char 'P' 1602 1603------------------ 1604pprIfaceUnivCoProv :: IfaceUnivCoProv -> SDoc 1605pprIfaceUnivCoProv IfaceUnsafeCoerceProv 1606 = text "unsafe" 1607pprIfaceUnivCoProv (IfacePhantomProv co) 1608 = text "phantom" <+> pprParendIfaceCoercion co 1609pprIfaceUnivCoProv (IfaceProofIrrelProv co) 1610 = text "irrel" <+> pprParendIfaceCoercion co 1611pprIfaceUnivCoProv (IfacePluginProv s) 1612 = text "plugin" <+> doubleQuotes (text s) 1613 1614------------------- 1615instance Outputable IfaceTyCon where 1616 ppr tc = pprPromotionQuote tc <> ppr (ifaceTyConName tc) 1617 1618pprPromotionQuote :: IfaceTyCon -> SDoc 1619pprPromotionQuote tc = 1620 pprPromotionQuoteI $ ifaceTyConIsPromoted $ ifaceTyConInfo tc 1621 1622pprPromotionQuoteI :: PromotionFlag -> SDoc 1623pprPromotionQuoteI NotPromoted = empty 1624pprPromotionQuoteI IsPromoted = char '\'' 1625 1626instance Outputable IfaceCoercion where 1627 ppr = pprIfaceCoercion 1628 1629instance Binary IfaceTyCon where 1630 put_ bh (IfaceTyCon n i) = put_ bh n >> put_ bh i 1631 1632 get bh = do n <- get bh 1633 i <- get bh 1634 return (IfaceTyCon n i) 1635 1636instance Binary IfaceTyConSort where 1637 put_ bh IfaceNormalTyCon = putByte bh 0 1638 put_ bh (IfaceTupleTyCon arity sort) = putByte bh 1 >> put_ bh arity >> put_ bh sort 1639 put_ bh (IfaceSumTyCon arity) = putByte bh 2 >> put_ bh arity 1640 put_ bh IfaceEqualityTyCon = putByte bh 3 1641 1642 get bh = do 1643 n <- getByte bh 1644 case n of 1645 0 -> return IfaceNormalTyCon 1646 1 -> IfaceTupleTyCon <$> get bh <*> get bh 1647 2 -> IfaceSumTyCon <$> get bh 1648 _ -> return IfaceEqualityTyCon 1649 1650instance Binary IfaceTyConInfo where 1651 put_ bh (IfaceTyConInfo i s) = put_ bh i >> put_ bh s 1652 1653 get bh = IfaceTyConInfo <$> get bh <*> get bh 1654 1655instance Outputable IfaceTyLit where 1656 ppr = pprIfaceTyLit 1657 1658instance Binary IfaceTyLit where 1659 put_ bh (IfaceNumTyLit n) = putByte bh 1 >> put_ bh n 1660 put_ bh (IfaceStrTyLit n) = putByte bh 2 >> put_ bh n 1661 1662 get bh = 1663 do tag <- getByte bh 1664 case tag of 1665 1 -> do { n <- get bh 1666 ; return (IfaceNumTyLit n) } 1667 2 -> do { n <- get bh 1668 ; return (IfaceStrTyLit n) } 1669 _ -> panic ("get IfaceTyLit " ++ show tag) 1670 1671instance Binary IfaceAppArgs where 1672 put_ bh tk = 1673 case tk of 1674 IA_Arg t a ts -> putByte bh 0 >> put_ bh t >> put_ bh a >> put_ bh ts 1675 IA_Nil -> putByte bh 1 1676 1677 get bh = 1678 do c <- getByte bh 1679 case c of 1680 0 -> do 1681 t <- get bh 1682 a <- get bh 1683 ts <- get bh 1684 return $! IA_Arg t a ts 1685 1 -> return IA_Nil 1686 _ -> panic ("get IfaceAppArgs " ++ show c) 1687 1688------------------- 1689 1690-- Some notes about printing contexts 1691-- 1692-- In the event that we are printing a singleton context (e.g. @Eq a@) we can 1693-- omit parentheses. However, we must take care to set the precedence correctly 1694-- to opPrec, since something like @a :~: b@ must be parenthesized (see 1695-- #9658). 1696-- 1697-- When printing a larger context we use 'fsep' instead of 'sep' so that 1698-- the context doesn't get displayed as a giant column. Rather than, 1699-- instance (Eq a, 1700-- Eq b, 1701-- Eq c, 1702-- Eq d, 1703-- Eq e, 1704-- Eq f, 1705-- Eq g, 1706-- Eq h, 1707-- Eq i, 1708-- Eq j, 1709-- Eq k, 1710-- Eq l) => 1711-- Eq (a, b, c, d, e, f, g, h, i, j, k, l) 1712-- 1713-- we want 1714-- 1715-- instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h, Eq i, 1716-- Eq j, Eq k, Eq l) => 1717-- Eq (a, b, c, d, e, f, g, h, i, j, k, l) 1718 1719 1720 1721-- | Prints "(C a, D b) =>", including the arrow. 1722-- Used when we want to print a context in a type, so we 1723-- use 'funPrec' to decide whether to parenthesise a singleton 1724-- predicate; e.g. Num a => a -> a 1725pprIfaceContextArr :: [IfacePredType] -> SDoc 1726pprIfaceContextArr [] = empty 1727pprIfaceContextArr [pred] = ppr_ty funPrec pred <+> darrow 1728pprIfaceContextArr preds = ppr_parend_preds preds <+> darrow 1729 1730-- | Prints a context or @()@ if empty 1731-- You give it the context precedence 1732pprIfaceContext :: PprPrec -> [IfacePredType] -> SDoc 1733pprIfaceContext _ [] = text "()" 1734pprIfaceContext prec [pred] = ppr_ty prec pred 1735pprIfaceContext _ preds = ppr_parend_preds preds 1736 1737ppr_parend_preds :: [IfacePredType] -> SDoc 1738ppr_parend_preds preds = parens (fsep (punctuate comma (map ppr preds))) 1739 1740instance Binary IfaceType where 1741 put_ _ (IfaceFreeTyVar tv) 1742 = pprPanic "Can't serialise IfaceFreeTyVar" (ppr tv) 1743 1744 put_ bh (IfaceForAllTy aa ab) = do 1745 putByte bh 0 1746 put_ bh aa 1747 put_ bh ab 1748 put_ bh (IfaceTyVar ad) = do 1749 putByte bh 1 1750 put_ bh ad 1751 put_ bh (IfaceAppTy ae af) = do 1752 putByte bh 2 1753 put_ bh ae 1754 put_ bh af 1755 put_ bh (IfaceFunTy af ag ah) = do 1756 putByte bh 3 1757 put_ bh af 1758 put_ bh ag 1759 put_ bh ah 1760 put_ bh (IfaceTyConApp tc tys) 1761 = do { putByte bh 5; put_ bh tc; put_ bh tys } 1762 put_ bh (IfaceCastTy a b) 1763 = do { putByte bh 6; put_ bh a; put_ bh b } 1764 put_ bh (IfaceCoercionTy a) 1765 = do { putByte bh 7; put_ bh a } 1766 put_ bh (IfaceTupleTy s i tys) 1767 = do { putByte bh 8; put_ bh s; put_ bh i; put_ bh tys } 1768 put_ bh (IfaceLitTy n) 1769 = do { putByte bh 9; put_ bh n } 1770 1771 get bh = do 1772 h <- getByte bh 1773 case h of 1774 0 -> do aa <- get bh 1775 ab <- get bh 1776 return (IfaceForAllTy aa ab) 1777 1 -> do ad <- get bh 1778 return (IfaceTyVar ad) 1779 2 -> do ae <- get bh 1780 af <- get bh 1781 return (IfaceAppTy ae af) 1782 3 -> do af <- get bh 1783 ag <- get bh 1784 ah <- get bh 1785 return (IfaceFunTy af ag ah) 1786 5 -> do { tc <- get bh; tys <- get bh 1787 ; return (IfaceTyConApp tc tys) } 1788 6 -> do { a <- get bh; b <- get bh 1789 ; return (IfaceCastTy a b) } 1790 7 -> do { a <- get bh 1791 ; return (IfaceCoercionTy a) } 1792 1793 8 -> do { s <- get bh; i <- get bh; tys <- get bh 1794 ; return (IfaceTupleTy s i tys) } 1795 _ -> do n <- get bh 1796 return (IfaceLitTy n) 1797 1798instance Binary IfaceMCoercion where 1799 put_ bh IfaceMRefl = do 1800 putByte bh 1 1801 put_ bh (IfaceMCo co) = do 1802 putByte bh 2 1803 put_ bh co 1804 1805 get bh = do 1806 tag <- getByte bh 1807 case tag of 1808 1 -> return IfaceMRefl 1809 2 -> do a <- get bh 1810 return $ IfaceMCo a 1811 _ -> panic ("get IfaceMCoercion " ++ show tag) 1812 1813instance Binary IfaceCoercion where 1814 put_ bh (IfaceReflCo a) = do 1815 putByte bh 1 1816 put_ bh a 1817 put_ bh (IfaceGReflCo a b c) = do 1818 putByte bh 2 1819 put_ bh a 1820 put_ bh b 1821 put_ bh c 1822 put_ bh (IfaceFunCo a b c) = do 1823 putByte bh 3 1824 put_ bh a 1825 put_ bh b 1826 put_ bh c 1827 put_ bh (IfaceTyConAppCo a b c) = do 1828 putByte bh 4 1829 put_ bh a 1830 put_ bh b 1831 put_ bh c 1832 put_ bh (IfaceAppCo a b) = do 1833 putByte bh 5 1834 put_ bh a 1835 put_ bh b 1836 put_ bh (IfaceForAllCo a b c) = do 1837 putByte bh 6 1838 put_ bh a 1839 put_ bh b 1840 put_ bh c 1841 put_ bh (IfaceCoVarCo a) = do 1842 putByte bh 7 1843 put_ bh a 1844 put_ bh (IfaceAxiomInstCo a b c) = do 1845 putByte bh 8 1846 put_ bh a 1847 put_ bh b 1848 put_ bh c 1849 put_ bh (IfaceUnivCo a b c d) = do 1850 putByte bh 9 1851 put_ bh a 1852 put_ bh b 1853 put_ bh c 1854 put_ bh d 1855 put_ bh (IfaceSymCo a) = do 1856 putByte bh 10 1857 put_ bh a 1858 put_ bh (IfaceTransCo a b) = do 1859 putByte bh 11 1860 put_ bh a 1861 put_ bh b 1862 put_ bh (IfaceNthCo a b) = do 1863 putByte bh 12 1864 put_ bh a 1865 put_ bh b 1866 put_ bh (IfaceLRCo a b) = do 1867 putByte bh 13 1868 put_ bh a 1869 put_ bh b 1870 put_ bh (IfaceInstCo a b) = do 1871 putByte bh 14 1872 put_ bh a 1873 put_ bh b 1874 put_ bh (IfaceKindCo a) = do 1875 putByte bh 15 1876 put_ bh a 1877 put_ bh (IfaceSubCo a) = do 1878 putByte bh 16 1879 put_ bh a 1880 put_ bh (IfaceAxiomRuleCo a b) = do 1881 putByte bh 17 1882 put_ bh a 1883 put_ bh b 1884 put_ _ (IfaceFreeCoVar cv) 1885 = pprPanic "Can't serialise IfaceFreeCoVar" (ppr cv) 1886 put_ _ (IfaceHoleCo cv) 1887 = pprPanic "Can't serialise IfaceHoleCo" (ppr cv) 1888 -- See Note [Holes in IfaceCoercion] 1889 1890 get bh = do 1891 tag <- getByte bh 1892 case tag of 1893 1 -> do a <- get bh 1894 return $ IfaceReflCo a 1895 2 -> do a <- get bh 1896 b <- get bh 1897 c <- get bh 1898 return $ IfaceGReflCo a b c 1899 3 -> do a <- get bh 1900 b <- get bh 1901 c <- get bh 1902 return $ IfaceFunCo a b c 1903 4 -> do a <- get bh 1904 b <- get bh 1905 c <- get bh 1906 return $ IfaceTyConAppCo a b c 1907 5 -> do a <- get bh 1908 b <- get bh 1909 return $ IfaceAppCo a b 1910 6 -> do a <- get bh 1911 b <- get bh 1912 c <- get bh 1913 return $ IfaceForAllCo a b c 1914 7 -> do a <- get bh 1915 return $ IfaceCoVarCo a 1916 8 -> do a <- get bh 1917 b <- get bh 1918 c <- get bh 1919 return $ IfaceAxiomInstCo a b c 1920 9 -> do a <- get bh 1921 b <- get bh 1922 c <- get bh 1923 d <- get bh 1924 return $ IfaceUnivCo a b c d 1925 10-> do a <- get bh 1926 return $ IfaceSymCo a 1927 11-> do a <- get bh 1928 b <- get bh 1929 return $ IfaceTransCo a b 1930 12-> do a <- get bh 1931 b <- get bh 1932 return $ IfaceNthCo a b 1933 13-> do a <- get bh 1934 b <- get bh 1935 return $ IfaceLRCo a b 1936 14-> do a <- get bh 1937 b <- get bh 1938 return $ IfaceInstCo a b 1939 15-> do a <- get bh 1940 return $ IfaceKindCo a 1941 16-> do a <- get bh 1942 return $ IfaceSubCo a 1943 17-> do a <- get bh 1944 b <- get bh 1945 return $ IfaceAxiomRuleCo a b 1946 _ -> panic ("get IfaceCoercion " ++ show tag) 1947 1948instance Binary IfaceUnivCoProv where 1949 put_ bh IfaceUnsafeCoerceProv = putByte bh 1 1950 put_ bh (IfacePhantomProv a) = do 1951 putByte bh 2 1952 put_ bh a 1953 put_ bh (IfaceProofIrrelProv a) = do 1954 putByte bh 3 1955 put_ bh a 1956 put_ bh (IfacePluginProv a) = do 1957 putByte bh 4 1958 put_ bh a 1959 1960 get bh = do 1961 tag <- getByte bh 1962 case tag of 1963 1 -> return $ IfaceUnsafeCoerceProv 1964 2 -> do a <- get bh 1965 return $ IfacePhantomProv a 1966 3 -> do a <- get bh 1967 return $ IfaceProofIrrelProv a 1968 4 -> do a <- get bh 1969 return $ IfacePluginProv a 1970 _ -> panic ("get IfaceUnivCoProv " ++ show tag) 1971 1972 1973instance Binary (DefMethSpec IfaceType) where 1974 put_ bh VanillaDM = putByte bh 0 1975 put_ bh (GenericDM t) = putByte bh 1 >> put_ bh t 1976 get bh = do 1977 h <- getByte bh 1978 case h of 1979 0 -> return VanillaDM 1980 _ -> do { t <- get bh; return (GenericDM t) } 1981 1982instance NFData IfaceType where 1983 rnf = \case 1984 IfaceFreeTyVar f1 -> f1 `seq` () 1985 IfaceTyVar f1 -> rnf f1 1986 IfaceLitTy f1 -> rnf f1 1987 IfaceAppTy f1 f2 -> rnf f1 `seq` rnf f2 1988 IfaceFunTy f1 f2 f3 -> f1 `seq` rnf f2 `seq` rnf f3 1989 IfaceForAllTy f1 f2 -> f1 `seq` rnf f2 1990 IfaceTyConApp f1 f2 -> rnf f1 `seq` rnf f2 1991 IfaceCastTy f1 f2 -> rnf f1 `seq` rnf f2 1992 IfaceCoercionTy f1 -> rnf f1 1993 IfaceTupleTy f1 f2 f3 -> f1 `seq` f2 `seq` rnf f3 1994 1995instance NFData IfaceTyLit where 1996 rnf = \case 1997 IfaceNumTyLit f1 -> rnf f1 1998 IfaceStrTyLit f1 -> rnf f1 1999 2000instance NFData IfaceCoercion where 2001 rnf = \case 2002 IfaceReflCo f1 -> rnf f1 2003 IfaceGReflCo f1 f2 f3 -> f1 `seq` rnf f2 `seq` rnf f3 2004 IfaceFunCo f1 f2 f3 -> f1 `seq` rnf f2 `seq` rnf f3 2005 IfaceTyConAppCo f1 f2 f3 -> f1 `seq` rnf f2 `seq` rnf f3 2006 IfaceAppCo f1 f2 -> rnf f1 `seq` rnf f2 2007 IfaceForAllCo f1 f2 f3 -> rnf f1 `seq` rnf f2 `seq` rnf f3 2008 IfaceCoVarCo f1 -> rnf f1 2009 IfaceAxiomInstCo f1 f2 f3 -> rnf f1 `seq` rnf f2 `seq` rnf f3 2010 IfaceAxiomRuleCo f1 f2 -> rnf f1 `seq` rnf f2 2011 IfaceUnivCo f1 f2 f3 f4 -> rnf f1 `seq` f2 `seq` rnf f3 `seq` rnf f4 2012 IfaceSymCo f1 -> rnf f1 2013 IfaceTransCo f1 f2 -> rnf f1 `seq` rnf f2 2014 IfaceNthCo f1 f2 -> rnf f1 `seq` rnf f2 2015 IfaceLRCo f1 f2 -> f1 `seq` rnf f2 2016 IfaceInstCo f1 f2 -> rnf f1 `seq` rnf f2 2017 IfaceKindCo f1 -> rnf f1 2018 IfaceSubCo f1 -> rnf f1 2019 IfaceFreeCoVar f1 -> f1 `seq` () 2020 IfaceHoleCo f1 -> f1 `seq` () 2021 2022instance NFData IfaceUnivCoProv where 2023 rnf x = seq x () 2024 2025instance NFData IfaceMCoercion where 2026 rnf x = seq x () 2027 2028instance NFData IfaceOneShot where 2029 rnf x = seq x () 2030 2031instance NFData IfaceTyConSort where 2032 rnf = \case 2033 IfaceNormalTyCon -> () 2034 IfaceTupleTyCon arity sort -> rnf arity `seq` sort `seq` () 2035 IfaceSumTyCon arity -> rnf arity 2036 IfaceEqualityTyCon -> () 2037 2038instance NFData IfaceTyConInfo where 2039 rnf (IfaceTyConInfo f s) = f `seq` rnf s 2040 2041instance NFData IfaceTyCon where 2042 rnf (IfaceTyCon nm info) = rnf nm `seq` rnf info 2043 2044instance NFData IfaceBndr where 2045 rnf = \case 2046 IfaceIdBndr id_bndr -> rnf id_bndr 2047 IfaceTvBndr tv_bndr -> rnf tv_bndr 2048 2049instance NFData IfaceAppArgs where 2050 rnf = \case 2051 IA_Nil -> () 2052 IA_Arg f1 f2 f3 -> rnf f1 `seq` f2 `seq` rnf f3 2053