Decls.hs 95.4 KB
Newer Older
Austin Seipp's avatar
Austin Seipp committed
1 2 3 4
{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-}
5

6 7
{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, DeriveFoldable,
             DeriveTraversable #-}
8 9 10
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
Sylvain Henry's avatar
Sylvain Henry committed
11
                                      -- in module GHC.Hs.PlaceHolder
12
{-# LANGUAGE ConstraintKinds #-}
13
{-# LANGUAGE TypeFamilies #-}
14

15 16
-- | Abstract syntax of global declarations.
--
17
-- Definitions for: @SynDecl@ and @ConDecl@, @ClassDecl@,
18
-- @InstDecl@, @DefaultDecl@ and @ForeignDecl@.
Sylvain Henry's avatar
Sylvain Henry committed
19
module GHC.Hs.Decls (
20
  -- * Toplevel declarations
21
  HsDecl(..), LHsDecl, HsDataDefn(..), HsDeriving, LHsFunDep,
22
  HsDerivingClause(..), LHsDerivingClause, NewOrData(..), newOrDataToFlavour,
23
  StandaloneKindSig(..), LStandaloneKindSig, standaloneKindSigName,
24

25
  -- ** Class or type declarations
26
  TyClDecl(..), LTyClDecl, DataDeclRn(..),
27
  TyClGroup(..),
28
  tyClGroupTyClDecls, tyClGroupInstDecls, tyClGroupRoleDecls,
29
  tyClGroupKindSigs,
30 31
  isClassDecl, isDataDecl, isSynDecl, tcdName,
  isFamilyDecl, isTypeFamilyDecl, isDataFamilyDecl,
32
  isOpenTypeFamilyInfo, isClosedTypeFamilyInfo,
33 34 35
  tyFamInstDeclName, tyFamInstDeclLName,
  countTyClDecls, pprTyClDeclFlavour,
  tyClDeclLName, tyClDeclTyVars,
36
  hsDeclHasCusk, famResultKindSignature,
37
  FamilyDecl(..), LFamilyDecl,
38

39
  -- ** Instance declarations
40
  InstDecl(..), LInstDecl, FamilyInfo(..),
41
  TyFamInstDecl(..), LTyFamInstDecl, instDeclDataFamInsts,
42
  TyFamDefltDecl, LTyFamDefltDecl,
43
  DataFamInstDecl(..), LDataFamInstDecl,
44
  pprDataFamInstFlavour, pprTyFamInstDecl, pprHsFamInstLHS,
45
  FamInstEqn, LFamInstEqn, FamEqn(..),
46
  TyFamInstEqn, LTyFamInstEqn, HsTyPats,
47
  LClsInstDecl, ClsInstDecl(..),
48

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

  -- * Grouping
86
  HsGroup(..),  emptyRdrGroup, emptyRnGroup, appendGroups, hsGroupInstDecls
87

88
    ) where
89 90

-- friends:
91 92
import GhcPrelude

Sylvain Henry's avatar
Sylvain Henry committed
93 94
import {-# SOURCE #-} GHC.Hs.Expr( HsExpr, HsSplice, pprExpr,
                                   pprSpliceDecl )
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
95
        -- Because Expr imports Decls via HsBracket
96

Sylvain Henry's avatar
Sylvain Henry committed
97 98 99
import GHC.Hs.Binds
import GHC.Hs.Types
import GHC.Hs.Doc
100
import TyCon
101
import BasicTypes
102
import Coercion
103
import ForeignCall
Sylvain Henry's avatar
Sylvain Henry committed
104
import GHC.Hs.Extension
105
import NameSet
106 107

-- others:
108
import Class
109
import Outputable
110 111
import Util
import SrcLoc
Ryan Scott's avatar
Ryan Scott committed
112
import Type
113

114
import Bag
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
115
import Maybes
116
import Data.Data        hiding (TyCon,Fixity, Infix)
117

Austin Seipp's avatar
Austin Seipp committed
118 119 120
{-
************************************************************************
*                                                                      *
121
\subsection[HsDecl]{Declarations}
Austin Seipp's avatar
Austin Seipp committed
122 123 124
*                                                                      *
************************************************************************
-}
125

126
type LHsDecl p = Located (HsDecl p)
Alan Zimmerman's avatar
Alan Zimmerman committed
127 128 129 130
        -- ^ When in a list this may have
        --
        --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi'
        --
131

132 133
-- For details on above see note [Api annotations] in ApiAnnotation

134
-- | A Haskell Declaration
135 136 137 138 139 140
data HsDecl p
  = TyClD      (XTyClD p)      (TyClDecl p)      -- ^ Type or Class Declaration
  | InstD      (XInstD p)      (InstDecl  p)     -- ^ Instance declaration
  | DerivD     (XDerivD p)     (DerivDecl p)     -- ^ Deriving declaration
  | ValD       (XValD p)       (HsBind p)        -- ^ Value declaration
  | SigD       (XSigD p)       (Sig p)           -- ^ Signature declaration
141
  | KindSigD   (XKindSigD p)   (StandaloneKindSig p) -- ^ Standalone kind signature
142 143 144 145 146 147 148 149 150 151 152
  | DefD       (XDefD p)       (DefaultDecl p)   -- ^ 'default' declaration
  | ForD       (XForD p)       (ForeignDecl p)   -- ^ Foreign declaration
  | WarningD   (XWarningD p)   (WarnDecls p)     -- ^ Warning declaration
  | AnnD       (XAnnD p)       (AnnDecl p)       -- ^ Annotation declaration
  | RuleD      (XRuleD p)      (RuleDecls p)     -- ^ Rule declaration
  | SpliceD    (XSpliceD p)    (SpliceDecl p)    -- ^ Splice declaration
                                                 -- (Includes quasi-quotes)
  | DocD       (XDocD p)       (DocDecl)  -- ^ Documentation comment declaration
  | RoleAnnotD (XRoleAnnotD p) (RoleAnnotDecl p) -- ^Role annotation declaration
  | XHsDecl    (XXHsDecl p)

153 154 155 156 157
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
158
type instance XKindSigD   (GhcPass _) = NoExtField
159 160 161 162 163 164 165 166 167
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
168 169

-- NB: all top-level fixity decls are contained EITHER
170
-- EITHER SigDs
171 172 173
-- OR     in the ClassDecls in TyClDs
--
-- The former covers
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
174 175 176 177 178
--      a) data constructors
--      b) class methods (but they can be also done in the
--              signatures of class decls)
--      c) imported functions (that have an IfacSig)
--      d) top level decls
179 180
--
-- The latter is for class methods only
181

182 183 184
-- | Haskell Group
--
-- A 'HsDecl' is categorised into a 'HsGroup' before being
185
-- fed to the renamer.
186
data HsGroup p
187
  = HsGroup {
188 189 190
        hs_ext    :: XCHsGroup p,
        hs_valds  :: HsValBinds p,
        hs_splcds :: [LSpliceDecl p],
191

192
        hs_tyclds :: [TyClGroup p],
193 194
                -- A list of mutually-recursive groups;
                -- This includes `InstDecl`s as well;
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
195 196
                -- Parser generates a singleton list;
                -- renamer does dependency analysis
197

198
        hs_derivds :: [LDerivDecl p],
199

200
        hs_fixds  :: [LFixitySig p],
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
201 202
                -- Snaffled out of both top-level fixity signatures,
                -- and those in class declarations
203

204 205 206 207 208
        hs_defds  :: [LDefaultDecl p],
        hs_fords  :: [LForeignDecl p],
        hs_warnds :: [LWarnDecls p],
        hs_annds  :: [LAnnDecl p],
        hs_ruleds :: [LRuleDecls p],
209

210
        hs_docs   :: [LDocDecl]
211 212 213
    }
  | XHsGroup (XXHsGroup p)

214 215
type instance XCHsGroup (GhcPass _) = NoExtField
type instance XXHsGroup (GhcPass _) = NoExtCon
216

217 218

emptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup (GhcPass p)
219 220 221
emptyRdrGroup = emptyGroup { hs_valds = emptyValBindsIn }
emptyRnGroup  = emptyGroup { hs_valds = emptyValBindsOut }

222 223 224
hsGroupInstDecls :: HsGroup id -> [LInstDecl id]
hsGroupInstDecls = (=<<) group_instds . hs_tyclds

225
emptyGroup = HsGroup { hs_ext = noExtField,
226
                       hs_tyclds = [],
227
                       hs_derivds = [],
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
228
                       hs_fixds = [], hs_defds = [], hs_annds = [],
229
                       hs_fords = [], hs_warnds = [], hs_ruleds = [],
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
230
                       hs_valds = error "emptyGroup hs_valds: Can't happen",
231
                       hs_splcds = [],
232
                       hs_docs = [] }
233

234 235
appendGroups :: HsGroup (GhcPass p) -> HsGroup (GhcPass p)
             -> HsGroup (GhcPass p)
236 237
appendGroups
    HsGroup {
238
        hs_valds  = val_groups1,
239
        hs_splcds = spliceds1,
240
        hs_tyclds = tyclds1,
241
        hs_derivds = derivds1,
242
        hs_fixds  = fixds1,
243 244
        hs_defds  = defds1,
        hs_annds  = annds1,
245
        hs_fords  = fords1,
246 247
        hs_warnds = warnds1,
        hs_ruleds = rulds1,
248
        hs_docs   = docs1 }
249
    HsGroup {
250
        hs_valds  = val_groups2,
251
        hs_splcds = spliceds2,
252
        hs_tyclds = tyclds2,
253
        hs_derivds = derivds2,
254
        hs_fixds  = fixds2,
255 256
        hs_defds  = defds2,
        hs_annds  = annds2,
257
        hs_fords  = fords2,
258 259 260
        hs_warnds = warnds2,
        hs_ruleds = rulds2,
        hs_docs   = docs2 }
261 262
  =
    HsGroup {
263
        hs_ext    = noExtField,
264
        hs_valds  = val_groups1 `plusHsValBinds` val_groups2,
265 266
        hs_splcds = spliceds1 ++ spliceds2,
        hs_tyclds = tyclds1 ++ tyclds2,
267
        hs_derivds = derivds1 ++ derivds2,
268 269 270
        hs_fixds  = fixds1 ++ fixds2,
        hs_annds  = annds1 ++ annds2,
        hs_defds  = defds1 ++ defds2,
271
        hs_fords  = fords1 ++ fords2,
272 273 274
        hs_warnds = warnds1 ++ warnds2,
        hs_ruleds = rulds1 ++ rulds2,
        hs_docs   = docs1  ++ docs2 }
275
appendGroups _ _ = panic "appendGroups"
276

277
instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsDecl p) where
278 279 280 281 282 283 284
    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
285
    ppr (KindSigD _ ksd)          = ppr ksd
286 287 288 289 290 291 292
    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
    ppr (XHsDecl x)               = ppr x
293

294
instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsGroup p) where
295
    ppr (HsGroup { hs_valds  = val_decls,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
296
                   hs_tyclds = tycl_decls,
297
                   hs_derivds = deriv_decls,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
298 299 300 301 302
                   hs_fixds  = fix_decls,
                   hs_warnds = deprec_decls,
                   hs_annds  = ann_decls,
                   hs_fords  = foreign_decls,
                   hs_defds  = default_decls,
303
                   hs_ruleds = rule_decls })
304 305
        = vcat_mb empty
            [ppr_ds fix_decls, ppr_ds default_decls,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
306 307
             ppr_ds deprec_decls, ppr_ds ann_decls,
             ppr_ds rule_decls,
308 309
             if isEmptyValBinds val_decls
                then Nothing
310
                else Just (ppr val_decls),
311
             ppr_ds (tyClGroupRoleDecls tycl_decls),
312
             ppr_ds (tyClGroupKindSigs  tycl_decls),
313 314
             ppr_ds (tyClGroupTyClDecls tycl_decls),
             ppr_ds (tyClGroupInstDecls tycl_decls),
315
             ppr_ds deriv_decls,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
316 317
             ppr_ds foreign_decls]
        where
318
          ppr_ds :: Outputable a => [a] -> Maybe SDoc
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
319 320
          ppr_ds [] = Nothing
          ppr_ds ds = Just (vcat (map ppr ds))
321 322

          vcat_mb :: SDoc -> [Maybe SDoc] -> SDoc
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
323
          -- Concatenate vertically with white-space between non-blanks
324 325 326
          vcat_mb _    []             = empty
          vcat_mb gap (Nothing : ds) = vcat_mb gap ds
          vcat_mb gap (Just d  : ds) = gap $$ d $$ vcat_mb blankLine ds
327
    ppr (XHsGroup x) = ppr x
328

329
-- | Located Splice Declaration
330
type LSpliceDecl pass = Located (SpliceDecl pass)
331 332

-- | Splice Declaration
333
data SpliceDecl p
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
334
  = SpliceDecl                  -- Top level splice
335 336
        (XSpliceDecl p)
        (Located (HsSplice p))
337
        SpliceExplicitFlag
338 339
  | XSpliceDecl (XXSpliceDecl p)

340 341
type instance XSpliceDecl      (GhcPass _) = NoExtField
type instance XXSpliceDecl     (GhcPass _) = NoExtCon
342

343 344
instance (p ~ GhcPass pass, OutputableBndrId p)
       => Outputable (SpliceDecl p) where
345 346
   ppr (SpliceDecl _ (L _ e) f) = pprSpliceDecl e f
   ppr (XSpliceDecl x) = ppr x
347

Austin Seipp's avatar
Austin Seipp committed
348 349 350
{-
************************************************************************
*                                                                      *
351
            Type and class declarations
Austin Seipp's avatar
Austin Seipp committed
352 353
*                                                                      *
************************************************************************
354

355 356
Note [The Naming story]
~~~~~~~~~~~~~~~~~~~~~~~
357 358
Here is the story about the implicit names that go with type, class,
and instance decls.  It's a bit tricky, so pay attention!
359 360 361

"Implicit" (or "system") binders
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
362
  Each data type decl defines
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
363 364
        a worker name for each constructor
        to-T and from-T convertors
365
  Each class decl defines
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
366 367 368 369
        a tycon for the class
        a data constructor for that tycon
        the worker for that constructor
        a selector for each superclass
370

371 372
All have occurrence names that are derived uniquely from their parent
declaration.
373 374 375 376 377 378 379

None of these get separate definitions in an interface file; they are
fully defined by the data or class decl.  But they may *occur* in
interface files, of course.  Any such occurrence must haul in the
relevant type or class decl.

Plan of attack:
380
 - Ensure they "point to" the parent data/class decl
381
   when loading that decl from an interface file
382 383 384 385 386
   (See RnHiFiles.getSysBinders)

 - When typechecking the decl, we build the implicit TyCons and Ids.
   When doing so we look them up in the name cache (RnEnv.lookupSysName),
   to ensure correct module and provenance is set
387

388 389
These are the two places that we have to conjure up the magic derived
names.  (The actual magic is in OccName.mkWorkerOcc, etc.)
390

391 392 393 394 395 396
Default methods
~~~~~~~~~~~~~~~
 - Occurrence name is derived uniquely from the method name
   E.g. $dmmax

 - If there is a default method name at all, it's recorded in
Sylvain Henry's avatar
Sylvain Henry committed
397
   the ClassOpSig (in GHC.Hs.Binds), in the DefMethInfo field.
398
   (DefMethInfo is defined in Class.hs)
399 400 401 402 403 404 405

Source-code class decls and interface-code class decls are treated subtly
differently, which has given me a great deal of confusion over the years.
Here's the deal.  (We distinguish the two cases because source-code decls
have (Just binds) in the tcdMeths field, whereas interface decls have Nothing.

In *source-code* class declarations:
406

407 408 409 410 411
 - When parsing, every ClassOpSig gets a DefMeth with a suitable RdrName
   This is done by RdrHsSyn.mkClassOpSigDM

 - The renamer renames it to a Name

412
 - During typechecking, we generate a binding for each $dm for
413
   which there's a programmer-supplied default method:
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
414 415 416 417
        class Foo a where
          op1 :: <type>
          op2 :: <type>
          op1 = ...
418
   We generate a binding for $dmop1 but not for $dmop2.
419 420
   The Class for Foo has a Nothing for op2 and
                         a Just ($dm_op1, VanillaDM) for op1.
421 422 423 424 425
   The Name for $dmop2 is simply discarded.

In *interface-file* class declarations:
  - When parsing, we see if there's an explicit programmer-supplied default method
    because there's an '=' sign to indicate it:
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
426 427 428
        class Foo a where
          op1 = :: <type>       -- NB the '='
          op2   :: <type>
429 430 431 432 433
    We use this info to generate a DefMeth with a suitable RdrName for op1,
    and a NoDefMeth for op2
  - The interface file has a separate definition for $dmop1, with unfolding etc.
  - The renamer renames it to a Name.
  - The renamer treats $dmop1 as a free variable of the declaration, so that
434
    the binding for $dmop1 will be sucked in.  (See RnHsSyn.tyClDeclFVs)
435 436 437 438 439 440 441 442 443 444 445 446 447 448
    This doesn't happen for source code class decls, because they *bind* the default method.

Dictionary functions
~~~~~~~~~~~~~~~~~~~~
Each instance declaration gives rise to one dictionary function binding.

The type checker makes up new source-code instance declarations
(e.g. from 'deriving' or generic default methods --- see
TcInstDcls.tcInstDecls1).  So we can't generate the names for
dictionary functions in advance (we don't know how many we need).

On the other hand for interface-file instance declarations, the decl
specifies the name of the dictionary function, and it has a binding elsewhere
in the interface file:
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
449 450
        instance {Eq Int} = dEqInt
        dEqInt :: {Eq Int} <pragma info>
451 452 453 454 455 456 457 458 459 460 461

So again we treat source code and interface file code slightly differently.

Source code:
  - Source code instance decls have a Nothing in the (Maybe name) field
    (see data InstDecl below)

  - The typechecker makes up a Local name for the dict fun for any source-code
    instance decl, whether it comes from a source-code instance decl, or whether
    the instance decl is derived from some other construct (e.g. 'deriving').

462
  - The occurrence name it chooses is derived from the instance decl (just for
463 464
    documentation really) --- e.g. dNumInt.  Two dict funs may share a common
    occurrence name, but will have different uniques.  E.g.
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
465 466
        instance Foo [Int]  where ...
        instance Foo [Bool] where ...
467 468
    These might both be dFooList

469
  - The CoreTidy phase externalises the name, and ensures the occurrence name is
470 471
    unique (this isn't special to dict funs).  So we'd get dFooList and dFooList1.

472
  - We can take this relaxed approach (changing the occurrence name later)
473 474 475 476 477 478 479 480 481
    because dict fun Ids are not captured in a TyCon or Class (unlike default
    methods, say).  Instead, they are kept separately in the InstEnv.  This
    makes it easy to adjust them after compiling a module.  (Once we've finished
    compiling that module, they don't change any more.)


Interface file code:
  - The instance decl gives the dict fun name, so the InstDecl has a (Just name)
    in the (Maybe name) field.
482

483 484
  - RnHsSyn.instDeclFVs treats the dict fun name as free in the decl, so that we
    suck in the dfun binding
Austin Seipp's avatar
Austin Seipp committed
485
-}
486

487
-- | Located Declaration of a Type or Class
488
type LTyClDecl pass = Located (TyClDecl pass)
489

490
-- | A type or class declaration.
491
data TyClDecl pass
Yuras's avatar
Yuras committed
492
  = -- | @type/data family T :: *->*@
Alan Zimmerman's avatar
Alan Zimmerman committed
493 494 495
    --
    --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',
    --             'ApiAnnotation.AnnData',
496
    --             'ApiAnnotation.AnnFamily','ApiAnnotation.AnnDcolon',
Jan Stolarek's avatar
Jan Stolarek committed
497 498 499 500
    --             'ApiAnnotation.AnnWhere','ApiAnnotation.AnnOpenP',
    --             'ApiAnnotation.AnnDcolon','ApiAnnotation.AnnCloseP',
    --             'ApiAnnotation.AnnEqual','ApiAnnotation.AnnRarrow',
    --             'ApiAnnotation.AnnVbar'
Alan Zimmerman's avatar
Alan Zimmerman committed
501

502
    -- For details on above see note [Api annotations] in ApiAnnotation
503
    FamDecl { tcdFExt :: XFamDecl pass, tcdFam :: FamilyDecl pass }
504

505
  | -- | @type@ declaration
Alan Zimmerman's avatar
Alan Zimmerman committed
506 507 508
    --
    --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',
    --             'ApiAnnotation.AnnEqual',
509 510

    -- For details on above see note [Api annotations] in ApiAnnotation
511 512
    SynDecl { tcdSExt   :: XSynDecl pass          -- ^ Post renameer, FVs
            , tcdLName  :: Located (IdP pass)     -- ^ Type constructor
513 514 515
            , tcdTyVars :: LHsQTyVars pass        -- ^ Type variables; for an
                                                  -- associated type these
                                                  -- include outer binders
516
            , tcdFixity :: LexicalFixity    -- ^ Fixity used in the declaration
517
            , tcdRhs    :: LHsType pass }         -- ^ RHS of type declaration
518 519

  | -- | @data@ declaration
Alan Zimmerman's avatar
Alan Zimmerman committed
520 521 522 523
    --
    --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnData',
    --              'ApiAnnotation.AnnFamily',
    --              'ApiAnnotation.AnnNewType',
524 525
    --              'ApiAnnotation.AnnNewType','ApiAnnotation.AnnDcolon'
    --              'ApiAnnotation.AnnWhere',
526 527

    -- For details on above see note [Api annotations] in ApiAnnotation
528 529 530 531 532
    DataDecl { tcdDExt     :: XDataDecl pass       -- ^ Post renamer, CUSK flag, FVs
             , tcdLName    :: Located (IdP pass)   -- ^ Type constructor
             , tcdTyVars   :: LHsQTyVars pass      -- ^ Type variables
                              -- See Note [TyVar binders for associated declarations]
             , tcdFixity   :: LexicalFixity        -- ^ Fixity used in the declaration
533
             , tcdDataDefn :: HsDataDefn pass }
534

535 536
  | ClassDecl { tcdCExt    :: XClassDecl pass,         -- ^ Post renamer, FVs
                tcdCtxt    :: LHsContext pass,         -- ^ Context...
537 538
                tcdLName   :: Located (IdP pass),      -- ^ Name of the class
                tcdTyVars  :: LHsQTyVars pass,         -- ^ Class type variables
539
                tcdFixity  :: LexicalFixity, -- ^ Fixity used in the declaration
540
                tcdFDs     :: [LHsFunDep pass],         -- ^ Functional deps
541 542 543
                tcdSigs    :: [LSig pass],              -- ^ Methods' signatures
                tcdMeths   :: LHsBinds pass,            -- ^ Default methods
                tcdATs     :: [LFamilyDecl pass],       -- ^ Associated types;
544
                tcdATDefs  :: [LTyFamDefltDecl pass],   -- ^ Associated type defaults
545
                tcdDocs    :: [LDocDecl]                -- ^ Haddock docs
546
    }
Alan Zimmerman's avatar
Alan Zimmerman committed
547 548 549 550 551 552
        -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnClass',
        --           'ApiAnnotation.AnnWhere','ApiAnnotation.AnnOpen',
        --           'ApiAnnotation.AnnClose'
        --   - The tcdFDs will have 'ApiAnnotation.AnnVbar',
        --                          'ApiAnnotation.AnnComma'
        --                          'ApiAnnotation.AnnRarrow'
553

554
        -- For details on above see note [Api annotations] in ApiAnnotation
555 556
  | XTyClDecl (XXTyClDecl pass)

557 558
type LHsFunDep pass = Located (FunDep (Located (IdP pass)))

559 560
data DataDeclRn = DataDeclRn
             { tcdDataCusk :: Bool    -- ^ does this have a CUSK?
561
                 -- See Note [CUSKs: complete user-supplied kind signatures]
562 563
             , tcdFVs      :: NameSet }
  deriving Data
564

565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585
{- Note [TyVar binders for associated decls]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
For an /associated/ data, newtype, or type-family decl, the LHsQTyVars
/includes/ outer binders.  For example
    class T a where
       data D a c
       type F a b :: *
       type F a b = a -> a
Here the data decl for 'D', and type-family decl for 'F', both include 'a'
in their LHsQTyVars (tcdTyVars and fdTyVars resp).

Ditto any implicit binders in the hsq_implicit field of the LHSQTyVars.

The idea is that the associated type is really a top-level decl in its
own right.  However we are careful to use the same name 'a', so that
we can match things up.

c.f. Note [Associated type tyvar names] in Class.hs
     Note [Family instance declaration binders]
-}

586
type instance XFamDecl      (GhcPass _) = NoExtField
587

588
type instance XSynDecl      GhcPs = NoExtField
589 590 591
type instance XSynDecl      GhcRn = NameSet -- FVs
type instance XSynDecl      GhcTc = NameSet -- FVs

592
type instance XDataDecl     GhcPs = NoExtField
593 594 595
type instance XDataDecl     GhcRn = DataDeclRn
type instance XDataDecl     GhcTc = DataDeclRn

596
type instance XClassDecl    GhcPs = NoExtField
597 598 599
type instance XClassDecl    GhcRn = NameSet -- FVs
type instance XClassDecl    GhcTc = NameSet -- FVs

600
type instance XXTyClDecl    (GhcPass _) = NoExtCon
601

Jan Stolarek's avatar
Jan Stolarek committed
602 603
-- Simple classifiers for TyClDecl
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
604

605
-- | @True@ <=> argument is a @data@\/@newtype@
606
-- declaration.
607
isDataDecl :: TyClDecl pass -> Bool
608 609
isDataDecl (DataDecl {}) = True
isDataDecl _other        = False
610

611
-- | type or type instance declaration
612
isSynDecl :: TyClDecl pass -> Bool
613 614
isSynDecl (SynDecl {})   = True
isSynDecl _other        = False
615

616
-- | type class
617
isClassDecl :: TyClDecl pass -> Bool
618
isClassDecl (ClassDecl {}) = True
619
isClassDecl _              = False
620

621
-- | type/data family declaration
622
isFamilyDecl :: TyClDecl pass -> Bool
623
isFamilyDecl (FamDecl {})  = True
624
isFamilyDecl _other        = False
625 626

-- | type family declaration
627
isTypeFamilyDecl :: TyClDecl pass -> Bool
628
isTypeFamilyDecl (FamDecl _ (FamilyDecl { fdInfo = info })) = case info of
629 630 631 632
  OpenTypeFamily      -> True
  ClosedTypeFamily {} -> True
  _                   -> False
isTypeFamilyDecl _ = False
633

634
-- | open type family info
635
isOpenTypeFamilyInfo :: FamilyInfo pass -> Bool
636 637 638 639
isOpenTypeFamilyInfo OpenTypeFamily = True
isOpenTypeFamilyInfo _              = False

-- | closed type family info
640
isClosedTypeFamilyInfo :: FamilyInfo pass -> Bool
641 642 643
isClosedTypeFamilyInfo (ClosedTypeFamily {}) = True
isClosedTypeFamilyInfo _                     = False

644
-- | data family declaration
645
isDataFamilyDecl :: TyClDecl pass -> Bool
646
isDataFamilyDecl (FamDecl _ (FamilyDecl { fdInfo = DataFamily })) = True
647
isDataFamilyDecl _other      = False
648

Austin Seipp's avatar
Austin Seipp committed
649
-- Dealing with names
650

651
tyFamInstDeclName :: TyFamInstDecl (GhcPass p) -> IdP (GhcPass p)
652 653
tyFamInstDeclName = unLoc . tyFamInstDeclLName

654
tyFamInstDeclLName :: TyFamInstDecl (GhcPass p) -> Located (IdP (GhcPass p))
655
tyFamInstDeclLName (TyFamInstDecl { tfid_eqn =
656
                     (HsIB { hsib_body = FamEqn { feqn_tycon = ln }}) })
657
  = ln
658 659 660 661
tyFamInstDeclLName (TyFamInstDecl (HsIB _ (XFamEqn nec)))
  = noExtCon nec
tyFamInstDeclLName (TyFamInstDecl (XHsImplicitBndrs nec))
  = noExtCon nec
662

663
tyClDeclLName :: TyClDecl pass -> Located (IdP pass)
664 665
tyClDeclLName (FamDecl { tcdFam = FamilyDecl { fdLName = ln } }) = ln
tyClDeclLName decl = tcdLName decl
666

667
tcdName :: TyClDecl pass -> IdP pass
668 669
tcdName = unLoc . tyClDeclLName

670
tyClDeclTyVars :: TyClDecl pass -> LHsQTyVars pass
671 672
tyClDeclTyVars (FamDecl { tcdFam = FamilyDecl { fdTyVars = tvs } }) = tvs
tyClDeclTyVars d = tcdTyVars d
673

674
countTyClDecls :: [TyClDecl pass] -> (Int, Int, Int, Int, Int)
675
        -- class, synonym decls, data, newtype, family decls
676
countTyClDecls decls
677 678 679 680
 = (count isClassDecl    decls,
    count isSynDecl      decls,  -- excluding...
    count isDataTy       decls,  -- ...family...
    count isNewTy        decls,  -- ...instances
681
    count isFamilyDecl   decls)
sof's avatar
sof committed
682
 where
683 684
   isDataTy DataDecl{ tcdDataDefn = HsDataDefn { dd_ND = DataType } } = True
   isDataTy _                                                       = False
685

686 687
   isNewTy DataDecl{ tcdDataDefn = HsDataDefn { dd_ND = NewType } } = True
   isNewTy _                                                      = False
688 689

-- | Does this declaration have a complete, user-supplied kind signature?
690
-- See Note [CUSKs: complete user-supplied kind signatures]
691 692 693 694 695 696 697 698 699 700 701 702 703 704 705
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
hsDeclHasCusk (FamDecl { tcdFam = XFamilyDecl nec }) = noExtCon nec
hsDeclHasCusk (XTyClDecl nec) = noExtCon nec
706

Jan Stolarek's avatar
Jan Stolarek committed
707 708
-- Pretty-printing TyClDecl
-- ~~~~~~~~~~~~~~~~~~~~~~~~
709

710
instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (TyClDecl p) where
711

712
    ppr (FamDecl { tcdFam = decl }) = ppr decl
713 714
    ppr (SynDecl { tcdLName = ltycon, tcdTyVars = tyvars, tcdFixity = fixity
                 , tcdRhs = rhs })
715
      = hang (text "type" <+>
716
              pp_vanilla_decl_head ltycon tyvars fixity noLHsContext <+> equals)
717
          4 (ppr rhs)
718

719 720 721
    ppr (DataDecl { tcdLName = ltycon, tcdTyVars = tyvars, tcdFixity = fixity
                  , tcdDataDefn = defn })
      = pp_data_defn (pp_vanilla_decl_head ltycon tyvars fixity) defn
722

723
    ppr (ClassDecl {tcdCtxt = context, tcdLName = lclas, tcdTyVars = tyvars,
724
                    tcdFixity = fixity,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
725
                    tcdFDs  = fds,
726 727 728
                    tcdSigs = sigs, tcdMeths = methods,
                    tcdATs = ats, tcdATDefs = at_defs})
      | null sigs && isEmptyBag methods && null ats && null at_defs -- No "where" part
729 730
      = top_matter

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
731
      | otherwise       -- Laid out
732
      = vcat [ top_matter <+> text "where"
733
             , nest 2 $ pprDeclList (map (pprFamilyDecl NotTopLevel . unLoc) ats ++
734
                                     map (pprTyFamDefltDecl . unLoc) at_defs ++
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
735
                                     pprLHsBindsForUser methods sigs) ]
736
      where
737
        top_matter = text "class"
738
                    <+> pp_vanilla_decl_head lclas tyvars fixity context
739
                    <+> pprFundeps (map unLoc fds)
740

741
    ppr (XTyClDecl x) = ppr x
742

743 744
instance (p ~ GhcPass pass, OutputableBndrId p)
       => Outputable (TyClGroup p) where
745 746
  ppr (TyClGroup { group_tyclds = tyclds
                 , group_roles = roles
747
                 , group_kisigs = kisigs
748 749 750
                 , group_instds = instds
                 }
      )
751 752 753
    = hang (text "TyClGroup") 2 $
      ppr kisigs $$
      ppr tyclds $$
754 755
      ppr roles $$
      ppr instds
756
  ppr (XTyClGroup x) = ppr x
757

758 759 760
pp_vanilla_decl_head :: (OutputableBndrId (GhcPass p))
   => Located (IdP (GhcPass p))
   -> LHsQTyVars (GhcPass p)
761
   -> LexicalFixity
762
   -> LHsContext (GhcPass p)
Jan Stolarek's avatar
Jan Stolarek committed
763
   -> SDoc
Alan Zimmerman's avatar