HsDecls.hs 92.6 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 11 12
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
                                      -- in module PlaceHolder
{-# 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@.
19
module HsDecls (
20
  -- * Toplevel declarations
21
  HsDecl(..), LHsDecl, HsDataDefn(..), HsDeriving,
22
  HsDerivingClause(..), LHsDerivingClause, NewOrData(..), newOrDataToFlavour,
23

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

37
  -- ** Instance declarations
38
  InstDecl(..), LInstDecl, FamilyInfo(..),
39
  TyFamInstDecl(..), LTyFamInstDecl, instDeclDataFamInsts,
40
  DataFamInstDecl(..), LDataFamInstDecl, pprDataFamInstFlavour, pprFamInstLHS,
41 42
  FamInstEqn, LFamInstEqn, FamEqn(..),
  TyFamInstEqn, LTyFamInstEqn, TyFamDefltEqn, LTyFamDefltEqn,
Alan Zimmerman's avatar
Alan Zimmerman committed
43
  HsTyPats,
44
  LClsInstDecl, ClsInstDecl(..),
45

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

  -- * Grouping
83
  HsGroup(..),  emptyRdrGroup, emptyRnGroup, appendGroups, hsGroupInstDecls
84

85
    ) where
86 87

-- friends:
88 89
import GhcPrelude

Alan Zimmerman's avatar
Alan Zimmerman committed
90 91
import {-# SOURCE #-}   HsExpr( LHsExpr, HsExpr, HsSplice, pprExpr,
                                pprSpliceDecl )
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
92
        -- Because Expr imports Decls via HsBracket
93

94
import HsBinds
95
import HsTypes
96
import HsDoc
97
import TyCon
98
import Name
99
import BasicTypes
100
import Coercion
101
import ForeignCall
102
import HsExtension
103
import NameSet
104 105

-- others:
106
import InstEnv
107
import Class
108
import Outputable
109 110 111
import Util
import SrcLoc

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

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

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

130 131
-- For details on above see note [Api annotations] in ApiAnnotation

132
-- | A Haskell Declaration
133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165
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
  | 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
  | VectD      (XVectD p)      (VectDecl p)      -- ^ Vectorise 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)

type instance XTyClD      (GhcPass _) = NoExt
type instance XInstD      (GhcPass _) = NoExt
type instance XDerivD     (GhcPass _) = NoExt
type instance XValD       (GhcPass _) = NoExt
type instance XSigD       (GhcPass _) = NoExt
type instance XDefD       (GhcPass _) = NoExt
type instance XForD       (GhcPass _) = NoExt
type instance XWarningD   (GhcPass _) = NoExt
type instance XAnnD       (GhcPass _) = NoExt
type instance XRuleD      (GhcPass _) = NoExt
type instance XVectD      (GhcPass _) = NoExt
type instance XSpliceD    (GhcPass _) = NoExt
type instance XDocD       (GhcPass _) = NoExt
type instance XRoleAnnotD (GhcPass _) = NoExt
type instance XXHsDecl    (GhcPass _) = NoExt
166 167

-- NB: all top-level fixity decls are contained EITHER
168
-- EITHER SigDs
169 170 171
-- OR     in the ClassDecls in TyClDs
--
-- The former covers
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
172 173 174 175 176
--      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
177 178
--
-- The latter is for class methods only
179

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

190
        hs_tyclds :: [TyClGroup p],
191 192
                -- 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
193 194
                -- Parser generates a singleton list;
                -- renamer does dependency analysis
195

196
        hs_derivds :: [LDerivDecl p],
197

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

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

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

type instance XCHsGroup (GhcPass _) = NoExt
type instance XXHsGroup (GhcPass _) = NoExt
215

216 217

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

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

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

233 234
appendGroups :: HsGroup (GhcPass p) -> HsGroup (GhcPass p)
             -> HsGroup (GhcPass p)
235 236
appendGroups
    HsGroup {
237
        hs_valds  = val_groups1,
238
        hs_splcds = spliceds1,
239
        hs_tyclds = tyclds1,
240
        hs_derivds = derivds1,
241
        hs_fixds  = fixds1,
242 243
        hs_defds  = defds1,
        hs_annds  = annds1,
244
        hs_fords  = fords1,
245 246 247
        hs_warnds = warnds1,
        hs_ruleds = rulds1,
        hs_vects = vects1,
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 261
        hs_warnds = warnds2,
        hs_ruleds = rulds2,
        hs_vects  = vects2,
        hs_docs   = docs2 }
262 263
  =
    HsGroup {
264
        hs_ext    = noExt,
265
        hs_valds  = val_groups1 `plusHsValBinds` val_groups2,
266 267
        hs_splcds = spliceds1 ++ spliceds2,
        hs_tyclds = tyclds1 ++ tyclds2,
268
        hs_derivds = derivds1 ++ derivds2,
269 270 271
        hs_fixds  = fixds1 ++ fixds2,
        hs_annds  = annds1 ++ annds2,
        hs_defds  = defds1 ++ defds2,
272
        hs_fords  = fords1 ++ fords2,
273 274 275 276
        hs_warnds = warnds1 ++ warnds2,
        hs_ruleds = rulds1 ++ rulds2,
        hs_vects  = vects1 ++ vects2,
        hs_docs   = docs1  ++ docs2 }
277
appendGroups _ _ = panic "appendGroups"
278

279
instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsDecl p) where
280 281 282 283 284 285 286 287 288 289 290 291 292 293 294
    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
    ppr (RuleD _ rd)              = ppr rd
    ppr (VectD _ vect)            = ppr vect
    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
295

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

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

331
-- | Located Splice Declaration
332
type LSpliceDecl pass = Located (SpliceDecl pass)
333 334

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

type instance XSpliceDecl      (GhcPass _) = NoExt
type instance XXSpliceDecl     (GhcPass _) = NoExt
344

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

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

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

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

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

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:
382
 - Ensure they "point to" the parent data/class decl
383
   when loading that decl from an interface file
384 385 386 387 388
   (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
389

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

393 394 395 396 397 398
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
399 400
   the ClassOpSig (in HsBinds), in the DefMethInfo field.
   (DefMethInfo is defined in Class.hs)
401 402 403 404 405 406 407

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:
408

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

 - The renamer renames it to a Name

414
 - During typechecking, we generate a binding for each $dm for
415
   which there's a programmer-supplied default method:
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
416 417 418 419
        class Foo a where
          op1 :: <type>
          op2 :: <type>
          op1 = ...
420
   We generate a binding for $dmop1 but not for $dmop2.
421 422
   The Class for Foo has a Nothing for op2 and
                         a Just ($dm_op1, VanillaDM) for op1.
423 424 425 426 427
   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
428 429 430
        class Foo a where
          op1 = :: <type>       -- NB the '='
          op2   :: <type>
431 432 433 434 435
    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
436
    the binding for $dmop1 will be sucked in.  (See RnHsSyn.tyClDeclFVs)
437 438 439 440 441 442 443 444 445 446 447 448 449 450
    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
451 452
        instance {Eq Int} = dEqInt
        dEqInt :: {Eq Int} <pragma info>
453 454 455 456 457 458 459 460 461 462 463

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').

464
  - The occurrence name it chooses is derived from the instance decl (just for
465 466
    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
467 468
        instance Foo [Int]  where ...
        instance Foo [Bool] where ...
469 470
    These might both be dFooList

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

474
  - We can take this relaxed approach (changing the occurrence name later)
475 476 477 478 479 480 481 482 483
    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.
484

485 486
  - 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
487
-}
488

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

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

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

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

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

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

    -- For details on above see note [Api annotations] in ApiAnnotation
530 531
    DataDecl { tcdDExt     :: XDataDecl pass -- ^ Post renamer, CUSK flag, FVs
             , tcdLName    :: Located (IdP pass) -- ^ Type constructor
532 533 534 535 536 537 538 539
             , tcdTyVars   :: LHsQTyVars pass  -- ^ Type variables; for an
                                               -- associated type
                                               --   these include outer binders
                                               -- Eg  class T a where
                                               --       type F a :: *
                                               --       type F a = a -> a
                                               -- Here the type decl for 'f'
                                               -- includes 'a' in its tcdTyVars
540 541
             , tcdFixity   :: LexicalFixity -- ^ Fixity used in the declaration
             , tcdDataDefn :: HsDataDefn pass }
542

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

564
        -- For details on above see note [Api annotations] in ApiAnnotation
565 566 567 568 569 570
  | XTyClDecl (XXTyClDecl pass)

data DataDeclRn = DataDeclRn
             { tcdDataCusk :: Bool    -- ^ does this have a CUSK?
             , tcdFVs      :: NameSet }
  deriving Data
571

572 573 574 575 576 577 578 579 580 581 582 583 584 585 586
type instance XFamDecl      (GhcPass _) = NoExt

type instance XSynDecl      GhcPs = NoExt
type instance XSynDecl      GhcRn = NameSet -- FVs
type instance XSynDecl      GhcTc = NameSet -- FVs

type instance XDataDecl     GhcPs = NoExt
type instance XDataDecl     GhcRn = DataDeclRn
type instance XDataDecl     GhcTc = DataDeclRn

type instance XClassDecl    GhcPs = NoExt
type instance XClassDecl    GhcRn = NameSet -- FVs
type instance XClassDecl    GhcTc = NameSet -- FVs

type instance XXTyClDecl    (GhcPass _) = NoExt
587

Jan Stolarek's avatar
Jan Stolarek committed
588 589
-- Simple classifiers for TyClDecl
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
590

591
-- | @True@ <=> argument is a @data@\/@newtype@
592
-- declaration.
593
isDataDecl :: TyClDecl pass -> Bool
594 595
isDataDecl (DataDecl {}) = True
isDataDecl _other        = False
596

597
-- | type or type instance declaration
598
isSynDecl :: TyClDecl pass -> Bool
599 600
isSynDecl (SynDecl {})   = True
isSynDecl _other        = False
601

602
-- | type class
603
isClassDecl :: TyClDecl pass -> Bool
604
isClassDecl (ClassDecl {}) = True
605
isClassDecl _              = False
606

607
-- | type/data family declaration
608
isFamilyDecl :: TyClDecl pass -> Bool
609
isFamilyDecl (FamDecl {})  = True
610
isFamilyDecl _other        = False
611 612

-- | type family declaration
613
isTypeFamilyDecl :: TyClDecl pass -> Bool
614
isTypeFamilyDecl (FamDecl _ (FamilyDecl { fdInfo = info })) = case info of
615 616 617 618
  OpenTypeFamily      -> True
  ClosedTypeFamily {} -> True
  _                   -> False
isTypeFamilyDecl _ = False
619

620
-- | open type family info
621
isOpenTypeFamilyInfo :: FamilyInfo pass -> Bool
622 623 624 625
isOpenTypeFamilyInfo OpenTypeFamily = True
isOpenTypeFamilyInfo _              = False

-- | closed type family info
626
isClosedTypeFamilyInfo :: FamilyInfo pass -> Bool
627 628 629
isClosedTypeFamilyInfo (ClosedTypeFamily {}) = True
isClosedTypeFamilyInfo _                     = False

630
-- | data family declaration
631
isDataFamilyDecl :: TyClDecl pass -> Bool
632
isDataFamilyDecl (FamDecl _ (FamilyDecl { fdInfo = DataFamily })) = True
633
isDataFamilyDecl _other      = False
634

Austin Seipp's avatar
Austin Seipp committed
635
-- Dealing with names
636

637
tyFamInstDeclName :: TyFamInstDecl pass -> (IdP pass)
638 639
tyFamInstDeclName = unLoc . tyFamInstDeclLName

640
tyFamInstDeclLName :: TyFamInstDecl pass -> Located (IdP pass)
641
tyFamInstDeclLName (TyFamInstDecl { tfid_eqn =
642
                     (HsIB { hsib_body = FamEqn { feqn_tycon = ln }}) })
643
  = ln
644 645 646 647
tyFamInstDeclLName (TyFamInstDecl (HsIB _ (XFamEqn _)))
  = panic "tyFamInstDeclLName"
tyFamInstDeclLName (TyFamInstDecl (XHsImplicitBndrs _))
  = panic "tyFamInstDeclLName"
648

649
tyClDeclLName :: TyClDecl pass -> Located (IdP pass)
650 651
tyClDeclLName (FamDecl { tcdFam = FamilyDecl { fdLName = ln } }) = ln
tyClDeclLName decl = tcdLName decl
652

653
tcdName :: TyClDecl pass -> (IdP pass)
654 655
tcdName = unLoc . tyClDeclLName

656
tyClDeclTyVars :: TyClDecl pass -> LHsQTyVars pass
657 658
tyClDeclTyVars (FamDecl { tcdFam = FamilyDecl { fdTyVars = tvs } }) = tvs
tyClDeclTyVars d = tcdTyVars d
659

660
countTyClDecls :: [TyClDecl pass] -> (Int, Int, Int, Int, Int)
661
        -- class, synonym decls, data, newtype, family decls
662
countTyClDecls decls
663 664 665 666
 = (count isClassDecl    decls,
    count isSynDecl      decls,  -- excluding...
    count isDataTy       decls,  -- ...family...
    count isNewTy        decls,  -- ...instances
667
    count isFamilyDecl   decls)
sof's avatar
sof committed
668
 where
669 670
   isDataTy DataDecl{ tcdDataDefn = HsDataDefn { dd_ND = DataType } } = True
   isDataTy _                                                       = False
671

672 673
   isNewTy DataDecl{ tcdDataDefn = HsDataDefn { dd_ND = NewType } } = True
   isNewTy _                                                      = False
674 675 676

-- | Does this declaration have a complete, user-supplied kind signature?
-- See Note [Complete user-supplied kind signatures]
677
hsDeclHasCusk :: TyClDecl GhcRn -> Bool
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
678
hsDeclHasCusk (FamDecl { tcdFam = fam_decl }) = famDeclHasCusk Nothing fam_decl
679
hsDeclHasCusk (SynDecl { tcdTyVars = tyvars, tcdRhs = rhs })
680
  -- NB: Keep this synchronized with 'getInitialKind'
681 682 683
  = hsTvbAllKinded tyvars && rhs_annotated rhs
  where
    rhs_annotated (L _ ty) = case ty of
684 685 686
      HsParTy _ lty  -> rhs_annotated lty
      HsKindSig {}   -> True
      _              -> False
687
hsDeclHasCusk (DataDecl { tcdDExt = DataDeclRn { tcdDataCusk = cusk }}) = cusk
688
hsDeclHasCusk (ClassDecl { tcdTyVars = tyvars }) = hsTvbAllKinded tyvars
689
hsDeclHasCusk (XTyClDecl _) = panic "hsDeclHasCusk"
690

Jan Stolarek's avatar
Jan Stolarek committed
691 692
-- Pretty-printing TyClDecl
-- ~~~~~~~~~~~~~~~~~~~~~~~~
693

694
instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (TyClDecl p) where
695

696
    ppr (FamDecl { tcdFam = decl }) = ppr decl
697 698
    ppr (SynDecl { tcdLName = ltycon, tcdTyVars = tyvars, tcdFixity = fixity
                 , tcdRhs = rhs })
699
      = hang (text "type" <+>
700
              pp_vanilla_decl_head ltycon tyvars fixity [] <+> equals)
701
          4 (ppr rhs)
702

703 704 705
    ppr (DataDecl { tcdLName = ltycon, tcdTyVars = tyvars, tcdFixity = fixity
                  , tcdDataDefn = defn })
      = pp_data_defn (pp_vanilla_decl_head ltycon tyvars fixity) defn
706

707
    ppr (ClassDecl {tcdCtxt = context, tcdLName = lclas, tcdTyVars = tyvars,
708
                    tcdFixity = fixity,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
709
                    tcdFDs  = fds,
710 711 712
                    tcdSigs = sigs, tcdMeths = methods,
                    tcdATs = ats, tcdATDefs = at_defs})
      | null sigs && isEmptyBag methods && null ats && null at_defs -- No "where" part
713 714
      = top_matter

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
715
      | otherwise       -- Laid out
716
      = vcat [ top_matter <+> text "where"
717
             , nest 2 $ pprDeclList (map (pprFamilyDecl NotTopLevel . unLoc) ats ++
718
                                     map ppr_fam_deflt_eqn at_defs ++
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
719
                                     pprLHsBindsForUser methods sigs) ]
720
      where
721
        top_matter = text "class"
722 723
                    <+> pp_vanilla_decl_head lclas tyvars fixity (unLoc context)
                    <+> pprFundeps (map unLoc fds)
724
    ppr (XTyClDecl x) = ppr x
725

726 727
instance (p ~ GhcPass pass, OutputableBndrId p)
       => Outputable (TyClGroup p) where
728 729 730 731 732
  ppr (TyClGroup { group_tyclds = tyclds
                 , group_roles = roles
                 , group_instds = instds
                 }
      )
733
    = ppr tyclds $$
734 735
      ppr roles $$
      ppr instds
736
  ppr (XTyClGroup x) = ppr x
737

738 739 740
pp_vanilla_decl_head :: (OutputableBndrId (GhcPass p))
   => Located (IdP (GhcPass p))
   -> LHsQTyVars (GhcPass p)
741
   -> LexicalFixity
742
   -> HsContext (GhcPass p)
Jan Stolarek's avatar
Jan Stolarek committed
743
   -> SDoc
744
pp_vanilla_decl_head thing (HsQTvs { hsq_explicit = tyvars }) fixity context
Alan Zimmerman's avatar
Alan Zimmerman committed
745 746 747
 = hsep [pprHsContext context, pp_tyvars tyvars]
  where
    pp_tyvars (varl:varsr)
748 749 750 751
      | fixity == Infix && length varsr > 1
         = hsep [char '(',ppr (unLoc varl), pprInfixOcc (unLoc thing)
                , (ppr.unLoc) (head varsr), char ')'
                , hsep (map (ppr.unLoc) (tail varsr))]
752
      | fixity == Infix
Alan Zimmerman's avatar
Alan Zimmerman committed
753 754 755 756 757
         = hsep [ppr (unLoc varl), pprInfixOcc (unLoc thing)
         , hsep (map (ppr.unLoc) varsr)]
      | otherwise = hsep [ pprPrefixOcc (unLoc thing)
                  , hsep (map (ppr.unLoc) (varl:varsr))]
    pp_tyvars [] = ppr thing
758
pp_vanilla_decl_head _ (XLHsQTyVars x) _ _ = ppr x
Jan Stolarek's avatar
Jan Stolarek committed
759

760
pprTyClDeclFlavour :: TyClDecl (GhcPass p) -> SDoc
761 762
pprTyClDeclFlavour (ClassDecl {})   = text "class"
pprTyClDeclFlavour (SynDecl {})     = text "type"
Jan Stolarek's avatar
Jan Stolarek committed
763
pprTyClDeclFlavour (FamDecl { tcdFam = FamilyDecl { fdInfo = info }})
764
  = pprFlavour info <+> text "family"
765 766
pprTyClDeclFlavour (FamDecl { tcdFam = XFamilyDecl x})
  = ppr x
Jan Stolarek's avatar
Jan Stolarek committed
767 768
pprTyClDeclFlavour (DataDecl { tcdDataDefn = HsDataDefn { dd_ND = nd } })
  = ppr nd
769 770 771
pprTyClDeclFlavour (DataDecl { tcdDataDefn = XHsDataDefn x })
  = ppr x
pprTyClDeclFlavour (XTyClDecl x) = ppr x
Jan Stolarek's avatar
Jan Stolarek committed
772 773


774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836
{- Note [Complete user-supplied kind signatures]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We kind-check declarations differently if they have a complete, user-supplied
kind signature (CUSK). This is because we can safely generalise a CUSKed
declaration before checking all of the others, supporting polymorphic recursion.
See ghc.haskell.org/trac/ghc/wiki/GhcKinds/KindInference#Proposednewstrategy
and #9200 for lots of discussion of how we got here.

A declaration has a CUSK if we can know its complete kind without doing any
inference, at all. Here are the rules:

 - A class or datatype is said to have a CUSK if and only if all of its type
variables are annotated. Its result kind is, by construction, Constraint or *
respectively.

 - A type synonym has a CUSK if and only if all of its type variables and its
RHS are annotated with kinds.

 - A closed type family is said to have a CUSK if and only if all of its type
variables and its return type are annotated.

 - An open type family always has a CUSK -- unannotated type variables (and
return type) default to *.

 - Additionally, if -XTypeInType is on, then a data definition with a top-level
   :: must explicitly bind all kind variables to the right of the ::.
   See test dependent/should_compile/KindLevels, which requires this case.
   (Naturally, any kind variable mentioned before the :: should not be bound
   after it.)
-}


{- *********************************************************************
*                                                                      *
                         TyClGroup
        Strongly connected components of
      type, class, instance, and role declarations
*                                                                      *
********************************************************************* -}

{- Note [TyClGroups and dependency analysis]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
A TyClGroup represents a strongly connected components of type/class/instance
decls, together with the role annotations for the type/class declarations.

The hs_tyclds :: [TyClGroup] field of a HsGroup is a dependency-order
sequence of strongly-connected components.

Invariants
 * The type and class declarations, group_tyclds, may depend on each
   other, or earlier TyClGroups, but not on later ones

 * The role annotations, group_roles, are role-annotations for some or
   all of the types and classes in group_tyclds (only).

 * The instance declarations, group_instds, may (and usually will)
   depend on group_tyclds, or on earlier TyClGroups, but not on later
   ones.

See Note [Dependency analsis of type, class, and instance decls]
in RnSource for more info.
-}

837
-- | Type or Class Group
838
data TyClGroup pass  -- See Note [TyClGroups and dependency analysis]
839 840
  = TyClGroup { group_ext    :: XCTyClGroup pass
              , group_tyclds :: [LTyClDecl pass]
841 842
              , group_roles  :: [LRoleAnnotDecl pass]
              , group_instds :: [LInstDecl pass] }
843
  | XTyClGroup (XXTyClGroup pass)
844

845 846 847 848 849 850
type instance XCTyClGroup (GhcPass _) = NoExt
type instance XXTyClGroup (GhcPass _) = NoExt


emptyTyClGroup :: TyClGroup (GhcPass p)
emptyTyClGroup = TyClGroup noExt [] [] []
851

852
tyClGroupTyClDecls :: [TyClGroup pass] -> [LTyClDecl pass]
853 854
tyClGroupTyClDecls = concatMap group_tyclds

855
tyClGroupInstDecls :: [TyClGroup pass] -> [LInstDecl pass]
856 857
tyClGroupInstDecls = concatMap group_instds

858
tyClGroupRoleDecls :: [TyClGroup pass] -> [LRoleAnnotDecl pass]
859 860
tyClGroupRoleDecls = concatMap group_roles

861 862
mkTyClGroup :: [LTyClDecl (GhcPass p)] -> [LInstDecl (GhcPass p)]
            -> TyClGroup (GhcPass p)
863
mkTyClGroup decls instds = TyClGroup
864 865
  { group_ext = noExt
  , group_tyclds = decls
866 867 868 869 870 871
  , group_roles = []
  , group_instds = instds
  }



Jan Stolarek's avatar
Jan Stolarek committed
872 873 874 875 876 877
{- *********************************************************************
*                                                                      *
               Data and type family declarations
*                                                                      *
********************************************************************* -}

878 879
{- Note [FamilyResultSig]
~~~~~~~~~~~~~~~~~~~~~~~~~
Jan Stolarek's avatar
Jan Stolarek committed
880

881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916