Decls.hs 46.3 KB
Newer Older
1

Hécate Moonlight's avatar
Hécate Moonlight committed
2
3
4
5
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
6
{-# LANGUAGE ScopedTypeVariables #-}
Hécate Moonlight's avatar
Hécate Moonlight committed
7
8
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
9
{-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow]
10
11
                                      -- in module Language.Haskell.Syntax.Extension

Hécate Moonlight's avatar
Hécate Moonlight committed
12
{-# OPTIONS_GHC -Wno-orphans #-} -- Outputable
13

Austin Seipp's avatar
Austin Seipp committed
14
15
16
17
{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-}
18

19

20
21
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}

22
23
-- | Abstract syntax of global declarations.
--
24
-- Definitions for: @SynDecl@ and @ConDecl@, @ClassDecl@,
25
-- @InstDecl@, @DefaultDecl@ and @ForeignDecl@.
Sylvain Henry's avatar
Sylvain Henry committed
26
module GHC.Hs.Decls (
27
  -- * Toplevel declarations
28
  HsDecl(..), LHsDecl, HsDataDefn(..), HsDeriving, LHsFunDep,
29
30
  HsDerivingClause(..), LHsDerivingClause, DerivClauseTys(..), LDerivClauseTys,
  NewOrData(..), newOrDataToFlavour,
31
  StandaloneKindSig(..), LStandaloneKindSig, standaloneKindSigName,
32

33
  -- ** Class or type declarations
34
  TyClDecl(..), LTyClDecl, DataDeclRn(..),
35
  TyClGroup(..),
36
  tyClGroupTyClDecls, tyClGroupInstDecls, tyClGroupRoleDecls,
37
  tyClGroupKindSigs,
38
39
  isClassDecl, isDataDecl, isSynDecl, tcdName,
  isFamilyDecl, isTypeFamilyDecl, isDataFamilyDecl,
40
  isOpenTypeFamilyInfo, isClosedTypeFamilyInfo,
41
42
43
  tyFamInstDeclName, tyFamInstDeclLName,
  countTyClDecls, pprTyClDeclFlavour,
  tyClDeclLName, tyClDeclTyVars,
44
  hsDeclHasCusk, famResultKindSignature,
45
  FamilyDecl(..), LFamilyDecl,
Alan Zimmerman's avatar
Alan Zimmerman committed
46
  FunDep(..),
47

48
  -- ** Instance declarations
49
  InstDecl(..), LInstDecl, FamilyInfo(..),
50
  TyFamInstDecl(..), LTyFamInstDecl, instDeclDataFamInsts,
51
  TyFamDefltDecl, LTyFamDefltDecl,
52
  DataFamInstDecl(..), LDataFamInstDecl,
53
  pprDataFamInstFlavour, pprTyFamInstDecl, pprHsFamInstLHS,
54
  FamEqn(..), TyFamInstEqn, LTyFamInstEqn, HsTyPats,
55
  LClsInstDecl, ClsInstDecl(..),
56

57
58
  -- ** Standalone deriving declarations
  DerivDecl(..), LDerivDecl,
Ryan Scott's avatar
Ryan Scott committed
59
  -- ** Deriving strategies
60
61
  DerivStrategy(..), LDerivStrategy,
  derivStrategyName, foldDerivStrategy, mapDerivStrategy,
Alan Zimmerman's avatar
Alan Zimmerman committed
62
  XViaStrategyPs(..),
63
  -- ** @RULE@ declarations
64
  LRuleDecls,RuleDecls(..),RuleDecl(..),LRuleDecl,HsRuleRn(..),
Alan Zimmerman's avatar
Alan Zimmerman committed
65
  HsRuleAnn(..),
66
  RuleBndr(..),LRuleBndr,
67
  collectRuleBndrSigTys,
68
  flattenRuleDecls, pprFullRuleName,
69
70
  -- ** @default@ declarations
  DefaultDecl(..), LDefaultDecl,
71
  -- ** Template haskell declaration splice
72
  SpliceExplicitFlag(..),
73
  SpliceDecl(..), LSpliceDecl,
74
75
  -- ** Foreign function interface declarations
  ForeignDecl(..), LForeignDecl, ForeignImport(..), ForeignExport(..),
76
  CImportSpec(..),
77
  -- ** Data-constructor declarations
Ryan Scott's avatar
Ryan Scott committed
78
  ConDecl(..), LConDecl,
Ryan Scott's avatar
Ryan Scott committed
79
80
  HsConDeclH98Details, HsConDeclGADTDetails(..), hsConDeclTheta,
  getConNames, getRecConArgs_maybe,
81
82
83
84
  -- ** Document comments
  DocDecl(..), LDocDecl, docDeclDoc,
  -- ** Deprecations
  WarnDecl(..),  LWarnDecl,
Alan Zimmerman's avatar
Alan Zimmerman committed
85
  WarnDecls(..), LWarnDecls,
86
  -- ** Annotations
87
  AnnDecl(..), LAnnDecl,
88
  AnnProvenance(..), annProvenanceName_maybe,
89
90
  -- ** Role annotations
  RoleAnnotDecl(..), LRoleAnnotDecl, roleAnnotDeclName,
Jan Stolarek's avatar
Jan Stolarek committed
91
92
  -- ** Injective type families
  FamilyResultSig(..), LFamilyResultSig, InjectivityAnn(..), LInjectivityAnn,
93
  resultVariableName, familyDeclLName, familyDeclName,
94
95

  -- * Grouping
96
97
  HsGroup(..),  emptyRdrGroup, emptyRnGroup, appendGroups, hsGroupInstDecls,
  hsGroupTopLevelFixitySigs,
98

99
  partitionBindsAndSigs,
100
    ) where
101
102

-- friends:
103
import GHC.Prelude
104

105
106
107
import Language.Haskell.Syntax.Decls

import {-# SOURCE #-} GHC.Hs.Expr ( pprExpr, pprSpliceDecl )
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
108
        -- Because Expr imports Decls via HsBracket
109

Sylvain Henry's avatar
Sylvain Henry committed
110
import GHC.Hs.Binds
111
import GHC.Hs.Type
Sylvain Henry's avatar
Sylvain Henry committed
112
import GHC.Hs.Doc
Sylvain Henry's avatar
Sylvain Henry committed
113
import GHC.Types.Basic
Sylvain Henry's avatar
Sylvain Henry committed
114
import GHC.Core.Coercion
115
import Language.Haskell.Syntax.Extension
Sylvain Henry's avatar
Sylvain Henry committed
116
import GHC.Hs.Extension
Alan Zimmerman's avatar
Alan Zimmerman committed
117
import GHC.Parser.Annotation
Gert-Jan Bottu's avatar
Gert-Jan Bottu committed
118
import GHC.Types.Name
Sylvain Henry's avatar
Sylvain Henry committed
119
import GHC.Types.Name.Set
Sylvain Henry's avatar
Sylvain Henry committed
120
import GHC.Types.Fixity
121
122

-- others:
123
import GHC.Utils.Outputable
124
import GHC.Utils.Panic
Sylvain Henry's avatar
Sylvain Henry committed
125
import GHC.Types.SrcLoc
Sylvain Henry's avatar
Sylvain Henry committed
126
import GHC.Types.SourceText
Sylvain Henry's avatar
Sylvain Henry committed
127
import GHC.Core.Type
Alan Zimmerman's avatar
Alan Zimmerman committed
128
import GHC.Types.ForeignCall
129

130
131
import GHC.Data.Bag
import GHC.Data.Maybe
Alan Zimmerman's avatar
Alan Zimmerman committed
132
import Data.Data (Data)
133

Austin Seipp's avatar
Austin Seipp committed
134
135
136
{-
************************************************************************
*                                                                      *
137
\subsection[HsDecl]{Declarations}
Austin Seipp's avatar
Austin Seipp committed
138
139
140
*                                                                      *
************************************************************************
-}
141

142
143
144
145
146
type instance XTyClD      (GhcPass _) = NoExtField
type instance XInstD      (GhcPass _) = NoExtField
type instance XDerivD     (GhcPass _) = NoExtField
type instance XValD       (GhcPass _) = NoExtField
type instance XSigD       (GhcPass _) = NoExtField
147
type instance XKindSigD   (GhcPass _) = NoExtField
148
149
150
151
152
153
154
155
156
type instance XDefD       (GhcPass _) = NoExtField
type instance XForD       (GhcPass _) = NoExtField
type instance XWarningD   (GhcPass _) = NoExtField
type instance XAnnD       (GhcPass _) = NoExtField
type instance XRuleD      (GhcPass _) = NoExtField
type instance XSpliceD    (GhcPass _) = NoExtField
type instance XDocD       (GhcPass _) = NoExtField
type instance XRoleAnnotD (GhcPass _) = NoExtField
type instance XXHsDecl    (GhcPass _) = NoExtCon
157

158
159
160
161
162
163
164
165
166
167
168
-- | Partition a list of HsDecls into function/pattern bindings, signatures,
-- type family declarations, type family instances, and documentation comments.
--
-- Panics when given a declaration that cannot be put into any of the output
-- groups.
--
-- The primary use of this function is to implement
-- 'GHC.Parser.PostProcess.cvBindsAndSigs'.
partitionBindsAndSigs
  :: [LHsDecl GhcPs]
  -> (LHsBinds GhcPs, [LSig GhcPs], [LFamilyDecl GhcPs],
Alan Zimmerman's avatar
Alan Zimmerman committed
169
      [LTyFamInstDecl GhcPs], [LDataFamInstDecl GhcPs], [LDocDecl GhcPs])
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
partitionBindsAndSigs = go
  where
    go [] = (emptyBag, [], [], [], [], [])
    go ((L l decl) : ds) =
      let (bs, ss, ts, tfis, dfis, docs) = go ds in
      case decl of
        ValD _ b
          -> (L l b `consBag` bs, ss, ts, tfis, dfis, docs)
        SigD _ s
          -> (bs, L l s : ss, ts, tfis, dfis, docs)
        TyClD _ (FamDecl _ t)
          -> (bs, ss, L l t : ts, tfis, dfis, docs)
        InstD _ (TyFamInstD { tfid_inst = tfi })
          -> (bs, ss, ts, L l tfi : tfis, dfis, docs)
        InstD _ (DataFamInstD { dfid_inst = dfi })
          -> (bs, ss, ts, tfis, L l dfi : dfis, docs)
        DocD _ d
          -> (bs, ss, ts, tfis, dfis, L l d : docs)
        _ -> pprPanic "partitionBindsAndSigs" (ppr decl)

190
191
type instance XCHsGroup (GhcPass _) = NoExtField
type instance XXHsGroup (GhcPass _) = NoExtCon
192

193
194

emptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup (GhcPass p)
195
196
197
emptyRdrGroup = emptyGroup { hs_valds = emptyValBindsIn }
emptyRnGroup  = emptyGroup { hs_valds = emptyValBindsOut }

198
emptyGroup = HsGroup { hs_ext = noExtField,
199
                       hs_tyclds = [],
200
                       hs_derivds = [],
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
201
                       hs_fixds = [], hs_defds = [], hs_annds = [],
202
                       hs_fords = [], hs_warnds = [], hs_ruleds = [],
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
203
                       hs_valds = error "emptyGroup hs_valds: Can't happen",
204
                       hs_splcds = [],
205
                       hs_docs = [] }
206

207
208
209
210
211
212
213
214
215
216
217
218
-- | The fixity signatures for each top-level declaration and class method
-- in an 'HsGroup'.
-- See Note [Top-level fixity signatures in an HsGroup]
hsGroupTopLevelFixitySigs :: HsGroup (GhcPass p) -> [LFixitySig (GhcPass p)]
hsGroupTopLevelFixitySigs (HsGroup{ hs_fixds = fixds, hs_tyclds = tyclds }) =
    fixds ++ cls_fixds
  where
    cls_fixds = [ L loc sig
                | L _ ClassDecl{tcdSigs = sigs} <- tyClGroupTyClDecls tyclds
                , L loc (FixSig _ sig) <- sigs
                ]

219
220
appendGroups :: HsGroup (GhcPass p) -> HsGroup (GhcPass p)
             -> HsGroup (GhcPass p)
221
222
appendGroups
    HsGroup {
223
        hs_valds  = val_groups1,
224
        hs_splcds = spliceds1,
225
        hs_tyclds = tyclds1,
226
        hs_derivds = derivds1,
227
        hs_fixds  = fixds1,
228
229
        hs_defds  = defds1,
        hs_annds  = annds1,
230
        hs_fords  = fords1,
231
232
        hs_warnds = warnds1,
        hs_ruleds = rulds1,
233
        hs_docs   = docs1 }
234
    HsGroup {
235
        hs_valds  = val_groups2,
236
        hs_splcds = spliceds2,
237
        hs_tyclds = tyclds2,
238
        hs_derivds = derivds2,
239
        hs_fixds  = fixds2,
240
241
        hs_defds  = defds2,
        hs_annds  = annds2,
242
        hs_fords  = fords2,
243
244
245
        hs_warnds = warnds2,
        hs_ruleds = rulds2,
        hs_docs   = docs2 }
246
247
  =
    HsGroup {
248
        hs_ext    = noExtField,
249
        hs_valds  = val_groups1 `plusHsValBinds` val_groups2,
250
251
        hs_splcds = spliceds1 ++ spliceds2,
        hs_tyclds = tyclds1 ++ tyclds2,
252
        hs_derivds = derivds1 ++ derivds2,
253
254
255
        hs_fixds  = fixds1 ++ fixds2,
        hs_annds  = annds1 ++ annds2,
        hs_defds  = defds1 ++ defds2,
256
        hs_fords  = fords1 ++ fords2,
257
258
259
        hs_warnds = warnds1 ++ warnds2,
        hs_ruleds = rulds1 ++ rulds2,
        hs_docs   = docs1  ++ docs2 }
260

261
instance (OutputableBndrId p) => Outputable (HsDecl (GhcPass p)) where
262
263
264
265
266
267
268
    ppr (TyClD _ dcl)             = ppr dcl
    ppr (ValD _ binds)            = ppr binds
    ppr (DefD _ def)              = ppr def
    ppr (InstD _ inst)            = ppr inst
    ppr (DerivD _ deriv)          = ppr deriv
    ppr (ForD _ fd)               = ppr fd
    ppr (SigD _ sd)               = ppr sd
269
    ppr (KindSigD _ ksd)          = ppr ksd
270
271
272
273
274
275
    ppr (RuleD _ rd)              = ppr rd
    ppr (WarningD _ wd)           = ppr wd
    ppr (AnnD _ ad)               = ppr ad
    ppr (SpliceD _ dd)            = ppr dd
    ppr (DocD _ doc)              = ppr doc
    ppr (RoleAnnotD _ ra)         = ppr ra
276

277
instance (OutputableBndrId p) => Outputable (HsGroup (GhcPass p)) where
278
    ppr (HsGroup { hs_valds  = val_decls,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
279
                   hs_tyclds = tycl_decls,
280
                   hs_derivds = deriv_decls,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
281
282
283
284
285
                   hs_fixds  = fix_decls,
                   hs_warnds = deprec_decls,
                   hs_annds  = ann_decls,
                   hs_fords  = foreign_decls,
                   hs_defds  = default_decls,
286
                   hs_ruleds = rule_decls })
287
288
        = vcat_mb empty
            [ppr_ds fix_decls, ppr_ds default_decls,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
289
290
             ppr_ds deprec_decls, ppr_ds ann_decls,
             ppr_ds rule_decls,
291
292
             if isEmptyValBinds val_decls
                then Nothing
293
                else Just (ppr val_decls),
294
             ppr_ds (tyClGroupRoleDecls tycl_decls),
295
             ppr_ds (tyClGroupKindSigs  tycl_decls),
296
297
             ppr_ds (tyClGroupTyClDecls tycl_decls),
             ppr_ds (tyClGroupInstDecls tycl_decls),
298
             ppr_ds deriv_decls,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
299
300
             ppr_ds foreign_decls]
        where
301
          ppr_ds :: Outputable a => [a] -> Maybe SDoc
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
302
303
          ppr_ds [] = Nothing
          ppr_ds ds = Just (vcat (map ppr ds))
304
305

          vcat_mb :: SDoc -> [Maybe SDoc] -> SDoc
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
306
          -- Concatenate vertically with white-space between non-blanks
307
308
309
          vcat_mb _    []             = empty
          vcat_mb gap (Nothing : ds) = vcat_mb gap ds
          vcat_mb gap (Just d  : ds) = gap $$ d $$ vcat_mb blankLine ds
310

311
312
type instance XSpliceDecl      (GhcPass _) = NoExtField
type instance XXSpliceDecl     (GhcPass _) = NoExtCon
313

314
315
instance OutputableBndrId p
       => Outputable (SpliceDecl (GhcPass p)) where
316
   ppr (SpliceDecl _ (L _ e) f) = pprSpliceDecl e f
317

Austin Seipp's avatar
Austin Seipp committed
318
319
320
{-
************************************************************************
*                                                                      *
321
            Type and class declarations
Austin Seipp's avatar
Austin Seipp committed
322
323
*                                                                      *
************************************************************************
324
325
-}

326
type instance XFamDecl      (GhcPass _) = NoExtField
327

Alan Zimmerman's avatar
Alan Zimmerman committed
328
type instance XSynDecl      GhcPs = EpAnn [AddEpAnn]
329
330
331
type instance XSynDecl      GhcRn = NameSet -- FVs
type instance XSynDecl      GhcTc = NameSet -- FVs

332
type instance XDataDecl     GhcPs = EpAnn [AddEpAnn]
333
334
335
type instance XDataDecl     GhcRn = DataDeclRn
type instance XDataDecl     GhcTc = DataDeclRn

Alan Zimmerman's avatar
Alan Zimmerman committed
336
type instance XClassDecl    GhcPs = (EpAnn [AddEpAnn], AnnSortKey, LayoutInfo)  -- See Note [Class LayoutInfo]
Alan Zimmerman's avatar
Alan Zimmerman committed
337
  -- TODO:AZ:tidy up AnnSortKey above
338
339
340
type instance XClassDecl    GhcRn = NameSet -- FVs
type instance XClassDecl    GhcTc = NameSet -- FVs

341
type instance XXTyClDecl    (GhcPass _) = NoExtCon
342

Alan Zimmerman's avatar
Alan Zimmerman committed
343
type instance XCTyFamInstDecl (GhcPass _) = EpAnn [AddEpAnn]
Alan Zimmerman's avatar
Alan Zimmerman committed
344
345
type instance XXTyFamInstDecl (GhcPass _) = NoExtCon

Austin Seipp's avatar
Austin Seipp committed
346
-- Dealing with names
347

Alan Zimmerman's avatar
Alan Zimmerman committed
348
349
tyFamInstDeclName :: Anno (IdGhcP p) ~ SrcSpanAnnN
                  => TyFamInstDecl (GhcPass p) -> IdP (GhcPass p)
350
351
tyFamInstDeclName = unLoc . tyFamInstDeclLName

Alan Zimmerman's avatar
Alan Zimmerman committed
352
353
tyFamInstDeclLName :: Anno (IdGhcP p) ~ SrcSpanAnnN
                   => TyFamInstDecl (GhcPass p) -> LocatedN (IdP (GhcPass p))
354
tyFamInstDeclLName (TyFamInstDecl { tfid_eqn = FamEqn { feqn_tycon = ln }})
355
356
  = ln

Alan Zimmerman's avatar
Alan Zimmerman committed
357
358
tyClDeclLName :: Anno (IdGhcP p) ~ SrcSpanAnnN
              => TyClDecl (GhcPass p) -> LocatedN (IdP (GhcPass p))
359
360
361
362
tyClDeclLName (FamDecl { tcdFam = fd })     = familyDeclLName fd
tyClDeclLName (SynDecl { tcdLName = ln })   = ln
tyClDeclLName (DataDecl { tcdLName = ln })  = ln
tyClDeclLName (ClassDecl { tcdLName = ln }) = ln
363

Zubin's avatar
Zubin committed
364
365
-- FIXME: tcdName is commonly used by both GHC and third-party tools, so it
-- needs to be polymorphic in the pass
Alan Zimmerman's avatar
Alan Zimmerman committed
366
367
tcdName :: Anno (IdGhcP p) ~ SrcSpanAnnN
        => TyClDecl (GhcPass p) -> IdP (GhcPass p)
368
369
tcdName = unLoc . tyClDeclLName

370
-- | Does this declaration have a complete, user-supplied kind signature?
371
-- See Note [CUSKs: complete user-supplied kind signatures]
372
373
374
375
376
377
378
379
380
381
382
383
384
hsDeclHasCusk :: TyClDecl GhcRn -> Bool
hsDeclHasCusk (FamDecl { tcdFam =
    FamilyDecl { fdInfo      = fam_info
               , fdTyVars    = tyvars
               , fdResultSig = L _ resultSig } }) =
    case fam_info of
      ClosedTypeFamily {} -> hsTvbAllKinded tyvars
                          && isJust (famResultKindSignature resultSig)
      _ -> True -- Un-associated open type/data families have CUSKs
hsDeclHasCusk (SynDecl { tcdTyVars = tyvars, tcdRhs = rhs })
  = hsTvbAllKinded tyvars && isJust (hsTyKindSig rhs)
hsDeclHasCusk (DataDecl { tcdDExt = DataDeclRn { tcdDataCusk = cusk }}) = cusk
hsDeclHasCusk (ClassDecl { tcdTyVars = tyvars }) = hsTvbAllKinded tyvars
385

Jan Stolarek's avatar
Jan Stolarek committed
386
387
-- Pretty-printing TyClDecl
-- ~~~~~~~~~~~~~~~~~~~~~~~~
388

389
instance (OutputableBndrId p) => Outputable (TyClDecl (GhcPass p)) where
390

391
    ppr (FamDecl { tcdFam = decl }) = ppr decl
392
393
    ppr (SynDecl { tcdLName = ltycon, tcdTyVars = tyvars, tcdFixity = fixity
                 , tcdRhs = rhs })
394
      = hang (text "type" <+>
395
              pp_vanilla_decl_head ltycon tyvars fixity Nothing <+> equals)
396
          4 (ppr rhs)
397

398
399
400
    ppr (DataDecl { tcdLName = ltycon, tcdTyVars = tyvars, tcdFixity = fixity
                  , tcdDataDefn = defn })
      = pp_data_defn (pp_vanilla_decl_head ltycon tyvars fixity) defn
401

402
    ppr (ClassDecl {tcdCtxt = context, tcdLName = lclas, tcdTyVars = tyvars,
403
                    tcdFixity = fixity,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
404
                    tcdFDs  = fds,
405
406
407
                    tcdSigs = sigs, tcdMeths = methods,
                    tcdATs = ats, tcdATDefs = at_defs})
      | null sigs && isEmptyBag methods && null ats && null at_defs -- No "where" part
408
409
      = top_matter

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
410
      | otherwise       -- Laid out
411
      = vcat [ top_matter <+> text "where"
Alan Zimmerman's avatar
Alan Zimmerman committed
412
             , nest 2 $ pprDeclList (map (ppr . unLoc) ats ++
413
                                     map (pprTyFamDefltDecl . unLoc) at_defs ++
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
414
                                     pprLHsBindsForUser methods sigs) ]
415
      where
416
        top_matter = text "class"
417
                    <+> pp_vanilla_decl_head lclas tyvars fixity context
418
                    <+> pprFundeps (map unLoc fds)
419

420
421
instance OutputableBndrId p
       => Outputable (TyClGroup (GhcPass p)) where
422
423
  ppr (TyClGroup { group_tyclds = tyclds
                 , group_roles = roles
424
                 , group_kisigs = kisigs
425
426
427
                 , group_instds = instds
                 }
      )
428
429
430
    = hang (text "TyClGroup") 2 $
      ppr kisigs $$
      ppr tyclds $$
431
432
      ppr roles $$
      ppr instds
433

434
pp_vanilla_decl_head :: (OutputableBndrId p)
Alan Zimmerman's avatar
Alan Zimmerman committed
435
   => XRec (GhcPass p) (IdP (GhcPass p))
436
   -> LHsQTyVars (GhcPass p)
437
   -> LexicalFixity
438
   -> Maybe (LHsContext (GhcPass p))
Jan Stolarek's avatar
Jan Stolarek committed
439
   -> SDoc
440
pp_vanilla_decl_head thing (HsQTvs { hsq_explicit = tyvars }) fixity context
441
 = hsep [pprLHsContext context, pp_tyvars tyvars]
Alan Zimmerman's avatar
Alan Zimmerman committed
442
443
  where
    pp_tyvars (varl:varsr)
444
445
446
447
      | fixity == Infix && length varsr > 1
         = hsep [char '(',ppr (unLoc varl), pprInfixOcc (unLoc thing)
                , (ppr.unLoc) (head varsr), char ')'
                , hsep (map (ppr.unLoc) (tail varsr))]
448
      | fixity == Infix
Alan Zimmerman's avatar
Alan Zimmerman committed
449
450
451
452
         = hsep [ppr (unLoc varl), pprInfixOcc (unLoc thing)
         , hsep (map (ppr.unLoc) varsr)]
      | otherwise = hsep [ pprPrefixOcc (unLoc thing)
                  , hsep (map (ppr.unLoc) (varl:varsr))]
453
    pp_tyvars [] = pprPrefixOcc (unLoc thing)
Jan Stolarek's avatar
Jan Stolarek committed
454

455
pprTyClDeclFlavour :: TyClDecl (GhcPass p) -> SDoc
456
457
pprTyClDeclFlavour (ClassDecl {})   = text "class"
pprTyClDeclFlavour (SynDecl {})     = text "type"
Jan Stolarek's avatar
Jan Stolarek committed
458
pprTyClDeclFlavour (FamDecl { tcdFam = FamilyDecl { fdInfo = info }})
459
  = pprFlavour info <+> text "family"
Jan Stolarek's avatar
Jan Stolarek committed
460
461
462
pprTyClDeclFlavour (DataDecl { tcdDataDefn = HsDataDefn { dd_ND = nd } })
  = ppr nd

Alan Zimmerman's avatar
Alan Zimmerman committed
463
464
465
instance OutputableBndrId p => Outputable (FunDep (GhcPass p)) where
  ppr = pprFunDep

Alan Zimmerman's avatar
Alan Zimmerman committed
466
type instance XCFunDep    (GhcPass _) = EpAnn [AddEpAnn]
Alan Zimmerman's avatar
Alan Zimmerman committed
467
468
469
470
471
472
473
474
475
type instance XXFunDep    (GhcPass _) = NoExtCon

pprFundeps :: OutputableBndrId p => [FunDep (GhcPass p)] -> SDoc
pprFundeps []  = empty
pprFundeps fds = hsep (vbar : punctuate comma (map pprFunDep fds))

pprFunDep :: OutputableBndrId p => FunDep (GhcPass p) -> SDoc
pprFunDep (FunDep _ us vs) = hsep [interppSP us, arrow, interppSP vs]

476
477
478
479
480
481
482
483
{- *********************************************************************
*                                                                      *
                         TyClGroup
        Strongly connected components of
      type, class, instance, and role declarations
*                                                                      *
********************************************************************* -}

484
485
type instance XCTyClGroup (GhcPass _) = NoExtField
type instance XXTyClGroup (GhcPass _) = NoExtCon
486
487


Jan Stolarek's avatar
Jan Stolarek committed
488
489
490
491
492
493
{- *********************************************************************
*                                                                      *
               Data and type family declarations
*                                                                      *
********************************************************************* -}

494
495
type instance XNoSig            (GhcPass _) = NoExtField
type instance XCKindSig         (GhcPass _) = NoExtField
496

497
498
type instance XTyVarSig         (GhcPass _) = NoExtField
type instance XXFamilyResultSig (GhcPass _) = NoExtCon
499

Alan Zimmerman's avatar
Alan Zimmerman committed
500
type instance XCFamilyDecl    (GhcPass _) = EpAnn [AddEpAnn]
501
type instance XXFamilyDecl    (GhcPass _) = NoExtCon
502
503


504
505
------------- Functions over FamilyDecls -----------

Alan Zimmerman's avatar
Alan Zimmerman committed
506
familyDeclLName :: FamilyDecl (GhcPass p) -> XRec (GhcPass p) (IdP (GhcPass p))
507
508
509
510
511
familyDeclLName (FamilyDecl { fdLName = n }) = n

familyDeclName :: FamilyDecl (GhcPass p) -> IdP (GhcPass p)
familyDeclName = unLoc . familyDeclLName

512
513
514
515
516
famResultKindSignature :: FamilyResultSig (GhcPass p) -> Maybe (LHsKind (GhcPass p))
famResultKindSignature (NoSig _) = Nothing
famResultKindSignature (KindSig _ ki) = Just ki
famResultKindSignature (TyVarSig _ bndr) =
  case unLoc bndr of
Gert-Jan Bottu's avatar
Gert-Jan Bottu committed
517
518
    UserTyVar _ _ _ -> Nothing
    KindedTyVar _ _ _ ki -> Just ki
Jan Stolarek's avatar
Jan Stolarek committed
519
520

-- | Maybe return name of the result type variable
521
resultVariableName :: FamilyResultSig (GhcPass a) -> Maybe (IdP (GhcPass a))
522
523
resultVariableName (TyVarSig _ sig) = Just $ hsLTyVarName sig
resultVariableName _                = Nothing
Jan Stolarek's avatar
Jan Stolarek committed
524

525
526
------------- Pretty printing FamilyDecls -----------

Alan Zimmerman's avatar
Alan Zimmerman committed
527
type instance XCInjectivityAnn  (GhcPass _) = EpAnn [AddEpAnn]
Alan Zimmerman's avatar
Alan Zimmerman committed
528
529
type instance XXInjectivityAnn  (GhcPass _) = NoExtCon

530
531
instance OutputableBndrId p
       => Outputable (FamilyDecl (GhcPass p)) where
Alan Zimmerman's avatar
Alan Zimmerman committed
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
  ppr (FamilyDecl { fdInfo = info, fdLName = ltycon
                  , fdTopLevel = top_level
                  , fdTyVars = tyvars
                  , fdFixity = fixity
                  , fdResultSig = L _ result
                  , fdInjectivityAnn = mb_inj })
    = vcat [ pprFlavour info <+> pp_top_level <+>
             pp_vanilla_decl_head ltycon tyvars fixity Nothing <+>
             pp_kind <+> pp_inj <+> pp_where
           , nest 2 $ pp_eqns ]
    where
      pp_top_level = case top_level of
                       TopLevel    -> text "family"
                       NotTopLevel -> empty

      pp_kind = case result of
                  NoSig    _         -> empty
                  KindSig  _ kind    -> dcolon <+> ppr kind
                  TyVarSig _ tv_bndr -> text "=" <+> ppr tv_bndr
      pp_inj = case mb_inj of
                 Just (L _ (InjectivityAnn _ lhs rhs)) ->
                   hsep [ vbar, ppr lhs, text "->", hsep (map ppr rhs) ]
                 Nothing -> empty
      (pp_where, pp_eqns) = case info of
        ClosedTypeFamily mb_eqns ->
          ( text "where"
          , case mb_eqns of
              Nothing   -> text ".."
              Just eqns -> vcat $ map (ppr_fam_inst_eqn . unLoc) eqns )
        _ -> (empty, empty)
562

563

564

Jan Stolarek's avatar
Jan Stolarek committed
565
{- *********************************************************************
Austin Seipp's avatar
Austin Seipp committed
566
*                                                                      *
Jan Stolarek's avatar
Jan Stolarek committed
567
               Data types and data constructors
Austin Seipp's avatar
Austin Seipp committed
568
*                                                                      *
Jan Stolarek's avatar
Jan Stolarek committed
569
********************************************************************* -}
570

571
type instance XCHsDataDefn    (GhcPass _) = NoExtField
572
type instance XXHsDataDefn    (GhcPass _) = NoExtCon
573

Alan Zimmerman's avatar
Alan Zimmerman committed
574
type instance XCHsDerivingClause    (GhcPass _) = EpAnn [AddEpAnn]
575
type instance XXHsDerivingClause    (GhcPass _) = NoExtCon
Ryan Scott's avatar
Ryan Scott committed
576

577
578
instance OutputableBndrId p
       => Outputable (HsDerivingClause (GhcPass p)) where
Ryan Scott's avatar
Ryan Scott committed
579
580
581
  ppr (HsDerivingClause { deriv_clause_strategy = dcs
                        , deriv_clause_tys      = L _ dct })
    = hsep [ text "deriving"
Ryan Scott's avatar
Ryan Scott committed
582
           , pp_strat_before
583
           , ppr dct
Ryan Scott's avatar
Ryan Scott committed
584
           , pp_strat_after ]
Alan Zimmerman's avatar
Alan Zimmerman committed
585
      where
Ryan Scott's avatar
Ryan Scott committed
586
587
588
589
590
591
        -- @via@ is unique in that in comes /after/ the class being derived,
        -- so we must special-case it.
        (pp_strat_before, pp_strat_after) =
          case dcs of
            Just (L _ via@ViaStrategy{}) -> (empty, ppr via)
            _                            -> (ppDerivStrategy dcs, empty)
592

593
594
595
596
597
598
599
600
type instance XDctSingle (GhcPass _) = NoExtField
type instance XDctMulti  (GhcPass _) = NoExtField
type instance XXDerivClauseTys (GhcPass _) = NoExtCon

instance OutputableBndrId p => Outputable (DerivClauseTys (GhcPass p)) where
  ppr (DctSingle _ ty) = ppr ty
  ppr (DctMulti _ tys) = parens (interpp'SP tys)

Alan Zimmerman's avatar
Alan Zimmerman committed
601
type instance XStandaloneKindSig GhcPs = EpAnn [AddEpAnn]
Alan Zimmerman's avatar
Alan Zimmerman committed
602
603
604
type instance XStandaloneKindSig GhcRn = NoExtField
type instance XStandaloneKindSig GhcTc = NoExtField

605
606
607
608
609
type instance XXStandaloneKindSig (GhcPass p) = NoExtCon

standaloneKindSigName :: StandaloneKindSig (GhcPass p) -> IdP (GhcPass p)
standaloneKindSigName (StandaloneKindSig _ lname _) = unLoc lname

Alan Zimmerman's avatar
Alan Zimmerman committed
610
611
type instance XConDeclGADT (GhcPass _) = EpAnn [AddEpAnn]
type instance XConDeclH98  (GhcPass _) = EpAnn [AddEpAnn]
612

Ryan Scott's avatar
Ryan Scott committed
613
type instance XXConDecl (GhcPass _) = NoExtCon
614

Alan Zimmerman's avatar
Alan Zimmerman committed
615
getConNames :: ConDecl GhcRn -> [LocatedN Name]
Alan Zimmerman's avatar
Alan Zimmerman committed
616
617
618
getConNames ConDeclH98  {con_name  = name}  = [name]
getConNames ConDeclGADT {con_names = names} = names

Ryan Scott's avatar
Ryan Scott committed
619
620
621
-- | Return @'Just' fields@ if a data constructor declaration uses record
-- syntax (i.e., 'RecCon'), where @fields@ are the field selectors.
-- Otherwise, return 'Nothing'.
Alan Zimmerman's avatar
Alan Zimmerman committed
622
getRecConArgs_maybe :: ConDecl GhcRn -> Maybe (LocatedL [LConDeclField GhcRn])
Ryan Scott's avatar
Ryan Scott committed
623
624
625
626
627
628
getRecConArgs_maybe (ConDeclH98{con_args = args}) = case args of
  PrefixCon{} -> Nothing
  RecCon flds -> Just flds
  InfixCon{}  -> Nothing
getRecConArgs_maybe (ConDeclGADT{con_g_args = args}) = case args of
  PrefixConGADT{} -> Nothing
629
  RecConGADT flds _ -> Just flds
630

Zubin's avatar
Zubin committed
631
hsConDeclTheta :: Maybe (LHsContext (GhcPass p)) -> [LHsType (GhcPass p)]
632
633
634
hsConDeclTheta Nothing            = []
hsConDeclTheta (Just (L _ theta)) = theta

635
pp_data_defn :: (OutputableBndrId p)
636
                  => (Maybe (LHsContext (GhcPass p)) -> SDoc)   -- Printing the header
637
                  -> HsDataDefn (GhcPass p)
638
                  -> SDoc
639
pp_data_defn pp_hdr (HsDataDefn { dd_ND = new_or_data, dd_ctxt = context
Alan Zimmerman's avatar
Alan Zimmerman committed
640
                                , dd_cType = mb_ct
641
                                , dd_kindSig = mb_sig
642
                                , dd_cons = condecls, dd_derivs = derivings })
643
  | null condecls
Alan Zimmerman's avatar
Alan Zimmerman committed
644
645
  = ppr new_or_data <+> pp_ct <+> pp_hdr context <+> pp_sig
    <+> pp_derivings derivings
646
647

  | otherwise
Alan Zimmerman's avatar
Alan Zimmerman committed
648
  = hang (ppr new_or_data <+> pp_ct  <+> pp_hdr context <+> pp_sig)
Ryan Scott's avatar
Ryan Scott committed
649
       2 (pp_condecls condecls $$ pp_derivings derivings)
650
  where
Alan Zimmerman's avatar
Alan Zimmerman committed
651
652
653
    pp_ct = case mb_ct of
               Nothing   -> empty
               Just ct -> ppr ct
654
655
656
    pp_sig = case mb_sig of
               Nothing   -> empty
               Just kind -> dcolon <+> ppr kind
Alan Zimmerman's avatar
Alan Zimmerman committed
657
    pp_derivings ds = vcat (map ppr ds)
658

659
660
instance OutputableBndrId p
       => Outputable (HsDataDefn (GhcPass p)) where
661
   ppr d = pp_data_defn (\_ -> text "Naked HsDataDefn") d
662

663
664
instance OutputableBndrId p
       => Outputable (StandaloneKindSig (GhcPass p)) where
665
666
  ppr (StandaloneKindSig _ v ki)
    = text "type" <+> pprPrefixOcc (unLoc v) <+> text "::" <+> ppr ki
667

668
669
670
pp_condecls :: forall p. OutputableBndrId p => [LConDecl (GhcPass p)] -> SDoc
pp_condecls cs
  | gadt_syntax                  -- In GADT syntax
671
  = hang (text "where") 2 (vcat (map ppr cs))
672
  | otherwise                    -- In H98 syntax
673
  = equals <+> sep (punctuate (text " |") (map ppr cs))
674
675
676
677
678
  where
    gadt_syntax = case cs of
      []                      -> False
      (L _ ConDeclH98{}  : _) -> False
      (L _ ConDeclGADT{} : _) -> True
679

680
instance (OutputableBndrId p) => Outputable (ConDecl (GhcPass p)) where
681
682
    ppr = pprConDecl

683
pprConDecl :: forall p. OutputableBndrId p => ConDecl (GhcPass p) -> SDoc
Alan Zimmerman's avatar
Alan Zimmerman committed
684
pprConDecl (ConDeclH98 { con_name = L _ con
685
686
687
                       , con_ex_tvs = ex_tvs
                       , con_mb_cxt = mcxt
                       , con_args = args
Alan Zimmerman's avatar
Alan Zimmerman committed
688
                       , con_doc = doc })
689
  = sep [ ppr_mbDoc doc
Alan Zimmerman's avatar
Alan Zimmerman committed
690
        , pprHsForAll (mkHsForAllInvisTele noAnn ex_tvs) mcxt
691
        , ppr_details args ]
sof's avatar
sof committed
692
  where
Krzysztof Gogolewski's avatar
Krzysztof Gogolewski committed
693
694
695
696
697
    -- In ppr_details: let's not print the multiplicities (they are always 1, by
    -- definition) as they do not appear in an actual declaration.
    ppr_details (InfixCon t1 t2) = hsep [ppr (hsScaledThing t1),
                                         pprInfixOcc con,
                                         ppr (hsScaledThing t2)]
698
699
    ppr_details (PrefixCon _ tys) = hsep (pprPrefixOcc con
                                    : map (pprHsType . unLoc . hsScaledThing) tys)
700
    ppr_details (RecCon fields)  = pprPrefixOcc con
Alan Zimmerman's avatar
Alan Zimmerman committed
701
                                 <+> pprConDeclFields (unLoc fields)
702

703
pprConDecl (ConDeclGADT { con_names = cons, con_bndrs = L _ outer_bndrs
Ryan Scott's avatar
Ryan Scott committed
704
                        , con_mb_cxt = mcxt, con_g_args = args
705
706
                        , con_res_ty = res_ty, con_doc = doc })
  = ppr_mbDoc doc <+> ppr_con_names cons <+> dcolon
707
    <+> (sep [pprHsOuterSigTyVarBndrs outer_bndrs <+> pprLHsContext mcxt,
708
              sep (ppr_args args ++ [ppr res_ty]) ])
709
  where
710
711
712
713
714
715
716
717
    ppr_args (PrefixConGADT args) = map (\(HsScaled arr t) -> ppr t <+> ppr_arr arr) args
    ppr_args (RecConGADT fields _) = [pprConDeclFields (unLoc fields) <+> arrow]

    -- Display linear arrows as unrestricted with -XNoLinearTypes
    -- (cf. dataConDisplayType in Note [Displaying linear fields] in GHC.Core.DataCon)
    ppr_arr (HsLinearArrow _) = sdocOption sdocLinearTypes $ \show_linear_types ->
                                  if show_linear_types then lollipop else arrow
    ppr_arr arr = pprHsArrow arr
718

Alan Zimmerman's avatar
Alan Zimmerman committed
719
ppr_con_names :: (OutputableBndr a) => [GenLocated l a] -> SDoc
720
ppr_con_names = pprWithCommas (pprPrefixOcc . unLoc)
721

Austin Seipp's avatar
Austin Seipp committed
722
723
724
{-
************************************************************************
*                                                                      *
725
                Instance declarations
Austin Seipp's avatar
Austin Seipp committed
726
727
*                                                                      *
************************************************************************
728
729
-}

Alan Zimmerman's avatar
Alan Zimmerman committed
730
type instance XCFamEqn    (GhcPass _) r = EpAnn [AddEpAnn]
731
type instance XXFamEqn    (GhcPass _) r = NoExtCon
732

Alan Zimmerman's avatar
Alan Zimmerman committed
733
734
type instance Anno (FamEqn (GhcPass p) _) = SrcSpanAnnA

735
----------------- Class instances -------------
736

Alan Zimmerman's avatar
Alan Zimmerman committed
737
type instance XCClsInstDecl    GhcPs = (EpAnn [AddEpAnn], AnnSortKey) -- TODO:AZ:tidy up
Alan Zimmerman's avatar
Alan Zimmerman committed
738
739
740
type instance XCClsInstDecl    GhcRn = NoExtField
type instance XCClsInstDecl    GhcTc = NoExtField

741
type instance XXClsInstDecl    (GhcPass _) = NoExtCon
742
743
744

----------------- Instances of all kinds -------------

745
type instance XClsInstD     (GhcPass _) = NoExtField
Alan Zimmerman's avatar
Alan Zimmerman committed
746

Alan Zimmerman's avatar
Alan Zimmerman committed
747
type instance XDataFamInstD GhcPs = EpAnn [AddEpAnn]
Alan Zimmerman's avatar
Alan Zimmerman committed
748
749
750
751
752
753
754
type instance XDataFamInstD GhcRn = NoExtField
type instance XDataFamInstD GhcTc = NoExtField

type instance XTyFamInstD   GhcPs = NoExtField
type instance XTyFamInstD   GhcRn = NoExtField
type instance XTyFamInstD   GhcTc = NoExtField

755
type instance XXInstDecl    (GhcPass _) = NoExtCon
756

757
758
instance OutputableBndrId p
       => Outputable (TyFamInstDecl (GhcPass p)) where
759
760
  ppr = pprTyFamInstDecl TopLevel

761
pprTyFamInstDecl :: (OutputableBndrId p)
762
                 => TopLevelFlag -> TyFamInstDecl (GhcPass p) -> SDoc
763
pprTyFamInstDecl top_lvl (TyFamInstDecl { tfid_eqn = eqn })
764
   = text "type" <+> ppr_instance_keyword top_lvl <+> ppr_fam_inst_eqn eqn
765

766
ppr_instance_keyword :: TopLevelFlag -> SDoc
767
ppr_instance_keyword TopLevel    = text "instance"
768
769
ppr_instance_keyword NotTopLevel = empty

770
pprTyFamDefltDecl :: (OutputableBndrId p)
771
772
773
                  => TyFamDefltDecl (GhcPass p) -> SDoc
pprTyFamDefltDecl = pprTyFamInstDecl NotTopLevel

774
ppr_fam_inst_eqn :: (OutputableBndrId p)
775
                 => TyFamInstEqn (GhcPass p) -> SDoc
776
777
778
779
780
ppr_fam_inst_eqn (FamEqn { feqn_tycon  = L _ tycon
                         , feqn_bndrs  = bndrs
                         , feqn_pats   = pats
                         , feqn_fixity = fixity
                         , feqn_rhs    = rhs })
781
    = pprHsFamInstLHS tycon bndrs pats fixity Nothing <+> equals <+> ppr rhs
782

783
784
instance OutputableBndrId p
       => Outputable (DataFamInstDecl (GhcPass p)) where
785
786
  ppr = pprDataFamInstDecl TopLevel

787
pprDataFamInstDecl :: (OutputableBndrId p)
788
                   => TopLevelFlag -> DataFamInstDecl (GhcPass p) -> SDoc
789
790
pprDataFamInstDecl top_lvl (DataFamInstDecl { dfid_eqn =
                            (FamEqn { feqn_tycon  = L _ tycon
791
                                    , feqn_bndrs  = bndrs
792
793
                                    , feqn_pats   = pats
                                    , feqn_fixity = fixity
794
                                    , feqn_rhs    = defn })})
795
796
  = pp_data_defn pp_hdr defn
  where
Alan Zimmerman's avatar
Alan Zimmerman committed
797
798
    pp_hdr mctxt = ppr_instance_keyword top_lvl
              <+> pprHsFamInstLHS tycon bndrs pats fixity mctxt
799
800
                  -- pp_data_defn pretty-prints the kind sig. See #14817.

801
pprDataFamInstFlavour :: DataFamInstDecl (GhcPass p) -> SDoc
802
803
pprDataFamInstFlavour (DataFamInstDecl { dfid_eqn =
                       (FamEqn { feqn_rhs = HsDataDefn { dd_ND = nd }})})
804
805
  = ppr nd

806
pprHsFamInstLHS :: (OutputableBndrId p)
807
   => IdP (GhcPass p)
808
   -> HsOuterFamEqnTyVarBndrs (GhcPass p)
809
   -> HsTyPats (GhcPass p)
810
   -> LexicalFixity
811
   -> Maybe (LHsContext (GhcPass p))
Jan Stolarek's avatar
Jan Stolarek committed
812
   -> SDoc
813
pprHsFamInstLHS thing bndrs typats fixity mb_ctxt
814
   = hsep [ pprHsOuterFamEqnTyVarBndrs bndrs
815
          , pprLHsContext mb_ctxt
816
          , pprHsArgsApp thing fixity typats ]
817

818
819
instance OutputableBndrId p
       => Outputable (ClsInstDecl (GhcPass p)) where
820
821
    ppr (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = binds
                     , cid_sigs = sigs, cid_tyfam_insts = ats
822
                     , cid_overlap_mode = mbOverlap
823
                     , cid_datafam_insts = adts })
824
      | null sigs, null ats, null adts, isEmptyBag binds  -- No "where" part
825
      = top_matter
826

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
827
      | otherwise       -- Laid out
828
      = vcat [ top_matter <+> text "where"
829
830
831
832
             , nest 2 $ pprDeclList $
               map (pprTyFamInstDecl NotTopLevel . unLoc)   ats ++
               map (pprDataFamInstDecl NotTopLevel . unLoc) adts ++
               pprLHsBindsForUser binds sigs ]
833
      where
834
        top_matter = text "instance" <+> ppOverlapPragma mbOverlap
835
836
                                             <+> ppr inst_ty

837