never executed always true always false
1 -----------------------------------------------------------------------------
2 --
3 -- Pretty-printing TyThings
4 --
5 -- (c) The GHC Team 2005
6 --
7 -----------------------------------------------------------------------------
8
9
10 module GHC.Types.TyThing.Ppr (
11 pprTyThing,
12 pprTyThingInContext,
13 pprTyThingLoc,
14 pprTyThingInContextLoc,
15 pprTyThingHdr,
16 pprFamInst
17 ) where
18
19 import GHC.Prelude
20
21 import GHC.Types.TyThing ( TyThing(..), tyThingParent_maybe )
22 import GHC.Types.Name
23
24 import GHC.Core.Type ( ArgFlag(..), mkTyVarBinders )
25 import GHC.Core.Coercion.Axiom ( coAxiomTyCon )
26 import GHC.Core.FamInstEnv( FamInst(..), FamFlavor(..) )
27 import GHC.Core.TyCo.Ppr ( pprUserForAll, pprTypeApp )
28
29 import GHC.Iface.Syntax ( ShowSub(..), ShowHowMuch(..), AltPpr(..)
30 , showToHeader, pprIfaceDecl )
31 import GHC.Iface.Make ( tyThingToIfaceDecl )
32
33 import GHC.Utils.Outputable
34 import GHC.Utils.Trace
35
36 -- -----------------------------------------------------------------------------
37 -- Pretty-printing entities that we get from the GHC API
38
39 {- Note [Pretty printing via Iface syntax]
40 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
41 Our general plan for pretty-printing
42 - Types
43 - TyCons
44 - Classes
45 - Pattern synonyms
46 ...etc...
47
48 is to convert them to Iface syntax, and pretty-print that. For example
49 - pprType converts a Type to an IfaceType, and pretty prints that.
50 - pprTyThing converts the TyThing to an IfaceDecl,
51 and pretty prints that.
52
53 So Iface syntax plays a dual role:
54 - it's the internal version of an interface files
55 - it's used for pretty-printing
56
57 Why do this?
58
59 * A significant reason is that we need to be able
60 to pretty-print Iface syntax (to display Foo.hi), and it was a
61 pain to duplicate masses of pretty-printing goop, esp for
62 Type and IfaceType.
63
64 * When pretty-printing (a type, say), we want to tidy (with
65 tidyType) to avoids having (forall a a. blah) where the two
66 a's have different uniques.
67
68 Alas, for type constructors, TyCon, tidying does not work well,
69 because a TyCon includes DataCons which include Types, which mention
70 TyCons. And tidying can't tidy a mutually recursive data structure
71 graph, only trees.
72
73 * Interface files contains fast-strings, not uniques, so the very same
74 tidying must take place when we convert to IfaceDecl. E.g.
75 GHC.Iface.Make.tyThingToIfaceDecl which converts a TyThing (i.e. TyCon,
76 Class etc) to an IfaceDecl.
77
78 Bottom line: IfaceDecls are already 'tidy', so it's straightforward
79 to print them.
80
81 * An alternative I once explored was to ensure that TyCons get type
82 variables with distinct print-names. That's ok for type variables
83 but less easy for kind variables. Processing data type declarations
84 is already so complicated that I don't think it's sensible to add
85 the extra requirement that it generates only "pretty" types and
86 kinds.
87
88 Consequences:
89
90 - Iface syntax (and IfaceType) must contain enough information to
91 print nicely. Hence, for example, the IfaceAppArgs type, which
92 allows us to suppress invisible kind arguments in types
93 (see Note [Suppressing invisible arguments] in GHC.Iface.Type)
94
95 - In a few places we have info that is used only for pretty-printing,
96 and is totally ignored when turning Iface syntax back into Core
97 (in GHC.IfaceToCore). For example, IfaceClosedSynFamilyTyCon
98 stores a [IfaceAxBranch] that is used only for pretty-printing.
99
100 - See Note [Free tyvars in IfaceType] in GHC.Iface.Type
101
102 See #7730, #8776 for details -}
103
104 --------------------
105 -- | Pretty-prints a 'FamInst' (type/data family instance) with its defining location.
106 pprFamInst :: FamInst -> SDoc
107 -- * For data instances we go via pprTyThing of the representational TyCon,
108 -- because there is already much cleverness associated with printing
109 -- data type declarations that I don't want to duplicate
110 -- * For type instances we print directly here; there is no TyCon
111 -- to give to pprTyThing
112 --
113 -- FamInstEnv.pprFamInst does a more quick-and-dirty job for internal purposes
114
115 pprFamInst (FamInst { fi_flavor = DataFamilyInst rep_tc })
116 = pprTyThingInContextLoc (ATyCon rep_tc)
117
118 pprFamInst (FamInst { fi_flavor = SynFamilyInst, fi_axiom = axiom
119 , fi_tvs = tvs, fi_tys = lhs_tys, fi_rhs = rhs })
120 = showWithLoc (pprDefinedAt (getName axiom)) $
121 hang (text "type instance"
122 <+> pprUserForAll (mkTyVarBinders Specified tvs)
123 -- See Note [Printing foralls in type family instances]
124 -- in GHC.Iface.Type
125 <+> pprTypeApp (coAxiomTyCon axiom) lhs_tys)
126 2 (equals <+> ppr rhs)
127
128 ----------------------------
129 -- | Pretty-prints a 'TyThing' with its defining location.
130 pprTyThingLoc :: TyThing -> SDoc
131 pprTyThingLoc tyThing
132 = showWithLoc (pprDefinedAt (getName tyThing))
133 (pprTyThing showToHeader tyThing)
134
135 -- | Pretty-prints the 'TyThing' header. For functions and data constructors
136 -- the function is equivalent to 'pprTyThing' but for type constructors
137 -- and classes it prints only the header part of the declaration.
138 pprTyThingHdr :: TyThing -> SDoc
139 pprTyThingHdr = pprTyThing showToHeader
140
141 -- | Pretty-prints a 'TyThing' in context: that is, if the entity
142 -- is a data constructor, record selector, or class method, then
143 -- the entity's parent declaration is pretty-printed with irrelevant
144 -- parts omitted.
145 pprTyThingInContext :: ShowSub -> TyThing -> SDoc
146 pprTyThingInContext show_sub thing
147 = go [] thing
148 where
149 go ss thing
150 = case tyThingParent_maybe thing of
151 Just parent ->
152 go (getOccName thing : ss) parent
153 Nothing ->
154 pprTyThing
155 (show_sub { ss_how_much = ShowSome ss (AltPpr Nothing) })
156 thing
157
158 -- | Like 'pprTyThingInContext', but adds the defining location.
159 pprTyThingInContextLoc :: TyThing -> SDoc
160 pprTyThingInContextLoc tyThing
161 = showWithLoc (pprDefinedAt (getName tyThing))
162 (pprTyThingInContext showToHeader tyThing)
163
164 -- | Pretty-prints a 'TyThing'.
165 pprTyThing :: ShowSub -> TyThing -> SDoc
166 -- We pretty-print 'TyThing' via 'IfaceDecl'
167 -- See Note [Pretty printing via Iface syntax]
168 pprTyThing ss ty_thing
169 = sdocOption sdocLinearTypes $ \show_linear_types ->
170 pprIfaceDecl ss' (tyThingToIfaceDecl show_linear_types ty_thing)
171 where
172 ss' = case ss_how_much ss of
173 ShowHeader (AltPpr Nothing) -> ss { ss_how_much = ShowHeader ppr' }
174 ShowSome xs (AltPpr Nothing) -> ss { ss_how_much = ShowSome xs ppr' }
175 _ -> ss
176
177 ppr' = AltPpr $ ppr_bndr $ getName ty_thing
178
179 ppr_bndr :: Name -> Maybe (OccName -> SDoc)
180 ppr_bndr name
181 | isBuiltInSyntax name
182 = Nothing
183 | otherwise
184 = case nameModule_maybe name of
185 Just mod -> Just $ \occ -> getPprStyle $ \sty ->
186 pprModulePrefix sty mod occ <> ppr occ
187 Nothing -> warnPprTrace True (ppr name) Nothing
188 -- Nothing is unexpected here; TyThings have External names
189
190 showWithLoc :: SDoc -> SDoc -> SDoc
191 showWithLoc loc doc
192 = hang doc 2 (char '\t' <> comment <+> loc)
193 -- The tab tries to make them line up a bit
194 where
195 comment = text "--"