HsDecls.hs 85 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 FlexibleInstances #-}
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,
Ryan Scott's avatar
Ryan Scott committed
22
  HsDerivingClause(..), LHsDerivingClause,
23

24
  -- ** Class or type declarations
25
  TyClDecl(..), LTyClDecl,
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, NewOrData(..), 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
Alan Zimmerman's avatar
Alan Zimmerman committed
49
  LRuleDecls,RuleDecls(..),RuleDecl(..), LRuleDecl, RuleBndr(..),LRuleBndr,
50
  collectRuleBndrSigTys,
51
  flattenRuleDecls, pprFullRuleName,
52 53
  -- ** @VECTORISE@ declarations
  VectDecl(..), LVectDecl,
54
  lvectDeclName, lvectInstDecl,
55 56
  -- ** @default@ declarations
  DefaultDecl(..), LDefaultDecl,
57
  -- ** Template haskell declaration splice
58
  SpliceExplicitFlag(..),
59
  SpliceDecl(..), LSpliceDecl,
60 61
  -- ** Foreign function interface declarations
  ForeignDecl(..), LForeignDecl, ForeignImport(..), ForeignExport(..),
62
  noForeignImportCoercionYet, noForeignExportCoercionYet,
63
  CImportSpec(..),
64
  -- ** Data-constructor declarations
Alan Zimmerman's avatar
Alan Zimmerman committed
65
  ConDecl(..), LConDecl,
66
  HsConDeclDetails, hsConDeclArgTys,
Alan Zimmerman's avatar
Alan Zimmerman committed
67 68 69
  getConNames,
  getConDetails,
  gadtDeclDetails,
70 71 72 73
  -- ** Document comments
  DocDecl(..), LDocDecl, docDeclDoc,
  -- ** Deprecations
  WarnDecl(..),  LWarnDecl,
Alan Zimmerman's avatar
Alan Zimmerman committed
74
  WarnDecls(..), LWarnDecls,
75
  -- ** Annotations
76
  AnnDecl(..), LAnnDecl,
77
  AnnProvenance(..), annProvenanceName_maybe,
78 79
  -- ** Role annotations
  RoleAnnotDecl(..), LRoleAnnotDecl, roleAnnotDeclName,
Jan Stolarek's avatar
Jan Stolarek committed
80 81 82
  -- ** Injective type families
  FamilyResultSig(..), LFamilyResultSig, InjectivityAnn(..), LInjectivityAnn,
  resultVariableName,
83 84

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

87
    ) where
88 89

-- friends:
90 91
import GhcPrelude

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

96
import HsBinds
97
import HsTypes
98
import HsDoc
99
import TyCon
100
import Name
101
import BasicTypes
102
import Coercion
103
import ForeignCall
104 105
import PlaceHolder ( PlaceHolder(..) )
import HsExtension
106
import NameSet
107 108

-- others:
109
import InstEnv
110
import Class
111
import Outputable
112 113 114
import Util
import SrcLoc

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

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

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

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

135
-- | A Haskell Declaration
136
data HsDecl id
137 138 139 140 141 142 143 144 145 146 147 148 149 150 151
  = TyClD       (TyClDecl id)      -- ^ Type or Class Declaration
  | InstD       (InstDecl  id)     -- ^ Instance declaration
  | DerivD      (DerivDecl id)     -- ^ Deriving declaration
  | ValD        (HsBind id)        -- ^ Value declaration
  | SigD        (Sig id)           -- ^ Signature declaration
  | DefD        (DefaultDecl id)   -- ^ 'default' declaration
  | ForD        (ForeignDecl id)   -- ^ Foreign declaration
  | WarningD    (WarnDecls id)     -- ^ Warning declaration
  | AnnD        (AnnDecl id)       -- ^ Annotation declaration
  | RuleD       (RuleDecls id)     -- ^ Rule declaration
  | VectD       (VectDecl id)      -- ^ Vectorise declaration
  | SpliceD     (SpliceDecl id)    -- ^ Splice declaration
                                   -- (Includes quasi-quotes)
  | DocD        (DocDecl)          -- ^ Documentation comment declaration
  | RoleAnnotD  (RoleAnnotDecl id) -- ^ Role annotation declaration
152
deriving instance (DataId id) => Data (HsDecl id)
153

154 155

-- NB: all top-level fixity decls are contained EITHER
156
-- EITHER SigDs
157 158 159
-- OR     in the ClassDecls in TyClDs
--
-- The former covers
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
160 161 162 163 164
--      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
165 166
--
-- The latter is for class methods only
167

168 169 170
-- | Haskell Group
--
-- A 'HsDecl' is categorised into a 'HsGroup' before being
171 172 173
-- fed to the renamer.
data HsGroup id
  = HsGroup {
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
174
        hs_valds  :: HsValBinds id,
175
        hs_splcds :: [LSpliceDecl id],
176

177
        hs_tyclds :: [TyClGroup id],
178 179
                -- 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
180 181
                -- Parser generates a singleton list;
                -- renamer does dependency analysis
182

183
        hs_derivds :: [LDerivDecl id],
184

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
185 186 187
        hs_fixds  :: [LFixitySig id],
                -- Snaffled out of both top-level fixity signatures,
                -- and those in class declarations
188

189 190
        hs_defds  :: [LDefaultDecl id],
        hs_fords  :: [LForeignDecl id],
Alan Zimmerman's avatar
Alan Zimmerman committed
191
        hs_warnds :: [LWarnDecls id],
192
        hs_annds  :: [LAnnDecl id],
Alan Zimmerman's avatar
Alan Zimmerman committed
193
        hs_ruleds :: [LRuleDecls id],
194
        hs_vects  :: [LVectDecl id],
195

196
        hs_docs   :: [LDocDecl]
197
  }
198
deriving instance (DataIdLR id id) => Data (HsGroup id)
199

200 201 202 203
emptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup a
emptyRdrGroup = emptyGroup { hs_valds = emptyValBindsIn }
emptyRnGroup  = emptyGroup { hs_valds = emptyValBindsOut }

204 205 206 207
hsGroupInstDecls :: HsGroup id -> [LInstDecl id]
hsGroupInstDecls = (=<<) group_instds . hs_tyclds

emptyGroup = HsGroup { hs_tyclds = [],
208
                       hs_derivds = [],
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
209 210 211
                       hs_fixds = [], hs_defds = [], hs_annds = [],
                       hs_fords = [], hs_warnds = [], hs_ruleds = [], hs_vects = [],
                       hs_valds = error "emptyGroup hs_valds: Can't happen",
212
                       hs_splcds = [],
213
                       hs_docs = [] }
214

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

259 260
instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
       => Outputable (HsDecl (GhcPass p)) where
261 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
    ppr (RuleD rd)              = ppr rd
269
    ppr (VectD vect)            = ppr vect
Ian Lynagh's avatar
Ian Lynagh committed
270
    ppr (WarningD wd)           = ppr wd
271
    ppr (AnnD ad)               = ppr ad
272 273
    ppr (SpliceD dd)            = ppr dd
    ppr (DocD doc)              = ppr doc
274
    ppr (RoleAnnotD ra)         = ppr ra
275

276 277
instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass 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 286 287
                   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 })
288 289
        = vcat_mb empty
            [ppr_ds fix_decls, ppr_ds default_decls,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
290 291 292
             ppr_ds deprec_decls, ppr_ds ann_decls,
             ppr_ds rule_decls,
             ppr_ds vect_decls,
293 294
             if isEmptyValBinds val_decls
                then Nothing
295
                else Just (ppr val_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
-- | Located Splice Declaration
312
type LSpliceDecl pass = Located (SpliceDecl pass)
313 314

-- | Splice Declaration
315
data SpliceDecl id
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
316
  = SpliceDecl                  -- Top level splice
317
        (Located (HsSplice id))
318
        SpliceExplicitFlag
319
deriving instance (DataId id) => Data (SpliceDecl id)
320

321 322
instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
       => Outputable (SpliceDecl (GhcPass p)) where
Alan Zimmerman's avatar
Alan Zimmerman committed
323
   ppr (SpliceDecl (L _ e) f) = pprSpliceDecl e f
324

Austin Seipp's avatar
Austin Seipp committed
325 326 327
{-
************************************************************************
*                                                                      *
328
            Type and class declarations
Austin Seipp's avatar
Austin Seipp committed
329 330
*                                                                      *
************************************************************************
331

332 333
Note [The Naming story]
~~~~~~~~~~~~~~~~~~~~~~~
334 335
Here is the story about the implicit names that go with type, class,
and instance decls.  It's a bit tricky, so pay attention!
336 337 338

"Implicit" (or "system") binders
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
339
  Each data type decl defines
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
340 341
        a worker name for each constructor
        to-T and from-T convertors
342
  Each class decl defines
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
343 344 345 346
        a tycon for the class
        a data constructor for that tycon
        the worker for that constructor
        a selector for each superclass
347

348 349
All have occurrence names that are derived uniquely from their parent
declaration.
350 351 352 353 354 355 356

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:
357
 - Ensure they "point to" the parent data/class decl
358
   when loading that decl from an interface file
359 360 361 362 363
   (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
364

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

368 369 370 371 372 373
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
374 375
   the ClassOpSig (in HsBinds), in the DefMethInfo field.
   (DefMethInfo is defined in Class.hs)
376 377 378 379 380 381 382

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

384 385 386 387 388
 - When parsing, every ClassOpSig gets a DefMeth with a suitable RdrName
   This is done by RdrHsSyn.mkClassOpSigDM

 - The renamer renames it to a Name

389
 - During typechecking, we generate a binding for each $dm for
390
   which there's a programmer-supplied default method:
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
391 392 393 394
        class Foo a where
          op1 :: <type>
          op2 :: <type>
          op1 = ...
395
   We generate a binding for $dmop1 but not for $dmop2.
396 397
   The Class for Foo has a Nothing for op2 and
                         a Just ($dm_op1, VanillaDM) for op1.
398 399 400 401 402
   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
403 404 405
        class Foo a where
          op1 = :: <type>       -- NB the '='
          op2   :: <type>
406 407 408 409 410
    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
411
    the binding for $dmop1 will be sucked in.  (See RnHsSyn.tyClDeclFVs)
412 413 414 415 416 417 418 419 420 421 422 423 424 425
    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
426 427
        instance {Eq Int} = dEqInt
        dEqInt :: {Eq Int} <pragma info>
428 429 430 431 432 433 434 435 436 437 438

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

439
  - The occurrence name it chooses is derived from the instance decl (just for
440 441
    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
442 443
        instance Foo [Int]  where ...
        instance Foo [Bool] where ...
444 445
    These might both be dFooList

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

449
  - We can take this relaxed approach (changing the occurrence name later)
450 451 452 453 454 455 456 457 458
    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.
459

460 461
  - 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
462
-}
463

464
-- | Located Declaration of a Type or Class
465
type LTyClDecl pass = Located (TyClDecl pass)
466

467
-- | A type or class declaration.
468
data TyClDecl pass
Yuras's avatar
Yuras committed
469
  = -- | @type/data family T :: *->*@
Alan Zimmerman's avatar
Alan Zimmerman committed
470 471 472
    --
    --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',
    --             'ApiAnnotation.AnnData',
473
    --             'ApiAnnotation.AnnFamily','ApiAnnotation.AnnDcolon',
Jan Stolarek's avatar
Jan Stolarek committed
474 475 476 477
    --             'ApiAnnotation.AnnWhere','ApiAnnotation.AnnOpenP',
    --             'ApiAnnotation.AnnDcolon','ApiAnnotation.AnnCloseP',
    --             'ApiAnnotation.AnnEqual','ApiAnnotation.AnnRarrow',
    --             'ApiAnnotation.AnnVbar'
Alan Zimmerman's avatar
Alan Zimmerman committed
478

479
    -- For details on above see note [Api annotations] in ApiAnnotation
480
    FamDecl { tcdFam :: FamilyDecl pass }
481

482
  | -- | @type@ declaration
Alan Zimmerman's avatar
Alan Zimmerman committed
483 484 485
    --
    --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',
    --             'ApiAnnotation.AnnEqual',
486 487

    -- For details on above see note [Api annotations] in ApiAnnotation
488 489 490 491
    SynDecl { tcdLName  :: Located (IdP pass)     -- ^ Type constructor
            , tcdTyVars :: LHsQTyVars pass        -- ^ Type variables; for an
                                                  -- associated type these
                                                  -- include outer binders
492
            , tcdFixity :: LexicalFixity    -- ^ Fixity used in the declaration
493 494
            , tcdRhs    :: LHsType pass           -- ^ RHS of type declaration
            , tcdFVs    :: PostRn pass NameSet }
495 496

  | -- | @data@ declaration
Alan Zimmerman's avatar
Alan Zimmerman committed
497 498 499 500
    --
    --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnData',
    --              'ApiAnnotation.AnnFamily',
    --              'ApiAnnotation.AnnNewType',
501 502
    --              'ApiAnnotation.AnnNewType','ApiAnnotation.AnnDcolon'
    --              'ApiAnnotation.AnnWhere',
503 504

    -- For details on above see note [Api annotations] in ApiAnnotation
505 506 507 508 509 510 511 512 513
    DataDecl { tcdLName    :: Located (IdP pass) -- ^ Type constructor
             , 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
514
             , tcdFixity  :: LexicalFixity -- ^ Fixity used in the declaration
515 516 517
             , tcdDataDefn :: HsDataDefn pass
             , tcdDataCusk :: PostRn pass Bool    -- ^ does this have a CUSK?
             , tcdFVs      :: PostRn pass NameSet }
518

519 520 521
  | ClassDecl { tcdCtxt    :: LHsContext pass,         -- ^ Context...
                tcdLName   :: Located (IdP pass),      -- ^ Name of the class
                tcdTyVars  :: LHsQTyVars pass,         -- ^ Class type variables
522
                tcdFixity  :: LexicalFixity, -- ^ Fixity used in the declaration
523
                tcdFDs     :: [Located (FunDep (Located (IdP pass)))],
Alan Zimmerman's avatar
Alan Zimmerman committed
524
                                                        -- ^ Functional deps
525 526 527 528 529
                tcdSigs    :: [LSig pass],              -- ^ Methods' signatures
                tcdMeths   :: LHsBinds pass,            -- ^ Default methods
                tcdATs     :: [LFamilyDecl pass],       -- ^ Associated types;
                tcdATDefs  :: [LTyFamDefltEqn pass],
                                                   -- ^ Associated type defaults
530
                tcdDocs    :: [LDocDecl],               -- ^ Haddock docs
531
                tcdFVs     :: PostRn pass NameSet
532
    }
Alan Zimmerman's avatar
Alan Zimmerman committed
533 534 535 536 537 538
        -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnClass',
        --           'ApiAnnotation.AnnWhere','ApiAnnotation.AnnOpen',
        --           'ApiAnnotation.AnnClose'
        --   - The tcdFDs will have 'ApiAnnotation.AnnVbar',
        --                          'ApiAnnotation.AnnComma'
        --                          'ApiAnnotation.AnnRarrow'
539

540 541
        -- For details on above see note [Api annotations] in ApiAnnotation

542
deriving instance (DataId id) => Data (TyClDecl id)
543

544

Jan Stolarek's avatar
Jan Stolarek committed
545 546
-- Simple classifiers for TyClDecl
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
547

548
-- | @True@ <=> argument is a @data@\/@newtype@
549
-- declaration.
550
isDataDecl :: TyClDecl pass -> Bool
551 552
isDataDecl (DataDecl {}) = True
isDataDecl _other        = False
553

554
-- | type or type instance declaration
555
isSynDecl :: TyClDecl pass -> Bool
556 557
isSynDecl (SynDecl {})   = True
isSynDecl _other        = False
558

559
-- | type class
560
isClassDecl :: TyClDecl pass -> Bool
561
isClassDecl (ClassDecl {}) = True
562
isClassDecl _              = False
563

564
-- | type/data family declaration
565
isFamilyDecl :: TyClDecl pass -> Bool
566
isFamilyDecl (FamDecl {})  = True
567
isFamilyDecl _other        = False
568 569

-- | type family declaration
570
isTypeFamilyDecl :: TyClDecl pass -> Bool
571 572 573 574 575
isTypeFamilyDecl (FamDecl (FamilyDecl { fdInfo = info })) = case info of
  OpenTypeFamily      -> True
  ClosedTypeFamily {} -> True
  _                   -> False
isTypeFamilyDecl _ = False
576

577
-- | open type family info
578
isOpenTypeFamilyInfo :: FamilyInfo pass -> Bool
579 580 581 582
isOpenTypeFamilyInfo OpenTypeFamily = True
isOpenTypeFamilyInfo _              = False

-- | closed type family info
583
isClosedTypeFamilyInfo :: FamilyInfo pass -> Bool
584 585 586
isClosedTypeFamilyInfo (ClosedTypeFamily {}) = True
isClosedTypeFamilyInfo _                     = False

587
-- | data family declaration
588
isDataFamilyDecl :: TyClDecl pass -> Bool
589
isDataFamilyDecl (FamDecl (FamilyDecl { fdInfo = DataFamily })) = True
590
isDataFamilyDecl _other      = False
591

Austin Seipp's avatar
Austin Seipp committed
592
-- Dealing with names
593

594
tyFamInstDeclName :: TyFamInstDecl pass -> (IdP pass)
595 596
tyFamInstDeclName = unLoc . tyFamInstDeclLName

597
tyFamInstDeclLName :: TyFamInstDecl pass -> Located (IdP pass)
598
tyFamInstDeclLName (TyFamInstDecl { tfid_eqn =
599
                     (HsIB { hsib_body = FamEqn { feqn_tycon = ln }}) })
600 601
  = ln

602
tyClDeclLName :: TyClDecl pass -> Located (IdP pass)
603 604
tyClDeclLName (FamDecl { tcdFam = FamilyDecl { fdLName = ln } }) = ln
tyClDeclLName decl = tcdLName decl
605

606
tcdName :: TyClDecl pass -> (IdP pass)
607 608
tcdName = unLoc . tyClDeclLName

609
tyClDeclTyVars :: TyClDecl pass -> LHsQTyVars pass
610 611
tyClDeclTyVars (FamDecl { tcdFam = FamilyDecl { fdTyVars = tvs } }) = tvs
tyClDeclTyVars d = tcdTyVars d
612

613
countTyClDecls :: [TyClDecl pass] -> (Int, Int, Int, Int, Int)
614
        -- class, synonym decls, data, newtype, family decls
615
countTyClDecls decls
616 617 618 619
 = (count isClassDecl    decls,
    count isSynDecl      decls,  -- excluding...
    count isDataTy       decls,  -- ...family...
    count isNewTy        decls,  -- ...instances
620
    count isFamilyDecl   decls)
sof's avatar
sof committed
621
 where
622 623
   isDataTy DataDecl{ tcdDataDefn = HsDataDefn { dd_ND = DataType } } = True
   isDataTy _                                                       = False
624

625 626
   isNewTy DataDecl{ tcdDataDefn = HsDataDefn { dd_ND = NewType } } = True
   isNewTy _                                                      = False
627 628 629

-- | Does this declaration have a complete, user-supplied kind signature?
-- See Note [Complete user-supplied kind signatures]
630
hsDeclHasCusk :: TyClDecl GhcRn -> Bool
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
631
hsDeclHasCusk (FamDecl { tcdFam = fam_decl }) = famDeclHasCusk Nothing fam_decl
632
hsDeclHasCusk (SynDecl { tcdTyVars = tyvars, tcdRhs = rhs })
633
  -- NB: Keep this synchronized with 'getInitialKind'
634 635 636
  = hsTvbAllKinded tyvars && rhs_annotated rhs
  where
    rhs_annotated (L _ ty) = case ty of
637 638 639
      HsParTy _ lty  -> rhs_annotated lty
      HsKindSig {}   -> True
      _              -> False
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
640
hsDeclHasCusk (DataDecl { tcdDataCusk = cusk }) = cusk
641 642
hsDeclHasCusk (ClassDecl { tcdTyVars = tyvars }) = hsTvbAllKinded tyvars

Jan Stolarek's avatar
Jan Stolarek committed
643 644
-- Pretty-printing TyClDecl
-- ~~~~~~~~~~~~~~~~~~~~~~~~
645

646 647
instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
       => Outputable (TyClDecl (GhcPass p)) where
648

649
    ppr (FamDecl { tcdFam = decl }) = ppr decl
650 651
    ppr (SynDecl { tcdLName = ltycon, tcdTyVars = tyvars, tcdFixity = fixity
                 , tcdRhs = rhs })
652
      = hang (text "type" <+>
653
              pp_vanilla_decl_head ltycon tyvars fixity [] <+> equals)
654
          4 (ppr rhs)
655

656 657 658
    ppr (DataDecl { tcdLName = ltycon, tcdTyVars = tyvars, tcdFixity = fixity
                  , tcdDataDefn = defn })
      = pp_data_defn (pp_vanilla_decl_head ltycon tyvars fixity) defn
659

660
    ppr (ClassDecl {tcdCtxt = context, tcdLName = lclas, tcdTyVars = tyvars,
661
                    tcdFixity = fixity,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
662
                    tcdFDs  = fds,
663 664 665
                    tcdSigs = sigs, tcdMeths = methods,
                    tcdATs = ats, tcdATDefs = at_defs})
      | null sigs && isEmptyBag methods && null ats && null at_defs -- No "where" part
666 667
      = top_matter

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
668
      | otherwise       -- Laid out
669
      = vcat [ top_matter <+> text "where"
670
             , nest 2 $ pprDeclList (map (pprFamilyDecl NotTopLevel . unLoc) ats ++
671
                                     map ppr_fam_deflt_eqn at_defs ++
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
672
                                     pprLHsBindsForUser methods sigs) ]
673
      where
674
        top_matter = text "class"
675 676
                    <+> pp_vanilla_decl_head lclas tyvars fixity (unLoc context)
                    <+> pprFundeps (map unLoc fds)
677

678 679
instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
       => Outputable (TyClGroup (GhcPass p)) where
680 681 682 683 684
  ppr (TyClGroup { group_tyclds = tyclds
                 , group_roles = roles
                 , group_instds = instds
                 }
      )
685
    = ppr tyclds $$
686 687
      ppr roles $$
      ppr instds
688

689 690 691
pp_vanilla_decl_head :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
   => Located (IdP (GhcPass p))
   -> LHsQTyVars (GhcPass p)
692
   -> LexicalFixity
693
   -> HsContext (GhcPass p)
Jan Stolarek's avatar
Jan Stolarek committed
694
   -> SDoc
695
pp_vanilla_decl_head thing (HsQTvs { hsq_explicit = tyvars }) fixity context
Alan Zimmerman's avatar
Alan Zimmerman committed
696 697 698
 = hsep [pprHsContext context, pp_tyvars tyvars]
  where
    pp_tyvars (varl:varsr)
699 700 701 702
      | fixity == Infix && length varsr > 1
         = hsep [char '(',ppr (unLoc varl), pprInfixOcc (unLoc thing)
                , (ppr.unLoc) (head varsr), char ')'
                , hsep (map (ppr.unLoc) (tail varsr))]
703
      | fixity == Infix
Alan Zimmerman's avatar
Alan Zimmerman committed
704 705 706 707 708
         = 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
Jan Stolarek's avatar
Jan Stolarek committed
709 710

pprTyClDeclFlavour :: TyClDecl a -> SDoc
711 712
pprTyClDeclFlavour (ClassDecl {})   = text "class"
pprTyClDeclFlavour (SynDecl {})     = text "type"
Jan Stolarek's avatar
Jan Stolarek committed
713
pprTyClDeclFlavour (FamDecl { tcdFam = FamilyDecl { fdInfo = info }})
714
  = pprFlavour info <+> text "family"
Jan Stolarek's avatar
Jan Stolarek committed
715 716 717 718
pprTyClDeclFlavour (DataDecl { tcdDataDefn = HsDataDefn { dd_ND = nd } })
  = ppr nd


719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781
{- 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.
-}

782
-- | Type or Class Group
783 784 785 786
data TyClGroup pass  -- See Note [TyClGroups and dependency analysis]
  = TyClGroup { group_tyclds :: [LTyClDecl pass]
              , group_roles  :: [LRoleAnnotDecl pass]
              , group_instds :: [LInstDecl pass] }
787 788
deriving instance (DataId id) => Data (TyClGroup id)

789
emptyTyClGroup :: TyClGroup pass
790 791
emptyTyClGroup = TyClGroup [] [] []

792
tyClGroupTyClDecls :: [TyClGroup pass] -> [LTyClDecl pass]
793 794
tyClGroupTyClDecls = concatMap group_tyclds

795
tyClGroupInstDecls :: [TyClGroup pass] -> [LInstDecl pass]
796 797
tyClGroupInstDecls = concatMap group_instds

798
tyClGroupRoleDecls :: [TyClGroup pass] -> [LRoleAnnotDecl pass]
799 800
tyClGroupRoleDecls = concatMap group_roles

801
mkTyClGroup :: [LTyClDecl pass] -> [LInstDecl pass] -> TyClGroup pass
802 803 804 805 806 807 808 809
mkTyClGroup decls instds = TyClGroup
  { group_tyclds = decls
  , group_roles = []
  , group_instds = instds
  }



Jan Stolarek's avatar
Jan Stolarek committed
810 811 812 813 814 815
{- *********************************************************************
*                                                                      *
               Data and type family declarations
*                                                                      *
********************************************************************* -}

816 817
{- Note [FamilyResultSig]
~~~~~~~~~~~~~~~~~~~~~~~~~
Jan Stolarek's avatar
Jan Stolarek committed
818

819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877
This data type represents the return signature of a type family.  Possible
values are:

 * NoSig - the user supplied no return signature:
      type family Id a where ...

 * KindSig - the user supplied the return kind:
      type family Id a :: * where ...

 * TyVarSig - user named the result with a type variable and possibly
   provided a kind signature for that variable:
      type family Id a = r where ...
      type family Id a = (r :: *) where ...

   Naming result of a type family is required if we want to provide
   injectivity annotation for a type family:
      type family Id a = r | r -> a where ...

See also: Note [Injectivity annotation]

Note [Injectivity annotation]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

A user can declare a type family to be injective:

   type family Id a = r | r -> a where ...

 * The part after the "|" is called "injectivity annotation".
 * "r -> a" part is called "injectivity condition"; at the moment terms
   "injectivity annotation" and "injectivity condition" are synonymous
   because we only allow a single injectivity condition.
 * "r" is the "LHS of injectivity condition". LHS can only contain the
   variable naming the result of a type family.

 * "a" is the "RHS of injectivity condition". RHS contains space-separated
   type and kind variables representing the arguments of a type
   family. Variables can be omitted if a type family is not injective in
   these arguments. Example:
         type family Foo a b c = d | d -> a c where ...

Note that:
 (a) naming of type family result is required to provide injectivity
     annotation
 (b) for associated types if the result was named then injectivity annotation
     is mandatory. Otherwise result type variable is indistinguishable from
     associated type default.

It is possible that in the future this syntax will be extended to support
more complicated injectivity annotations. For example we could declare that
if we know the result of Plus and one of its arguments we can determine the
other argument:

   type family Plus a b = (r :: Nat) | r a -> b, r b -> a where ...

Here injectivity annotation would consist of two comma-separated injectivity
conditions.

See also Note [Injective type families] in TyCon
-}
Jan Stolarek's avatar
Jan Stolarek committed
878

879
-- | Located type Family Result Signature