print * in unicode correctly (fixes #12550)
[ghc.git] / compiler / iface / IfaceType.hs
1 {-
2 (c) The University of Glasgow 2006
3 (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
4
5
6 This module defines interface types and binders
7 -}
8
9 {-# LANGUAGE CPP, FlexibleInstances, BangPatterns #-}
10 -- FlexibleInstances for Binary (DefMethSpec IfaceType)
11
12 module IfaceType (
13 IfExtName, IfLclName,
14
15 IfaceType(..), IfacePredType, IfaceKind, IfaceCoercion(..),
16 IfaceUnivCoProv(..),
17 IfaceTyCon(..), IfaceTyConInfo(..), IfaceTyConSort(..), IsPromoted(..),
18 IfaceTyLit(..), IfaceTcArgs(..),
19 IfaceContext, IfaceBndr(..), IfaceOneShot(..), IfaceLamBndr,
20 IfaceTvBndr, IfaceIdBndr, IfaceTyConBinder,
21 IfaceForAllBndr, ArgFlag(..),
22
23 ifTyConBinderTyVar, ifTyConBinderName,
24
25 -- Equality testing
26 IfRnEnv2, emptyIfRnEnv2, eqIfaceType, eqIfaceTypes,
27 eqIfaceTcArgs, eqIfaceTvBndrs, isIfaceLiftedTypeKind,
28
29 -- Conversion from IfaceTcArgs -> [IfaceType]
30 tcArgsIfaceTypes,
31
32 -- Printing
33 pprIfaceType, pprParendIfaceType,
34 pprIfaceContext, pprIfaceContextArr,
35 pprIfaceIdBndr, pprIfaceLamBndr, pprIfaceTvBndr, pprIfaceTyConBinders,
36 pprIfaceBndrs, pprIfaceTcArgs, pprParendIfaceTcArgs,
37 pprIfaceForAllPart, pprIfaceForAll, pprIfaceSigmaType,
38 pprIfaceTyLit,
39 pprIfaceCoercion, pprParendIfaceCoercion,
40 splitIfaceSigmaTy, pprIfaceTypeApp, pprUserIfaceForAll,
41 pprIfaceCoTcApp, pprTyTcApp, pprIfacePrefixApp,
42
43 suppressIfaceInvisibles,
44 stripIfaceInvisVars,
45 stripInvisArgs,
46 substIfaceType, substIfaceTyVar, substIfaceTcArgs, mkIfaceTySubst,
47 eqIfaceTvBndr
48 ) where
49
50 #include "HsVersions.h"
51
52 import {-# SOURCE #-} TysWiredIn ( ptrRepLiftedDataConTyCon )
53
54 import DynFlags
55 import StaticFlags ( opt_PprStyle_Debug )
56 import TyCon hiding ( pprPromotionQuote )
57 import CoAxiom
58 import Var
59 import PrelNames
60 import Name
61 import BasicTypes
62 import Binary
63 import Outputable
64 import FastString
65 import FastStringEnv
66 import UniqFM
67 import Util
68
69 import Data.List (foldl')
70
71 {-
72 ************************************************************************
73 * *
74 Local (nested) binders
75 * *
76 ************************************************************************
77 -}
78
79 type IfLclName = FastString -- A local name in iface syntax
80
81 type IfExtName = Name -- An External or WiredIn Name can appear in IfaceSyn
82 -- (However Internal or System Names never should)
83
84 data IfaceBndr -- Local (non-top-level) binders
85 = IfaceIdBndr {-# UNPACK #-} !IfaceIdBndr
86 | IfaceTvBndr {-# UNPACK #-} !IfaceTvBndr
87
88 type IfaceIdBndr = (IfLclName, IfaceType)
89 type IfaceTvBndr = (IfLclName, IfaceKind)
90
91 ifaceTvBndrName :: IfaceTvBndr -> IfLclName
92 ifaceTvBndrName (n,_) = n
93
94 type IfaceLamBndr = (IfaceBndr, IfaceOneShot)
95
96 data IfaceOneShot -- See Note [Preserve OneShotInfo] in CoreTicy
97 = IfaceNoOneShot -- and Note [The oneShot function] in MkId
98 | IfaceOneShot
99
100
101 {-
102 %************************************************************************
103 %* *
104 IfaceType
105 %* *
106 %************************************************************************
107 -}
108
109 -------------------------------
110 type IfaceKind = IfaceType
111
112 data IfaceType -- A kind of universal type, used for types and kinds
113 = IfaceTcTyVar TyVar -- See Note [TcTyVars in IfaceType]
114 | IfaceTyVar IfLclName -- Type/coercion variable only, not tycon
115 | IfaceLitTy IfaceTyLit
116 | IfaceAppTy IfaceType IfaceType
117 | IfaceFunTy IfaceType IfaceType
118 | IfaceDFunTy IfaceType IfaceType
119 | IfaceForAllTy IfaceForAllBndr IfaceType
120 | IfaceTyConApp IfaceTyCon IfaceTcArgs -- Not necessarily saturated
121 -- Includes newtypes, synonyms, tuples
122 | IfaceCastTy IfaceType IfaceCoercion
123 | IfaceCoercionTy IfaceCoercion
124
125 | IfaceTupleTy -- Saturated tuples (unsaturated ones use IfaceTyConApp)
126 TupleSort -- What sort of tuple?
127 IsPromoted -- A bit like IfaceTyCon
128 IfaceTcArgs -- arity = length args
129 -- For promoted data cons, the kind args are omitted
130
131 type IfacePredType = IfaceType
132 type IfaceContext = [IfacePredType]
133
134 data IfaceTyLit
135 = IfaceNumTyLit Integer
136 | IfaceStrTyLit FastString
137 deriving (Eq)
138
139 type IfaceTyConBinder = TyVarBndr IfaceTvBndr TyConBndrVis
140 type IfaceForAllBndr = TyVarBndr IfaceTvBndr ArgFlag
141
142 -- See Note [Suppressing invisible arguments]
143 -- We use a new list type (rather than [(IfaceType,Bool)], because
144 -- it'll be more compact and faster to parse in interface
145 -- files. Rather than two bytes and two decisions (nil/cons, and
146 -- type/kind) there'll just be one.
147 data IfaceTcArgs
148 = ITC_Nil
149 | ITC_Vis IfaceType IfaceTcArgs -- "Vis" means show when pretty-printing
150 | ITC_Invis IfaceKind IfaceTcArgs -- "Invis" means don't show when pretty-printing
151 -- except with -fprint-explicit-kinds
152
153 instance Monoid IfaceTcArgs where
154 mempty = ITC_Nil
155 ITC_Nil `mappend` xs = xs
156 ITC_Vis ty rest `mappend` xs = ITC_Vis ty (rest `mappend` xs)
157 ITC_Invis ki rest `mappend` xs = ITC_Invis ki (rest `mappend` xs)
158
159 -- Encodes type constructors, kind constructors,
160 -- coercion constructors, the lot.
161 -- We have to tag them in order to pretty print them
162 -- properly.
163 data IfaceTyCon = IfaceTyCon { ifaceTyConName :: IfExtName
164 , ifaceTyConInfo :: IfaceTyConInfo }
165 deriving (Eq)
166
167 -- | Is a TyCon a promoted data constructor or just a normal type constructor?
168 data IsPromoted = IsNotPromoted | IsPromoted
169 deriving (Eq)
170
171 -- | The various types of TyCons which have special, built-in syntax.
172 data IfaceTyConSort = IfaceNormalTyCon -- ^ a regular tycon
173
174 | IfaceTupleTyCon !Arity !TupleSort
175 -- ^ e.g. @(a, b, c)@ or @(#a, b, c#)@.
176 -- The arity is the tuple width, not the tycon arity
177 -- (which is twice the width in the case of unboxed
178 -- tuples).
179
180 | IfaceSumTyCon !Arity
181 -- ^ e.g. @(a | b | c)@
182
183 | IfaceEqualityTyCon !Bool
184 -- ^ a type equality. 'True' indicates kind-homogeneous.
185 -- See Note [Equality predicates in IfaceType] for
186 -- details.
187 deriving (Eq)
188
189 {- Note [TcTyVars in IfaceType]
190 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
191 Nowadays (since Nov 16, 2016) we pretty-print a Type by converting to an
192 IfaceType and pretty printing that. This eliminates a lot of
193 pretty-print duplication, and it matches what we do with
194 pretty-printing TyThings.
195
196 It works fine for closed types, but when printing debug traces (e.g.
197 when using -ddump-tc-trace) we print a lot of /open/ types. These
198 types are full of TcTyVars, and it's absolutely crucial to print them
199 in their full glory, with their unique, TcTyVarDetails etc.
200
201 So we simply embed a TcTyVar in IfaceType with the IfaceTcTyVar constructor.
202 Note that:
203
204 * We never expect to serialise an IfaceTcTyVar into an interface file, nor
205 to deserialise one. IfaceTcTyVar is used only in the "convert to IfaceType
206 and then pretty-print" pipeline.
207
208
209 Note [Equality predicates in IfaceType]
210 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
211 GHC has several varieties of type equality (see Note [The equality types story]
212 in TysPrim for details) which all must be rendered with different surface syntax
213 during pretty-printing. Which syntax we use depends upon,
214
215 1. Which predicate tycon was used
216 2. Whether the types being compared are of the same kind.
217
218 Unfortunately, determining (2) from an IfaceType isn't possible since we can't
219 see through type synonyms. Consequently, we need to record whether the equality
220 is homogeneous or not in IfaceTyConSort for the purposes of pretty-printing.
221
222 Namely we handle these cases,
223
224 Predicate Homogeneous Heterogeneous
225 ---------------- ----------- -------------
226 eqTyCon ~ N/A
227 heqTyCon ~ ~~
228 eqPrimTyCon ~# ~~
229 eqReprPrimTyCon Coercible Coercible
230
231 -}
232
233 data IfaceTyConInfo -- Used to guide pretty-printing
234 -- and to disambiguate D from 'D (they share a name)
235 = IfaceTyConInfo { ifaceTyConIsPromoted :: IsPromoted
236 , ifaceTyConSort :: IfaceTyConSort }
237 deriving (Eq)
238
239 data IfaceCoercion
240 = IfaceReflCo Role IfaceType
241 | IfaceFunCo Role IfaceCoercion IfaceCoercion
242 | IfaceTyConAppCo Role IfaceTyCon [IfaceCoercion]
243 | IfaceAppCo IfaceCoercion IfaceCoercion
244 | IfaceForAllCo IfaceTvBndr IfaceCoercion IfaceCoercion
245 | IfaceCoVarCo IfLclName
246 | IfaceAxiomInstCo IfExtName BranchIndex [IfaceCoercion]
247 | IfaceUnivCo IfaceUnivCoProv Role IfaceType IfaceType
248 | IfaceSymCo IfaceCoercion
249 | IfaceTransCo IfaceCoercion IfaceCoercion
250 | IfaceNthCo Int IfaceCoercion
251 | IfaceLRCo LeftOrRight IfaceCoercion
252 | IfaceInstCo IfaceCoercion IfaceCoercion
253 | IfaceCoherenceCo IfaceCoercion IfaceCoercion
254 | IfaceKindCo IfaceCoercion
255 | IfaceSubCo IfaceCoercion
256 | IfaceAxiomRuleCo IfLclName [IfaceCoercion]
257
258 data IfaceUnivCoProv
259 = IfaceUnsafeCoerceProv
260 | IfacePhantomProv IfaceCoercion
261 | IfaceProofIrrelProv IfaceCoercion
262 | IfacePluginProv String
263 | IfaceHoleProv Unique
264 -- ^ See Note [Holes in IfaceUnivCoProv]
265
266 {-
267 Note [Holes in IfaceUnivCoProv]
268 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
269 When typechecking fails the typechecker will produce a HoleProv UnivCoProv to
270 stand in place of the unproven assertion. While we generally don't want to let
271 these unproven assertions leak into interface files, we still need to be able to
272 pretty-print them as we use IfaceType's pretty-printer to render Types. For this
273 reason IfaceUnivCoProv has a IfaceHoleProv constructor; however, we fails when
274 asked to serialize to a IfaceHoleProv to ensure that they don't end up in an
275 interface file. To avoid an import loop between IfaceType and TyCoRep we only
276 keep the hole's Unique, since that is all we need to print.
277 -}
278
279 {-
280 %************************************************************************
281 %* *
282 Functions over IFaceTypes
283 * *
284 ************************************************************************
285 -}
286
287 ifaceTyConHasKey :: IfaceTyCon -> Unique -> Bool
288 ifaceTyConHasKey tc key = ifaceTyConName tc `hasKey` key
289
290 eqIfaceTvBndr :: IfaceTvBndr -> IfaceTvBndr -> Bool
291 eqIfaceTvBndr (occ1, _) (occ2, _) = occ1 == occ2
292
293 isIfaceLiftedTypeKind :: IfaceKind -> Bool
294 isIfaceLiftedTypeKind (IfaceTyConApp tc ITC_Nil)
295 = isLiftedTypeKindTyConName (ifaceTyConName tc)
296 isIfaceLiftedTypeKind (IfaceTyConApp tc
297 (ITC_Vis (IfaceTyConApp ptr_rep_lifted ITC_Nil) ITC_Nil))
298 = tc `ifaceTyConHasKey` tYPETyConKey
299 && ptr_rep_lifted `ifaceTyConHasKey` ptrRepLiftedDataConKey
300 isIfaceLiftedTypeKind _ = False
301
302 splitIfaceSigmaTy :: IfaceType -> ([IfaceForAllBndr], [IfacePredType], IfaceType)
303 -- Mainly for printing purposes
304 splitIfaceSigmaTy ty
305 = (bndrs, theta, tau)
306 where
307 (bndrs, rho) = split_foralls ty
308 (theta, tau) = split_rho rho
309
310 split_foralls (IfaceForAllTy bndr ty)
311 = case split_foralls ty of { (bndrs, rho) -> (bndr:bndrs, rho) }
312 split_foralls rho = ([], rho)
313
314 split_rho (IfaceDFunTy ty1 ty2)
315 = case split_rho ty2 of { (ps, tau) -> (ty1:ps, tau) }
316 split_rho tau = ([], tau)
317
318 suppressIfaceInvisibles :: DynFlags -> [IfaceTyConBinder] -> [a] -> [a]
319 suppressIfaceInvisibles dflags tys xs
320 | gopt Opt_PrintExplicitKinds dflags = xs
321 | otherwise = suppress tys xs
322 where
323 suppress _ [] = []
324 suppress [] a = a
325 suppress (k:ks) a@(_:xs)
326 | isInvisibleTyConBinder k = suppress ks xs
327 | otherwise = a
328
329 stripIfaceInvisVars :: DynFlags -> [IfaceTyConBinder] -> [IfaceTyConBinder]
330 stripIfaceInvisVars dflags tyvars
331 | gopt Opt_PrintExplicitKinds dflags = tyvars
332 | otherwise = filterOut isInvisibleTyConBinder tyvars
333
334 -- | Extract a IfaceTvBndr from a IfaceTyConBinder
335 ifTyConBinderTyVar :: IfaceTyConBinder -> IfaceTvBndr
336 ifTyConBinderTyVar = binderVar
337
338 -- | Extract the variable name from a IfaceTyConBinder
339 ifTyConBinderName :: IfaceTyConBinder -> IfLclName
340 ifTyConBinderName tcb = ifaceTvBndrName (ifTyConBinderTyVar tcb)
341
342 ifTypeIsVarFree :: IfaceType -> Bool
343 -- Returns True if the type definitely has no variables at all
344 -- Just used to control pretty printing
345 ifTypeIsVarFree ty = go ty
346 where
347 go (IfaceTyVar {}) = False
348 go (IfaceTcTyVar {}) = False
349 go (IfaceAppTy fun arg) = go fun && go arg
350 go (IfaceFunTy arg res) = go arg && go res
351 go (IfaceDFunTy arg res) = go arg && go res
352 go (IfaceForAllTy {}) = False
353 go (IfaceTyConApp _ args) = go_args args
354 go (IfaceTupleTy _ _ args) = go_args args
355 go (IfaceLitTy _) = True
356 go (IfaceCastTy {}) = False -- Safe
357 go (IfaceCoercionTy {}) = False -- Safe
358
359 go_args ITC_Nil = True
360 go_args (ITC_Vis arg args) = go arg && go_args args
361 go_args (ITC_Invis arg args) = go arg && go_args args
362
363 {-
364 Substitutions on IfaceType. This is only used during pretty-printing to construct
365 the result type of a GADT, and does not deal with binders (eg IfaceForAll), so
366 it doesn't need fancy capture stuff.
367 -}
368
369 type IfaceTySubst = FastStringEnv IfaceType
370
371 mkIfaceTySubst :: [IfaceTvBndr] -> [IfaceType] -> IfaceTySubst
372 mkIfaceTySubst tvs tys = mkFsEnv $ zipWithEqual "mkIfaceTySubst" (\(fs,_) ty -> (fs,ty)) tvs tys
373
374 substIfaceType :: IfaceTySubst -> IfaceType -> IfaceType
375 substIfaceType env ty
376 = go ty
377 where
378 go (IfaceTcTyVar tv) = IfaceTcTyVar tv
379 go (IfaceTyVar tv) = substIfaceTyVar env tv
380 go (IfaceAppTy t1 t2) = IfaceAppTy (go t1) (go t2)
381 go (IfaceFunTy t1 t2) = IfaceFunTy (go t1) (go t2)
382 go (IfaceDFunTy t1 t2) = IfaceDFunTy (go t1) (go t2)
383 go ty@(IfaceLitTy {}) = ty
384 go (IfaceTyConApp tc tys) = IfaceTyConApp tc (substIfaceTcArgs env tys)
385 go (IfaceTupleTy s i tys) = IfaceTupleTy s i (substIfaceTcArgs env tys)
386 go (IfaceForAllTy {}) = pprPanic "substIfaceType" (ppr ty)
387 go (IfaceCastTy ty co) = IfaceCastTy (go ty) (go_co co)
388 go (IfaceCoercionTy co) = IfaceCoercionTy (go_co co)
389
390 go_co (IfaceReflCo r ty) = IfaceReflCo r (go ty)
391 go_co (IfaceFunCo r c1 c2) = IfaceFunCo r (go_co c1) (go_co c2)
392 go_co (IfaceTyConAppCo r tc cos) = IfaceTyConAppCo r tc (go_cos cos)
393 go_co (IfaceAppCo c1 c2) = IfaceAppCo (go_co c1) (go_co c2)
394 go_co (IfaceForAllCo {}) = pprPanic "substIfaceCoercion" (ppr ty)
395 go_co (IfaceCoVarCo cv) = IfaceCoVarCo cv
396 go_co (IfaceAxiomInstCo a i cos) = IfaceAxiomInstCo a i (go_cos cos)
397 go_co (IfaceUnivCo prov r t1 t2) = IfaceUnivCo (go_prov prov) r (go t1) (go t2)
398 go_co (IfaceSymCo co) = IfaceSymCo (go_co co)
399 go_co (IfaceTransCo co1 co2) = IfaceTransCo (go_co co1) (go_co co2)
400 go_co (IfaceNthCo n co) = IfaceNthCo n (go_co co)
401 go_co (IfaceLRCo lr co) = IfaceLRCo lr (go_co co)
402 go_co (IfaceInstCo c1 c2) = IfaceInstCo (go_co c1) (go_co c2)
403 go_co (IfaceCoherenceCo c1 c2) = IfaceCoherenceCo (go_co c1) (go_co c2)
404 go_co (IfaceKindCo co) = IfaceKindCo (go_co co)
405 go_co (IfaceSubCo co) = IfaceSubCo (go_co co)
406 go_co (IfaceAxiomRuleCo n cos) = IfaceAxiomRuleCo n (go_cos cos)
407
408 go_cos = map go_co
409
410 go_prov IfaceUnsafeCoerceProv = IfaceUnsafeCoerceProv
411 go_prov (IfacePhantomProv co) = IfacePhantomProv (go_co co)
412 go_prov (IfaceProofIrrelProv co) = IfaceProofIrrelProv (go_co co)
413 go_prov (IfacePluginProv str) = IfacePluginProv str
414 go_prov (IfaceHoleProv h) = IfaceHoleProv h
415
416 substIfaceTcArgs :: IfaceTySubst -> IfaceTcArgs -> IfaceTcArgs
417 substIfaceTcArgs env args
418 = go args
419 where
420 go ITC_Nil = ITC_Nil
421 go (ITC_Vis ty tys) = ITC_Vis (substIfaceType env ty) (go tys)
422 go (ITC_Invis ty tys) = ITC_Invis (substIfaceType env ty) (go tys)
423
424 substIfaceTyVar :: IfaceTySubst -> IfLclName -> IfaceType
425 substIfaceTyVar env tv
426 | Just ty <- lookupFsEnv env tv = ty
427 | otherwise = IfaceTyVar tv
428
429 {-
430 ************************************************************************
431 * *
432 Equality over IfaceTypes
433 * *
434 ************************************************************************
435
436 Note [No kind check in ifaces]
437 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
438 We check iface types for equality only when checking the consistency
439 between two user-written signatures. In these cases, there is no possibility
440 for a kind mismatch. So we omit the kind check (which would be impossible to
441 write, anyway.)
442
443 -}
444
445 -- Like an RnEnv2, but mapping from FastString to deBruijn index
446 -- DeBruijn; see eqTypeX
447 type BoundVar = Int
448 data IfRnEnv2
449 = IRV2 { ifenvL :: UniqFM BoundVar -- from FastString
450 , ifenvR :: UniqFM BoundVar
451 , ifenv_next :: BoundVar
452 }
453
454 emptyIfRnEnv2 :: IfRnEnv2
455 emptyIfRnEnv2 = IRV2 { ifenvL = emptyUFM
456 , ifenvR = emptyUFM
457 , ifenv_next = 0 }
458
459 rnIfOccL :: IfRnEnv2 -> IfLclName -> Maybe BoundVar
460 rnIfOccL env = lookupUFM (ifenvL env)
461
462 rnIfOccR :: IfRnEnv2 -> IfLclName -> Maybe BoundVar
463 rnIfOccR env = lookupUFM (ifenvR env)
464
465 extendIfRnEnv2 :: IfRnEnv2 -> IfLclName -> IfLclName -> IfRnEnv2
466 extendIfRnEnv2 IRV2 { ifenvL = lenv
467 , ifenvR = renv
468 , ifenv_next = n } tv1 tv2
469 = IRV2 { ifenvL = addToUFM lenv tv1 n
470 , ifenvR = addToUFM renv tv2 n
471 , ifenv_next = n + 1
472 }
473
474 -- See Note [No kind check in ifaces]
475 eqIfaceType :: IfRnEnv2 -> IfaceType -> IfaceType -> Bool
476 eqIfaceType _ (IfaceTcTyVar tv1) (IfaceTcTyVar tv2)
477 = tv1 == tv2 -- Should not happen
478 eqIfaceType env (IfaceTyVar tv1) (IfaceTyVar tv2) =
479 case (rnIfOccL env tv1, rnIfOccR env tv2) of
480 (Just v1, Just v2) -> v1 == v2
481 (Nothing, Nothing) -> tv1 == tv2
482 _ -> False
483 eqIfaceType _ (IfaceLitTy l1) (IfaceLitTy l2) = l1 == l2
484 eqIfaceType env (IfaceAppTy t11 t12) (IfaceAppTy t21 t22)
485 = eqIfaceType env t11 t21 && eqIfaceType env t12 t22
486 eqIfaceType env (IfaceFunTy t11 t12) (IfaceFunTy t21 t22)
487 = eqIfaceType env t11 t21 && eqIfaceType env t12 t22
488 eqIfaceType env (IfaceDFunTy t11 t12) (IfaceDFunTy t21 t22)
489 = eqIfaceType env t11 t21 && eqIfaceType env t12 t22
490 eqIfaceType env (IfaceForAllTy bndr1 t1) (IfaceForAllTy bndr2 t2)
491 = eqIfaceForAllBndr env bndr1 bndr2 (\env' -> eqIfaceType env' t1 t2)
492 eqIfaceType env (IfaceTyConApp tc1 tys1) (IfaceTyConApp tc2 tys2)
493 = tc1 == tc2 && eqIfaceTcArgs env tys1 tys2
494 eqIfaceType env (IfaceTupleTy s1 tc1 tys1) (IfaceTupleTy s2 tc2 tys2)
495 = s1 == s2 && tc1 == tc2 && eqIfaceTcArgs env tys1 tys2
496 eqIfaceType env (IfaceCastTy t1 _) (IfaceCastTy t2 _)
497 = eqIfaceType env t1 t2
498 eqIfaceType _ (IfaceCoercionTy {}) (IfaceCoercionTy {})
499 = True
500 eqIfaceType _ _ _ = False
501
502 eqIfaceTypes :: IfRnEnv2 -> [IfaceType] -> [IfaceType] -> Bool
503 eqIfaceTypes env tys1 tys2 = and (zipWith (eqIfaceType env) tys1 tys2)
504
505 eqIfaceForAllBndr :: IfRnEnv2 -> IfaceForAllBndr -> IfaceForAllBndr
506 -> (IfRnEnv2 -> Bool) -- continuation
507 -> Bool
508 eqIfaceForAllBndr env (TvBndr (tv1, k1) vis1) (TvBndr (tv2, k2) vis2) k
509 = eqIfaceType env k1 k2 && vis1 == vis2 &&
510 k (extendIfRnEnv2 env tv1 tv2)
511
512 eqIfaceTcArgs :: IfRnEnv2 -> IfaceTcArgs -> IfaceTcArgs -> Bool
513 eqIfaceTcArgs _ ITC_Nil ITC_Nil = True
514 eqIfaceTcArgs env (ITC_Vis ty1 tys1) (ITC_Vis ty2 tys2)
515 = eqIfaceType env ty1 ty2 && eqIfaceTcArgs env tys1 tys2
516 eqIfaceTcArgs env (ITC_Invis ty1 tys1) (ITC_Invis ty2 tys2)
517 = eqIfaceType env ty1 ty2 && eqIfaceTcArgs env tys1 tys2
518 eqIfaceTcArgs _ _ _ = False
519
520 -- | Similar to 'eqTyVarBndrs', checks that tyvar lists
521 -- are the same length and have matching kinds; if so, extend the
522 -- 'IfRnEnv2'. Returns 'Nothing' if they don't match.
523 eqIfaceTvBndrs :: IfRnEnv2 -> [IfaceTvBndr] -> [IfaceTvBndr] -> Maybe IfRnEnv2
524 eqIfaceTvBndrs env [] [] = Just env
525 eqIfaceTvBndrs env ((tv1, k1):tvs1) ((tv2, k2):tvs2)
526 | eqIfaceType env k1 k2
527 = eqIfaceTvBndrs (extendIfRnEnv2 env tv1 tv2) tvs1 tvs2
528 eqIfaceTvBndrs _ _ _ = Nothing
529
530 {-
531 ************************************************************************
532 * *
533 Functions over IFaceTcArgs
534 * *
535 ************************************************************************
536 -}
537
538 stripInvisArgs :: DynFlags -> IfaceTcArgs -> IfaceTcArgs
539 stripInvisArgs dflags tys
540 | gopt Opt_PrintExplicitKinds dflags = tys
541 | otherwise = suppress_invis tys
542 where
543 suppress_invis c
544 = case c of
545 ITC_Invis _ ts -> suppress_invis ts
546 _ -> c
547
548 tcArgsIfaceTypes :: IfaceTcArgs -> [IfaceType]
549 tcArgsIfaceTypes ITC_Nil = []
550 tcArgsIfaceTypes (ITC_Invis t ts) = t : tcArgsIfaceTypes ts
551 tcArgsIfaceTypes (ITC_Vis t ts) = t : tcArgsIfaceTypes ts
552
553 ifaceVisTcArgsLength :: IfaceTcArgs -> Int
554 ifaceVisTcArgsLength = go 0
555 where
556 go !n ITC_Nil = n
557 go n (ITC_Vis _ rest) = go (n+1) rest
558 go n (ITC_Invis _ rest) = go n rest
559
560 {-
561 Note [Suppressing invisible arguments]
562 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
563 We use the IfaceTcArgs to specify which of the arguments to a type
564 constructor should be displayed when pretty-printing, under
565 the control of -fprint-explicit-kinds.
566 See also Type.filterOutInvisibleTypes.
567 For example, given
568 T :: forall k. (k->*) -> k -> * -- Ordinary kind polymorphism
569 'Just :: forall k. k -> 'Maybe k -- Promoted
570 we want
571 T * Tree Int prints as T Tree Int
572 'Just * prints as Just *
573
574
575 ************************************************************************
576 * *
577 Pretty-printing
578 * *
579 ************************************************************************
580 -}
581
582 if_print_coercions :: SDoc -- ^ if printing coercions
583 -> SDoc -- ^ otherwise
584 -> SDoc
585 if_print_coercions yes no
586 = sdocWithDynFlags $ \dflags ->
587 getPprStyle $ \style ->
588 if gopt Opt_PrintExplicitCoercions dflags
589 || dumpStyle style || debugStyle style
590 then yes
591 else no
592
593 pprIfaceInfixApp :: (TyPrec -> a -> SDoc) -> TyPrec -> SDoc -> a -> a -> SDoc
594 pprIfaceInfixApp pp p pp_tc ty1 ty2
595 = maybeParen p FunPrec $
596 sep [pp FunPrec ty1, pprInfixVar True pp_tc <+> pp FunPrec ty2]
597
598 pprIfacePrefixApp :: TyPrec -> SDoc -> [SDoc] -> SDoc
599 pprIfacePrefixApp p pp_fun pp_tys
600 | null pp_tys = pp_fun
601 | otherwise = maybeParen p TyConPrec $
602 hang pp_fun 2 (sep pp_tys)
603
604 -- ----------------------------- Printing binders ------------------------------------
605
606 instance Outputable IfaceBndr where
607 ppr (IfaceIdBndr bndr) = pprIfaceIdBndr bndr
608 ppr (IfaceTvBndr bndr) = char '@' <+> pprIfaceTvBndr False bndr
609
610 pprIfaceBndrs :: [IfaceBndr] -> SDoc
611 pprIfaceBndrs bs = sep (map ppr bs)
612
613 pprIfaceLamBndr :: IfaceLamBndr -> SDoc
614 pprIfaceLamBndr (b, IfaceNoOneShot) = ppr b
615 pprIfaceLamBndr (b, IfaceOneShot) = ppr b <> text "[OneShot]"
616
617 pprIfaceIdBndr :: IfaceIdBndr -> SDoc
618 pprIfaceIdBndr (name, ty) = parens (ppr name <+> dcolon <+> ppr ty)
619
620 pprIfaceTvBndr :: Bool -> IfaceTvBndr -> SDoc
621 pprIfaceTvBndr use_parens (tv, ki)
622 | isIfaceLiftedTypeKind ki = ppr tv
623 | otherwise = maybe_parens (ppr tv <+> dcolon <+> ppr ki)
624 where
625 maybe_parens | use_parens = parens
626 | otherwise = id
627
628 pprIfaceTyConBinders :: [IfaceTyConBinder] -> SDoc
629 pprIfaceTyConBinders = sep . map go
630 where
631 go tcb = pprIfaceTvBndr True (ifTyConBinderTyVar tcb)
632
633 instance Binary IfaceBndr where
634 put_ bh (IfaceIdBndr aa) = do
635 putByte bh 0
636 put_ bh aa
637 put_ bh (IfaceTvBndr ab) = do
638 putByte bh 1
639 put_ bh ab
640 get bh = do
641 h <- getByte bh
642 case h of
643 0 -> do aa <- get bh
644 return (IfaceIdBndr aa)
645 _ -> do ab <- get bh
646 return (IfaceTvBndr ab)
647
648 instance Binary IfaceOneShot where
649 put_ bh IfaceNoOneShot = do
650 putByte bh 0
651 put_ bh IfaceOneShot = do
652 putByte bh 1
653 get bh = do
654 h <- getByte bh
655 case h of
656 0 -> do return IfaceNoOneShot
657 _ -> do return IfaceOneShot
658
659 -- ----------------------------- Printing IfaceType ------------------------------------
660
661 ---------------------------------
662 instance Outputable IfaceType where
663 ppr ty = pprIfaceType ty
664
665 pprIfaceType, pprParendIfaceType :: IfaceType -> SDoc
666 pprIfaceType = eliminateRuntimeRep (ppr_ty TopPrec)
667 pprParendIfaceType = eliminateRuntimeRep (ppr_ty TyConPrec)
668
669 ppr_ty :: TyPrec -> IfaceType -> SDoc
670 ppr_ty _ (IfaceTcTyVar tyvar) = ppr tyvar -- This is the main reson for IfaceTcTyVar!
671 ppr_ty _ (IfaceTyVar tyvar) = ppr tyvar -- See Note [TcTyVars in IfaceType]
672 ppr_ty ctxt_prec (IfaceTyConApp tc tys) = pprTyTcApp ctxt_prec tc tys
673 ppr_ty _ (IfaceTupleTy i p tys) = pprTuple i p tys
674 ppr_ty _ (IfaceLitTy n) = pprIfaceTyLit n
675 -- Function types
676 ppr_ty ctxt_prec (IfaceFunTy ty1 ty2)
677 = -- We don't want to lose synonyms, so we mustn't use splitFunTys here.
678 maybeParen ctxt_prec FunPrec $
679 sep [ppr_ty FunPrec ty1, sep (ppr_fun_tail ty2)]
680 where
681 ppr_fun_tail (IfaceFunTy ty1 ty2)
682 = (arrow <+> ppr_ty FunPrec ty1) : ppr_fun_tail ty2
683 ppr_fun_tail other_ty
684 = [arrow <+> pprIfaceType other_ty]
685
686 ppr_ty ctxt_prec (IfaceAppTy ty1 ty2)
687 = if_print_coercions
688 ppr_app_ty
689 ppr_app_ty_no_casts
690 where
691 ppr_app_ty =
692 maybeParen ctxt_prec TyConPrec
693 $ ppr_ty FunPrec ty1 <+> ppr_ty TyConPrec ty2
694
695 -- Strip any casts from the head of the application
696 ppr_app_ty_no_casts =
697 case split_app_tys ty1 (ITC_Vis ty2 ITC_Nil) of
698 (IfaceCastTy head _, args) -> ppr_ty ctxt_prec (mk_app_tys head args)
699 _ -> ppr_app_ty
700
701 split_app_tys :: IfaceType -> IfaceTcArgs -> (IfaceType, IfaceTcArgs)
702 split_app_tys (IfaceAppTy t1 t2) args = split_app_tys t1 (t2 `ITC_Vis` args)
703 split_app_tys head args = (head, args)
704
705 mk_app_tys :: IfaceType -> IfaceTcArgs -> IfaceType
706 mk_app_tys (IfaceTyConApp tc tys1) tys2 =
707 IfaceTyConApp tc (tys1 `mappend` tys2)
708 mk_app_tys t1 tys2 =
709 foldl' IfaceAppTy t1 (tcArgsIfaceTypes tys2)
710
711 ppr_ty ctxt_prec (IfaceCastTy ty co)
712 = if_print_coercions
713 (parens (ppr_ty TopPrec ty <+> text "|>" <+> ppr co))
714 (ppr_ty ctxt_prec ty)
715
716 ppr_ty ctxt_prec (IfaceCoercionTy co)
717 = if_print_coercions
718 (ppr_co ctxt_prec co)
719 (text "<>")
720
721 ppr_ty ctxt_prec ty
722 = maybeParen ctxt_prec FunPrec (ppr_iface_sigma_type True ty)
723
724 {-
725 Note [Defaulting RuntimeRep variables]
726 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
727
728 RuntimeRep variables are considered by many (most?) users to be little more than
729 syntactic noise. When the notion was introduced there was a signficant and
730 understandable push-back from those with pedagogy in mind, which argued that
731 RuntimeRep variables would throw a wrench into nearly any teach approach since
732 they appear in even the lowly ($) function's type,
733
734 ($) :: forall (w :: RuntimeRep) a (b :: TYPE w). (a -> b) -> a -> b
735
736 which is significantly less readable than its non RuntimeRep-polymorphic type of
737
738 ($) :: (a -> b) -> a -> b
739
740 Moreover, unboxed types don't appear all that often in run-of-the-mill Haskell
741 programs, so it makes little sense to make all users pay this syntactic
742 overhead.
743
744 For this reason it was decided that we would hide RuntimeRep variables for now
745 (see #11549). We do this by defaulting all type variables of kind RuntimeRep to
746 PtrLiftedRep. This is done in a pass right before pretty-printing
747 (defaultRuntimeRepVars, controlled by -fprint-explicit-runtime-reps)
748 -}
749
750 -- | Default 'RuntimeRep' variables to 'LiftedPtr'. e.g.
751 --
752 -- @
753 -- ($) :: forall (r :: GHC.Types.RuntimeRep) a (b :: TYPE r).
754 -- (a -> b) -> a -> b
755 -- @
756 --
757 -- turns in to,
758 --
759 -- @ ($) :: forall a (b :: *). (a -> b) -> a -> b @
760 --
761 -- We do this to prevent RuntimeRep variables from incurring a significant
762 -- syntactic overhead in otherwise simple type signatures (e.g. ($)). See
763 -- Note [Defaulting RuntimeRep variables] and #11549 for further discussion.
764 --
765 defaultRuntimeRepVars :: IfaceType -> IfaceType
766 defaultRuntimeRepVars = go emptyFsEnv
767 where
768 go :: FastStringEnv () -> IfaceType -> IfaceType
769 go subs (IfaceForAllTy bndr ty)
770 | isRuntimeRep var_kind
771 = let subs' = extendFsEnv subs var ()
772 in go subs' ty
773 | otherwise
774 = IfaceForAllTy (TvBndr (var, go subs var_kind) (binderArgFlag bndr))
775 (go subs ty)
776 where
777 var :: IfLclName
778 (var, var_kind) = binderVar bndr
779
780 go subs (IfaceTyVar tv)
781 | tv `elemFsEnv` subs
782 = IfaceTyConApp ptrRepLifted ITC_Nil
783
784 go subs (IfaceFunTy kind ty)
785 = IfaceFunTy (go subs kind) (go subs ty)
786
787 go subs (IfaceAppTy x y)
788 = IfaceAppTy (go subs x) (go subs y)
789
790 go subs (IfaceDFunTy x y)
791 = IfaceDFunTy (go subs x) (go subs y)
792
793 go subs (IfaceCastTy x co)
794 = IfaceCastTy (go subs x) co
795
796 go _ other = other
797
798 ptrRepLifted :: IfaceTyCon
799 ptrRepLifted =
800 IfaceTyCon dc_name (IfaceTyConInfo IsPromoted IfaceNormalTyCon)
801 where dc_name = getName ptrRepLiftedDataConTyCon
802
803 isRuntimeRep :: IfaceType -> Bool
804 isRuntimeRep (IfaceTyConApp tc _) =
805 tc `ifaceTyConHasKey` runtimeRepTyConKey
806 isRuntimeRep _ = False
807
808 eliminateRuntimeRep :: (IfaceType -> SDoc) -> IfaceType -> SDoc
809 eliminateRuntimeRep f ty = sdocWithDynFlags $ \dflags ->
810 if gopt Opt_PrintExplicitRuntimeReps dflags
811 then f ty
812 else f (defaultRuntimeRepVars ty)
813
814 instance Outputable IfaceTcArgs where
815 ppr tca = pprIfaceTcArgs tca
816
817 pprIfaceTcArgs, pprParendIfaceTcArgs :: IfaceTcArgs -> SDoc
818 pprIfaceTcArgs = ppr_tc_args TopPrec
819 pprParendIfaceTcArgs = ppr_tc_args TyConPrec
820
821 ppr_tc_args :: TyPrec -> IfaceTcArgs -> SDoc
822 ppr_tc_args ctx_prec args
823 = let pprTys t ts = ppr_ty ctx_prec t <+> ppr_tc_args ctx_prec ts
824 in case args of
825 ITC_Nil -> empty
826 ITC_Vis t ts -> pprTys t ts
827 ITC_Invis t ts -> pprTys t ts
828
829 -------------------
830 ppr_iface_sigma_type :: Bool -> IfaceType -> SDoc
831 ppr_iface_sigma_type show_foralls_unconditionally ty
832 = ppr_iface_forall_part show_foralls_unconditionally tvs theta (ppr tau)
833 where
834 (tvs, theta, tau) = splitIfaceSigmaTy ty
835
836 -------------------
837 pprIfaceForAllPart :: [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc
838 pprIfaceForAllPart tvs ctxt sdoc = ppr_iface_forall_part False tvs ctxt sdoc
839
840 pprIfaceForAllCoPart :: [(IfLclName, IfaceCoercion)] -> SDoc -> SDoc
841 pprIfaceForAllCoPart tvs sdoc =
842 sep [ pprIfaceForAllCo tvs, sdoc ]
843
844 ppr_iface_forall_part :: Bool
845 -> [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc
846 ppr_iface_forall_part show_foralls_unconditionally tvs ctxt sdoc
847 = sep [ if show_foralls_unconditionally
848 then pprIfaceForAll tvs
849 else pprUserIfaceForAll tvs
850 , pprIfaceContextArr ctxt
851 , sdoc]
852
853 -- | Render the "forall ... ." or "forall ... ->" bit of a type.
854 pprIfaceForAll :: [IfaceForAllBndr] -> SDoc
855 pprIfaceForAll [] = empty
856 pprIfaceForAll bndrs@(TvBndr _ vis : _)
857 = add_separator (forAllLit <+> doc) <+> pprIfaceForAll bndrs'
858 where
859 (bndrs', doc) = ppr_itv_bndrs bndrs vis
860
861 add_separator stuff = case vis of
862 Required -> stuff <+> arrow
863 _inv -> stuff <> dot
864
865
866 -- | Render the ... in @(forall ... .)@ or @(forall ... ->)@.
867 -- Returns both the list of not-yet-rendered binders and the doc.
868 -- No anonymous binders here!
869 ppr_itv_bndrs :: [IfaceForAllBndr]
870 -> ArgFlag -- ^ visibility of the first binder in the list
871 -> ([IfaceForAllBndr], SDoc)
872 ppr_itv_bndrs all_bndrs@(bndr@(TvBndr _ vis) : bndrs) vis1
873 | vis `sameVis` vis1 = let (bndrs', doc) = ppr_itv_bndrs bndrs vis1 in
874 (bndrs', pprIfaceForAllBndr bndr <+> doc)
875 | otherwise = (all_bndrs, empty)
876 ppr_itv_bndrs [] _ = ([], empty)
877
878 pprIfaceForAllCo :: [(IfLclName, IfaceCoercion)] -> SDoc
879 pprIfaceForAllCo [] = empty
880 pprIfaceForAllCo tvs = text "forall" <+> pprIfaceForAllCoBndrs tvs <> dot
881
882 pprIfaceForAllCoBndrs :: [(IfLclName, IfaceCoercion)] -> SDoc
883 pprIfaceForAllCoBndrs bndrs = hsep $ map pprIfaceForAllCoBndr bndrs
884
885 pprIfaceForAllBndr :: IfaceForAllBndr -> SDoc
886 pprIfaceForAllBndr (TvBndr tv Inferred) = sdocWithDynFlags $ \dflags ->
887 if gopt Opt_PrintExplicitForalls dflags
888 then braces $ pprIfaceTvBndr False tv
889 else pprIfaceTvBndr True tv
890 pprIfaceForAllBndr (TvBndr tv _) = pprIfaceTvBndr True tv
891
892 pprIfaceForAllCoBndr :: (IfLclName, IfaceCoercion) -> SDoc
893 pprIfaceForAllCoBndr (tv, kind_co)
894 = parens (ppr tv <+> dcolon <+> pprIfaceCoercion kind_co)
895
896 pprIfaceSigmaType :: IfaceType -> SDoc
897 pprIfaceSigmaType ty = ppr_iface_sigma_type False ty
898
899 pprUserIfaceForAll :: [IfaceForAllBndr] -> SDoc
900 pprUserIfaceForAll tvs
901 = sdocWithDynFlags $ \dflags ->
902 ppWhen (any tv_has_kind_var tvs || gopt Opt_PrintExplicitForalls dflags) $
903 pprIfaceForAll tvs
904 where
905 tv_has_kind_var (TvBndr (_,kind) _) = not (ifTypeIsVarFree kind)
906
907
908 -------------------
909
910 -- See equivalent function in TyCoRep.hs
911 pprIfaceTyList :: TyPrec -> IfaceType -> IfaceType -> SDoc
912 -- Given a type-level list (t1 ': t2), see if we can print
913 -- it in list notation [t1, ...].
914 -- Precondition: Opt_PrintExplicitKinds is off
915 pprIfaceTyList ctxt_prec ty1 ty2
916 = case gather ty2 of
917 (arg_tys, Nothing)
918 -> char '\'' <> brackets (fsep (punctuate comma
919 (map (ppr_ty TopPrec) (ty1:arg_tys))))
920 (arg_tys, Just tl)
921 -> maybeParen ctxt_prec FunPrec $ hang (ppr_ty FunPrec ty1)
922 2 (fsep [ colon <+> ppr_ty FunPrec ty | ty <- arg_tys ++ [tl]])
923 where
924 gather :: IfaceType -> ([IfaceType], Maybe IfaceType)
925 -- (gather ty) = (tys, Nothing) means ty is a list [t1, .., tn]
926 -- = (tys, Just tl) means ty is of form t1:t2:...tn:tl
927 gather (IfaceTyConApp tc tys)
928 | tc `ifaceTyConHasKey` consDataConKey
929 , (ITC_Invis _ (ITC_Vis ty1 (ITC_Vis ty2 ITC_Nil))) <- tys
930 , (args, tl) <- gather ty2
931 = (ty1:args, tl)
932 | tc `ifaceTyConHasKey` nilDataConKey
933 = ([], Nothing)
934 gather ty = ([], Just ty)
935
936 pprIfaceTypeApp :: TyPrec -> IfaceTyCon -> IfaceTcArgs -> SDoc
937 pprIfaceTypeApp prec tc args = pprTyTcApp prec tc args
938
939 pprTyTcApp :: TyPrec -> IfaceTyCon -> IfaceTcArgs -> SDoc
940 pprTyTcApp ctxt_prec tc tys =
941 sdocWithDynFlags $ \dflags ->
942 getPprStyle $ \style ->
943 pprTyTcApp' ctxt_prec tc tys dflags style
944
945 pprTyTcApp' :: TyPrec -> IfaceTyCon -> IfaceTcArgs
946 -> DynFlags -> PprStyle -> SDoc
947 pprTyTcApp' ctxt_prec tc tys dflags style
948 | ifaceTyConName tc `hasKey` ipClassKey
949 , ITC_Vis (IfaceLitTy (IfaceStrTyLit n)) (ITC_Vis ty ITC_Nil) <- tys
950 = maybeParen ctxt_prec FunPrec
951 $ char '?' <> ftext n <> text "::" <> ppr_ty TopPrec ty
952
953 | IfaceTupleTyCon arity sort <- ifaceTyConSort info
954 , not (debugStyle style)
955 , arity == ifaceVisTcArgsLength tys
956 = pprTuple sort (ifaceTyConIsPromoted info) tys
957
958 | IfaceSumTyCon arity <- ifaceTyConSort info
959 = pprSum arity (ifaceTyConIsPromoted info) tys
960
961 | tc `ifaceTyConHasKey` consDataConKey
962 , not (gopt Opt_PrintExplicitKinds dflags)
963 , ITC_Invis _ (ITC_Vis ty1 (ITC_Vis ty2 ITC_Nil)) <- tys
964 = pprIfaceTyList ctxt_prec ty1 ty2
965
966 | tc `ifaceTyConHasKey` tYPETyConKey
967 , ITC_Vis (IfaceTyConApp rep ITC_Nil) ITC_Nil <- tys
968 , rep `ifaceTyConHasKey` ptrRepLiftedDataConKey
969 = kindStar
970
971 | tc `ifaceTyConHasKey` tYPETyConKey
972 , ITC_Vis (IfaceTyConApp rep ITC_Nil) ITC_Nil <- tys
973 , rep `ifaceTyConHasKey` ptrRepUnliftedDataConKey
974 = char '#'
975
976 | not opt_PprStyle_Debug
977 , tc `ifaceTyConHasKey` errorMessageTypeErrorFamKey
978 = text "(TypeError ...)" -- Suppress detail unles you _really_ want to see
979
980 | Just doc <- ppr_equality tc (tcArgsIfaceTypes tys)
981 = doc
982
983 | otherwise
984 = ppr_iface_tc_app ppr_ty ctxt_prec tc tys_wo_kinds
985 where
986 info = ifaceTyConInfo tc
987 tys_wo_kinds = tcArgsIfaceTypes $ stripInvisArgs dflags tys
988
989 -- | Pretty-print a type-level equality.
990 --
991 -- See Note [Equality predicates in IfaceType].
992 ppr_equality :: IfaceTyCon -> [IfaceType] -> Maybe SDoc
993 ppr_equality tc args
994 | hetero_eq_tc
995 , [k1, k2, t1, t2] <- args
996 = Just $ print_equality (k1, k2, t1, t2)
997
998 | hom_eq_tc
999 , [k, t1, t2] <- args
1000 = Just $ print_equality (k, k, t1, t2)
1001
1002 | otherwise
1003 = Nothing
1004 where
1005 homogeneous = case ifaceTyConSort $ ifaceTyConInfo tc of
1006 IfaceEqualityTyCon hom -> hom
1007 _other -> pprPanic "ppr_equality: homogeneity" (ppr tc)
1008 tc_name = ifaceTyConName tc
1009 pp = ppr_ty
1010 hom_eq_tc = tc_name `hasKey` eqTyConKey -- (~)
1011 hetero_eq_tc = tc_name `hasKey` eqPrimTyConKey -- (~#)
1012 || tc_name `hasKey` eqReprPrimTyConKey -- (~R#)
1013 || tc_name `hasKey` heqTyConKey -- (~~)
1014
1015 print_equality args =
1016 sdocWithDynFlags
1017 $ \dflags -> getPprStyle
1018 $ \style -> print_equality' args style dflags
1019
1020 print_equality' (ki1, ki2, ty1, ty2) style dflags
1021 | print_eqs
1022 = ppr_infix_eq (ppr tc)
1023
1024 | hetero_eq_tc
1025 , print_kinds || not homogeneous
1026 = ppr_infix_eq (text "~~")
1027
1028 | otherwise
1029 = if tc_name `hasKey` eqReprPrimTyConKey
1030 then text "Coercible"
1031 <+> sep [ pp TyConPrec ty1, pp TyConPrec ty2 ]
1032 else sep [pp TyOpPrec ty1, char '~', pp TyOpPrec ty2]
1033 where
1034 ppr_infix_eq eq_op
1035 = sep [ parens (pp TyOpPrec ty1 <+> dcolon <+> pp TyOpPrec ki1)
1036 , eq_op
1037 , parens (pp TyOpPrec ty2 <+> dcolon <+> pp TyOpPrec ki2) ]
1038
1039 print_kinds = gopt Opt_PrintExplicitKinds dflags
1040 print_eqs = gopt Opt_PrintEqualityRelations dflags ||
1041 dumpStyle style || debugStyle style
1042
1043
1044 pprIfaceCoTcApp :: TyPrec -> IfaceTyCon -> [IfaceCoercion] -> SDoc
1045 pprIfaceCoTcApp ctxt_prec tc tys = ppr_iface_tc_app ppr_co ctxt_prec tc tys
1046
1047 ppr_iface_tc_app :: (TyPrec -> a -> SDoc) -> TyPrec -> IfaceTyCon -> [a] -> SDoc
1048 ppr_iface_tc_app pp _ tc [ty]
1049 | tc `ifaceTyConHasKey` listTyConKey = pprPromotionQuote tc <> brackets (pp TopPrec ty)
1050 | tc `ifaceTyConHasKey` parrTyConKey = pprPromotionQuote tc <> paBrackets (pp TopPrec ty)
1051
1052 ppr_iface_tc_app pp ctxt_prec tc tys
1053 | tc `ifaceTyConHasKey` starKindTyConKey
1054 || tc `ifaceTyConHasKey` liftedTypeKindTyConKey
1055 || tc `ifaceTyConHasKey` unicodeStarKindTyConKey
1056 = kindStar -- Handle unicode; do not wrap * in parens
1057
1058 | tc `ifaceTyConHasKey` unliftedTypeKindTyConKey
1059 = ppr tc -- Do not wrap # in parens
1060
1061 | not (isSymOcc (nameOccName (ifaceTyConName tc)))
1062 = pprIfacePrefixApp ctxt_prec (ppr tc) (map (pp TyConPrec) tys)
1063
1064 | [ty1,ty2] <- tys -- Infix, two arguments;
1065 -- we know nothing of precedence though
1066 = pprIfaceInfixApp pp ctxt_prec (ppr tc) ty1 ty2
1067
1068 | otherwise
1069 = pprIfacePrefixApp ctxt_prec (parens (ppr tc)) (map (pp TyConPrec) tys)
1070
1071 pprSum :: Arity -> IsPromoted -> IfaceTcArgs -> SDoc
1072 pprSum _arity is_promoted args
1073 = -- drop the RuntimeRep vars.
1074 -- See Note [Unboxed tuple RuntimeRep vars] in TyCon
1075 let tys = tcArgsIfaceTypes args
1076 args' = drop (length tys `div` 2) tys
1077 in pprPromotionQuoteI is_promoted
1078 <> sumParens (pprWithBars (ppr_ty TopPrec) args')
1079
1080 pprTuple :: TupleSort -> IsPromoted -> IfaceTcArgs -> SDoc
1081 pprTuple ConstraintTuple IsNotPromoted ITC_Nil
1082 = text "() :: Constraint"
1083
1084 -- All promoted constructors have kind arguments
1085 pprTuple sort IsPromoted args
1086 = let tys = tcArgsIfaceTypes args
1087 args' = drop (length tys `div` 2) tys
1088 in pprPromotionQuoteI IsPromoted <>
1089 tupleParens sort (pprWithCommas pprIfaceType args')
1090
1091 pprTuple sort promoted args
1092 = -- drop the RuntimeRep vars.
1093 -- See Note [Unboxed tuple RuntimeRep vars] in TyCon
1094 let tys = tcArgsIfaceTypes args
1095 args' = case sort of
1096 UnboxedTuple -> drop (length tys `div` 2) tys
1097 _ -> tys
1098 in
1099 pprPromotionQuoteI promoted <>
1100 tupleParens sort (pprWithCommas pprIfaceType args')
1101
1102 pprIfaceTyLit :: IfaceTyLit -> SDoc
1103 pprIfaceTyLit (IfaceNumTyLit n) = integer n
1104 pprIfaceTyLit (IfaceStrTyLit n) = text (show n)
1105
1106 pprIfaceCoercion, pprParendIfaceCoercion :: IfaceCoercion -> SDoc
1107 pprIfaceCoercion = ppr_co TopPrec
1108 pprParendIfaceCoercion = ppr_co TyConPrec
1109
1110 ppr_co :: TyPrec -> IfaceCoercion -> SDoc
1111 ppr_co _ (IfaceReflCo r ty) = angleBrackets (ppr ty) <> ppr_role r
1112 ppr_co ctxt_prec (IfaceFunCo r co1 co2)
1113 = maybeParen ctxt_prec FunPrec $
1114 sep (ppr_co FunPrec co1 : ppr_fun_tail co2)
1115 where
1116 ppr_fun_tail (IfaceFunCo r co1 co2)
1117 = (arrow <> ppr_role r <+> ppr_co FunPrec co1) : ppr_fun_tail co2
1118 ppr_fun_tail other_co
1119 = [arrow <> ppr_role r <+> pprIfaceCoercion other_co]
1120
1121 ppr_co _ (IfaceTyConAppCo r tc cos)
1122 = parens (pprIfaceCoTcApp TopPrec tc cos) <> ppr_role r
1123 ppr_co ctxt_prec (IfaceAppCo co1 co2)
1124 = maybeParen ctxt_prec TyConPrec $
1125 ppr_co FunPrec co1 <+> pprParendIfaceCoercion co2
1126 ppr_co ctxt_prec co@(IfaceForAllCo {})
1127 = maybeParen ctxt_prec FunPrec (pprIfaceForAllCoPart tvs (pprIfaceCoercion inner_co))
1128 where
1129 (tvs, inner_co) = split_co co
1130
1131 split_co (IfaceForAllCo (name, _) kind_co co')
1132 = let (tvs, co'') = split_co co' in ((name,kind_co):tvs,co'')
1133 split_co co' = ([], co')
1134
1135 ppr_co _ (IfaceCoVarCo covar) = ppr covar
1136
1137 ppr_co ctxt_prec (IfaceUnivCo IfaceUnsafeCoerceProv r ty1 ty2)
1138 = maybeParen ctxt_prec TyConPrec $
1139 text "UnsafeCo" <+> ppr r <+>
1140 pprParendIfaceType ty1 <+> pprParendIfaceType ty2
1141
1142 ppr_co ctxt_prec (IfaceUnivCo (IfaceHoleProv u) _ _ _)
1143 = maybeParen ctxt_prec TyConPrec $
1144 sdocWithDynFlags $ \dflags ->
1145 if gopt Opt_PrintExplicitCoercions dflags
1146 then braces $ ppr u
1147 else braces $ text "a hole"
1148
1149 ppr_co _ (IfaceUnivCo _ _ ty1 ty2)
1150 = angleBrackets ( ppr ty1 <> comma <+> ppr ty2 )
1151
1152 ppr_co ctxt_prec (IfaceInstCo co ty)
1153 = maybeParen ctxt_prec TyConPrec $
1154 text "Inst" <+> pprParendIfaceCoercion co
1155 <+> pprParendIfaceCoercion ty
1156
1157 ppr_co ctxt_prec (IfaceAxiomRuleCo tc cos)
1158 = maybeParen ctxt_prec TyConPrec $ ppr tc <+> parens (interpp'SP cos)
1159
1160 ppr_co ctxt_prec (IfaceAxiomInstCo n i cos)
1161 = ppr_special_co ctxt_prec (ppr n <> brackets (ppr i)) cos
1162 ppr_co ctxt_prec (IfaceSymCo co)
1163 = ppr_special_co ctxt_prec (text "Sym") [co]
1164 ppr_co ctxt_prec (IfaceTransCo co1 co2)
1165 = ppr_special_co ctxt_prec (text "Trans") [co1,co2]
1166 ppr_co ctxt_prec (IfaceNthCo d co)
1167 = ppr_special_co ctxt_prec (text "Nth:" <> int d) [co]
1168 ppr_co ctxt_prec (IfaceLRCo lr co)
1169 = ppr_special_co ctxt_prec (ppr lr) [co]
1170 ppr_co ctxt_prec (IfaceSubCo co)
1171 = ppr_special_co ctxt_prec (text "Sub") [co]
1172 ppr_co ctxt_prec (IfaceCoherenceCo co1 co2)
1173 = ppr_special_co ctxt_prec (text "Coh") [co1,co2]
1174 ppr_co ctxt_prec (IfaceKindCo co)
1175 = ppr_special_co ctxt_prec (text "Kind") [co]
1176
1177 ppr_special_co :: TyPrec -> SDoc -> [IfaceCoercion] -> SDoc
1178 ppr_special_co ctxt_prec doc cos
1179 = maybeParen ctxt_prec TyConPrec
1180 (sep [doc, nest 4 (sep (map pprParendIfaceCoercion cos))])
1181
1182 ppr_role :: Role -> SDoc
1183 ppr_role r = underscore <> pp_role
1184 where pp_role = case r of
1185 Nominal -> char 'N'
1186 Representational -> char 'R'
1187 Phantom -> char 'P'
1188
1189 -------------------
1190 instance Outputable IfaceTyCon where
1191 ppr tc = pprPromotionQuote tc <> ppr (ifaceTyConName tc)
1192
1193 pprPromotionQuote :: IfaceTyCon -> SDoc
1194 pprPromotionQuote tc =
1195 pprPromotionQuoteI $ ifaceTyConIsPromoted $ ifaceTyConInfo tc
1196
1197 pprPromotionQuoteI :: IsPromoted -> SDoc
1198 pprPromotionQuoteI IsNotPromoted = empty
1199 pprPromotionQuoteI IsPromoted = char '\''
1200
1201 instance Outputable IfaceCoercion where
1202 ppr = pprIfaceCoercion
1203
1204 instance Binary IfaceTyCon where
1205 put_ bh (IfaceTyCon n i) = put_ bh n >> put_ bh i
1206
1207 get bh = do n <- get bh
1208 i <- get bh
1209 return (IfaceTyCon n i)
1210
1211 instance Binary IsPromoted where
1212 put_ bh IsNotPromoted = putByte bh 0
1213 put_ bh IsPromoted = putByte bh 1
1214
1215 get bh = do
1216 n <- getByte bh
1217 case n of
1218 0 -> return IsNotPromoted
1219 1 -> return IsPromoted
1220 _ -> fail "Binary(IsPromoted): fail)"
1221
1222 instance Binary IfaceTyConSort where
1223 put_ bh IfaceNormalTyCon = putByte bh 0
1224 put_ bh (IfaceTupleTyCon arity sort) = putByte bh 1 >> put_ bh arity >> put_ bh sort
1225 put_ bh (IfaceSumTyCon arity) = putByte bh 2 >> put_ bh arity
1226 put_ bh (IfaceEqualityTyCon hom)
1227 | hom = putByte bh 3
1228 | otherwise = putByte bh 4
1229
1230 get bh = do
1231 n <- getByte bh
1232 case n of
1233 0 -> return IfaceNormalTyCon
1234 1 -> IfaceTupleTyCon <$> get bh <*> get bh
1235 2 -> IfaceSumTyCon <$> get bh
1236 3 -> return $ IfaceEqualityTyCon True
1237 4 -> return $ IfaceEqualityTyCon False
1238 _ -> fail "Binary(IfaceTyConSort): fail"
1239
1240 instance Binary IfaceTyConInfo where
1241 put_ bh (IfaceTyConInfo i s) = put_ bh i >> put_ bh s
1242
1243 get bh = IfaceTyConInfo <$> get bh <*> get bh
1244
1245 instance Outputable IfaceTyLit where
1246 ppr = pprIfaceTyLit
1247
1248 instance Binary IfaceTyLit where
1249 put_ bh (IfaceNumTyLit n) = putByte bh 1 >> put_ bh n
1250 put_ bh (IfaceStrTyLit n) = putByte bh 2 >> put_ bh n
1251
1252 get bh =
1253 do tag <- getByte bh
1254 case tag of
1255 1 -> do { n <- get bh
1256 ; return (IfaceNumTyLit n) }
1257 2 -> do { n <- get bh
1258 ; return (IfaceStrTyLit n) }
1259 _ -> panic ("get IfaceTyLit " ++ show tag)
1260
1261 instance Binary IfaceTcArgs where
1262 put_ bh tk =
1263 case tk of
1264 ITC_Vis t ts -> putByte bh 0 >> put_ bh t >> put_ bh ts
1265 ITC_Invis t ts -> putByte bh 1 >> put_ bh t >> put_ bh ts
1266 ITC_Nil -> putByte bh 2
1267
1268 get bh =
1269 do c <- getByte bh
1270 case c of
1271 0 -> do
1272 t <- get bh
1273 ts <- get bh
1274 return $! ITC_Vis t ts
1275 1 -> do
1276 t <- get bh
1277 ts <- get bh
1278 return $! ITC_Invis t ts
1279 2 -> return ITC_Nil
1280 _ -> panic ("get IfaceTcArgs " ++ show c)
1281
1282 -------------------
1283
1284 -- Some notes about printing contexts
1285 --
1286 -- In the event that we are printing a singleton context (e.g. @Eq a@) we can
1287 -- omit parentheses. However, we must take care to set the precedence correctly
1288 -- to TyOpPrec, since something like @a :~: b@ must be parenthesized (see
1289 -- #9658).
1290 --
1291 -- When printing a larger context we use 'fsep' instead of 'sep' so that
1292 -- the context doesn't get displayed as a giant column. Rather than,
1293 -- instance (Eq a,
1294 -- Eq b,
1295 -- Eq c,
1296 -- Eq d,
1297 -- Eq e,
1298 -- Eq f,
1299 -- Eq g,
1300 -- Eq h,
1301 -- Eq i,
1302 -- Eq j,
1303 -- Eq k,
1304 -- Eq l) =>
1305 -- Eq (a, b, c, d, e, f, g, h, i, j, k, l)
1306 --
1307 -- we want
1308 --
1309 -- instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h, Eq i,
1310 -- Eq j, Eq k, Eq l) =>
1311 -- Eq (a, b, c, d, e, f, g, h, i, j, k, l)
1312
1313
1314
1315 -- | Prints "(C a, D b) =>", including the arrow. This is used when we want to
1316 -- print a context in a type.
1317 pprIfaceContextArr :: [IfacePredType] -> SDoc
1318 pprIfaceContextArr [] = empty
1319 pprIfaceContextArr [pred] = ppr_ty TyOpPrec pred <+> darrow
1320 pprIfaceContextArr preds =
1321 parens (fsep (punctuate comma (map ppr preds))) <+> darrow
1322
1323 -- | Prints a context or @()@ if empty. This is used when, e.g., we want to
1324 -- display a context in an error message.
1325 pprIfaceContext :: [IfacePredType] -> SDoc
1326 pprIfaceContext [] = parens empty
1327 pprIfaceContext [pred] = ppr_ty TyOpPrec pred
1328 pprIfaceContext preds = parens (fsep (punctuate comma (map ppr preds)))
1329
1330 instance Binary IfaceType where
1331 put_ _ (IfaceTcTyVar tv)
1332 = pprPanic "Can't serialise IfaceTcTyVar" (ppr tv)
1333
1334 put_ bh (IfaceForAllTy aa ab) = do
1335 putByte bh 0
1336 put_ bh aa
1337 put_ bh ab
1338 put_ bh (IfaceTyVar ad) = do
1339 putByte bh 1
1340 put_ bh ad
1341 put_ bh (IfaceAppTy ae af) = do
1342 putByte bh 2
1343 put_ bh ae
1344 put_ bh af
1345 put_ bh (IfaceFunTy ag ah) = do
1346 putByte bh 3
1347 put_ bh ag
1348 put_ bh ah
1349 put_ bh (IfaceDFunTy ag ah) = do
1350 putByte bh 4
1351 put_ bh ag
1352 put_ bh ah
1353 put_ bh (IfaceTyConApp tc tys)
1354 = do { putByte bh 5; put_ bh tc; put_ bh tys }
1355 put_ bh (IfaceCastTy a b)
1356 = do { putByte bh 6; put_ bh a; put_ bh b }
1357 put_ bh (IfaceCoercionTy a)
1358 = do { putByte bh 7; put_ bh a }
1359 put_ bh (IfaceTupleTy s i tys)
1360 = do { putByte bh 8; put_ bh s; put_ bh i; put_ bh tys }
1361 put_ bh (IfaceLitTy n)
1362 = do { putByte bh 9; put_ bh n }
1363
1364 get bh = do
1365 h <- getByte bh
1366 case h of
1367 0 -> do aa <- get bh
1368 ab <- get bh
1369 return (IfaceForAllTy aa ab)
1370 1 -> do ad <- get bh
1371 return (IfaceTyVar ad)
1372 2 -> do ae <- get bh
1373 af <- get bh
1374 return (IfaceAppTy ae af)
1375 3 -> do ag <- get bh
1376 ah <- get bh
1377 return (IfaceFunTy ag ah)
1378 4 -> do ag <- get bh
1379 ah <- get bh
1380 return (IfaceDFunTy ag ah)
1381 5 -> do { tc <- get bh; tys <- get bh
1382 ; return (IfaceTyConApp tc tys) }
1383 6 -> do { a <- get bh; b <- get bh
1384 ; return (IfaceCastTy a b) }
1385 7 -> do { a <- get bh
1386 ; return (IfaceCoercionTy a) }
1387
1388 8 -> do { s <- get bh; i <- get bh; tys <- get bh
1389 ; return (IfaceTupleTy s i tys) }
1390 _ -> do n <- get bh
1391 return (IfaceLitTy n)
1392
1393 instance Binary IfaceCoercion where
1394 put_ bh (IfaceReflCo a b) = do
1395 putByte bh 1
1396 put_ bh a
1397 put_ bh b
1398 put_ bh (IfaceFunCo a b c) = do
1399 putByte bh 2
1400 put_ bh a
1401 put_ bh b
1402 put_ bh c
1403 put_ bh (IfaceTyConAppCo a b c) = do
1404 putByte bh 3
1405 put_ bh a
1406 put_ bh b
1407 put_ bh c
1408 put_ bh (IfaceAppCo a b) = do
1409 putByte bh 4
1410 put_ bh a
1411 put_ bh b
1412 put_ bh (IfaceForAllCo a b c) = do
1413 putByte bh 5
1414 put_ bh a
1415 put_ bh b
1416 put_ bh c
1417 put_ bh (IfaceCoVarCo a) = do
1418 putByte bh 6
1419 put_ bh a
1420 put_ bh (IfaceAxiomInstCo a b c) = do
1421 putByte bh 7
1422 put_ bh a
1423 put_ bh b
1424 put_ bh c
1425 put_ bh (IfaceUnivCo a b c d) = do
1426 putByte bh 8
1427 put_ bh a
1428 put_ bh b
1429 put_ bh c
1430 put_ bh d
1431 put_ bh (IfaceSymCo a) = do
1432 putByte bh 9
1433 put_ bh a
1434 put_ bh (IfaceTransCo a b) = do
1435 putByte bh 10
1436 put_ bh a
1437 put_ bh b
1438 put_ bh (IfaceNthCo a b) = do
1439 putByte bh 11
1440 put_ bh a
1441 put_ bh b
1442 put_ bh (IfaceLRCo a b) = do
1443 putByte bh 12
1444 put_ bh a
1445 put_ bh b
1446 put_ bh (IfaceInstCo a b) = do
1447 putByte bh 13
1448 put_ bh a
1449 put_ bh b
1450 put_ bh (IfaceCoherenceCo a b) = do
1451 putByte bh 14
1452 put_ bh a
1453 put_ bh b
1454 put_ bh (IfaceKindCo a) = do
1455 putByte bh 15
1456 put_ bh a
1457 put_ bh (IfaceSubCo a) = do
1458 putByte bh 16
1459 put_ bh a
1460 put_ bh (IfaceAxiomRuleCo a b) = do
1461 putByte bh 17
1462 put_ bh a
1463 put_ bh b
1464
1465 get bh = do
1466 tag <- getByte bh
1467 case tag of
1468 1 -> do a <- get bh
1469 b <- get bh
1470 return $ IfaceReflCo a b
1471 2 -> do a <- get bh
1472 b <- get bh
1473 c <- get bh
1474 return $ IfaceFunCo a b c
1475 3 -> do a <- get bh
1476 b <- get bh
1477 c <- get bh
1478 return $ IfaceTyConAppCo a b c
1479 4 -> do a <- get bh
1480 b <- get bh
1481 return $ IfaceAppCo a b
1482 5 -> do a <- get bh
1483 b <- get bh
1484 c <- get bh
1485 return $ IfaceForAllCo a b c
1486 6 -> do a <- get bh
1487 return $ IfaceCoVarCo a
1488 7 -> do a <- get bh
1489 b <- get bh
1490 c <- get bh
1491 return $ IfaceAxiomInstCo a b c
1492 8 -> do a <- get bh
1493 b <- get bh
1494 c <- get bh
1495 d <- get bh
1496 return $ IfaceUnivCo a b c d
1497 9 -> do a <- get bh
1498 return $ IfaceSymCo a
1499 10-> do a <- get bh
1500 b <- get bh
1501 return $ IfaceTransCo a b
1502 11-> do a <- get bh
1503 b <- get bh
1504 return $ IfaceNthCo a b
1505 12-> do a <- get bh
1506 b <- get bh
1507 return $ IfaceLRCo a b
1508 13-> do a <- get bh
1509 b <- get bh
1510 return $ IfaceInstCo a b
1511 14-> do a <- get bh
1512 b <- get bh
1513 return $ IfaceCoherenceCo a b
1514 15-> do a <- get bh
1515 return $ IfaceKindCo a
1516 16-> do a <- get bh
1517 return $ IfaceSubCo a
1518 17-> do a <- get bh
1519 b <- get bh
1520 return $ IfaceAxiomRuleCo a b
1521 _ -> panic ("get IfaceCoercion " ++ show tag)
1522
1523 instance Binary IfaceUnivCoProv where
1524 put_ bh IfaceUnsafeCoerceProv = putByte bh 1
1525 put_ bh (IfacePhantomProv a) = do
1526 putByte bh 2
1527 put_ bh a
1528 put_ bh (IfaceProofIrrelProv a) = do
1529 putByte bh 3
1530 put_ bh a
1531 put_ bh (IfacePluginProv a) = do
1532 putByte bh 4
1533 put_ bh a
1534 put_ _ (IfaceHoleProv _) =
1535 pprPanic "Binary(IfaceUnivCoProv) hit a hole" empty
1536 -- See Note [Holes in IfaceUnivCoProv]
1537
1538 get bh = do
1539 tag <- getByte bh
1540 case tag of
1541 1 -> return $ IfaceUnsafeCoerceProv
1542 2 -> do a <- get bh
1543 return $ IfacePhantomProv a
1544 3 -> do a <- get bh
1545 return $ IfaceProofIrrelProv a
1546 4 -> do a <- get bh
1547 return $ IfacePluginProv a
1548 _ -> panic ("get IfaceUnivCoProv " ++ show tag)
1549
1550
1551 instance Binary (DefMethSpec IfaceType) where
1552 put_ bh VanillaDM = putByte bh 0
1553 put_ bh (GenericDM t) = putByte bh 1 >> put_ bh t
1554 get bh = do
1555 h <- getByte bh
1556 case h of
1557 0 -> return VanillaDM
1558 _ -> do { t <- get bh; return (GenericDM t) }