HsDecls.hs 81.7 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 40
  TyFamInstDecl(..), LTyFamInstDecl, instDeclDataFamInsts,
  DataFamInstDecl(..), LDataFamInstDecl, pprDataFamInstFlavour,
41
  TyFamEqn(..), TyFamInstEqn, LTyFamInstEqn, TyFamDefltEqn, LTyFamDefltEqn,
Alan Zimmerman's avatar
Alan Zimmerman committed
42
  HsTyPats,
43
  LClsInstDecl, ClsInstDecl(..),
44

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

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

86
    ) where
87 88

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

93
import HsBinds
94
import HsTypes
95
import HsDoc
96
import TyCon
97
import Name
98
import BasicTypes
99
import Coercion
100
import ForeignCall
101
import PlaceHolder ( PostTc,PostRn,PlaceHolder(..),DataId, OutputableBndrId )
102
import NameSet
103 104

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

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

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

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

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

131
-- | A Haskell Declaration
132
data HsDecl id
133 134 135 136 137 138 139 140 141 142 143 144 145 146 147
  = 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
148
deriving instance (DataId id) => Data (HsDecl id)
149

150 151

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

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

173
        hs_tyclds :: [TyClGroup id],
174 175
                -- 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
176 177
                -- Parser generates a singleton list;
                -- renamer does dependency analysis
178

179
        hs_derivds :: [LDerivDecl id],
180

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

185 186
        hs_defds  :: [LDefaultDecl id],
        hs_fords  :: [LForeignDecl id],
Alan Zimmerman's avatar
Alan Zimmerman committed
187
        hs_warnds :: [LWarnDecls id],
188
        hs_annds  :: [LAnnDecl id],
Alan Zimmerman's avatar
Alan Zimmerman committed
189
        hs_ruleds :: [LRuleDecls id],
190
        hs_vects  :: [LVectDecl id],
191

192
        hs_docs   :: [LDocDecl]
193
  }
194
deriving instance (DataId id) => Data (HsGroup id)
195

196 197 198 199
emptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup a
emptyRdrGroup = emptyGroup { hs_valds = emptyValBindsIn }
emptyRnGroup  = emptyGroup { hs_valds = emptyValBindsOut }

200 201 202 203
hsGroupInstDecls :: HsGroup id -> [LInstDecl id]
hsGroupInstDecls = (=<<) group_instds . hs_tyclds

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

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

254
instance (OutputableBndrId name) => Outputable (HsDecl name) where
255 256 257 258 259 260 261 262
    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
263
    ppr (VectD vect)            = ppr vect
Ian Lynagh's avatar
Ian Lynagh committed
264
    ppr (WarningD wd)           = ppr wd
265
    ppr (AnnD ad)               = ppr ad
266 267
    ppr (SpliceD dd)            = ppr dd
    ppr (DocD doc)              = ppr doc
268
    ppr (RoleAnnotD ra)         = ppr ra
269

270
instance (OutputableBndrId name) => Outputable (HsGroup name) where
271
    ppr (HsGroup { hs_valds  = val_decls,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
272
                   hs_tyclds = tycl_decls,
273
                   hs_derivds = deriv_decls,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
274 275 276 277 278 279 280
                   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 })
281 282
        = vcat_mb empty
            [ppr_ds fix_decls, ppr_ds default_decls,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
283 284 285
             ppr_ds deprec_decls, ppr_ds ann_decls,
             ppr_ds rule_decls,
             ppr_ds vect_decls,
286 287
             if isEmptyValBinds val_decls
                then Nothing
288
                else Just (ppr val_decls),
289 290
             ppr_ds (tyClGroupTyClDecls tycl_decls),
             ppr_ds (tyClGroupInstDecls tycl_decls),
291
             ppr_ds deriv_decls,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
292 293
             ppr_ds foreign_decls]
        where
294
          ppr_ds :: Outputable a => [a] -> Maybe SDoc
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
295 296
          ppr_ds [] = Nothing
          ppr_ds ds = Just (vcat (map ppr ds))
297 298

          vcat_mb :: SDoc -> [Maybe SDoc] -> SDoc
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
299
          -- Concatenate vertically with white-space between non-blanks
300 301 302
          vcat_mb _    []             = empty
          vcat_mb gap (Nothing : ds) = vcat_mb gap ds
          vcat_mb gap (Just d  : ds) = gap $$ d $$ vcat_mb blankLine ds
303

304
-- | Located Splice Declaration
305
type LSpliceDecl name = Located (SpliceDecl name)
306 307

-- | Splice Declaration
308
data SpliceDecl id
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
309
  = SpliceDecl                  -- Top level splice
310
        (Located (HsSplice id))
311
        SpliceExplicitFlag
312
deriving instance (DataId id) => Data (SpliceDecl id)
313

314
instance (OutputableBndrId name) => Outputable (SpliceDecl name) where
Alan Zimmerman's avatar
Alan Zimmerman committed
315
   ppr (SpliceDecl (L _ e) f) = pprSpliceDecl e f
316

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

324 325
Note [The Naming story]
~~~~~~~~~~~~~~~~~~~~~~~
326 327
Here is the story about the implicit names that go with type, class,
and instance decls.  It's a bit tricky, so pay attention!
328 329 330

"Implicit" (or "system") binders
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
331
  Each data type decl defines
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
332 333
        a worker name for each constructor
        to-T and from-T convertors
334
  Each class decl defines
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
335 336 337 338
        a tycon for the class
        a data constructor for that tycon
        the worker for that constructor
        a selector for each superclass
339

340 341
All have occurrence names that are derived uniquely from their parent
declaration.
342 343 344 345 346 347 348

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:
349
 - Ensure they "point to" the parent data/class decl
350
   when loading that decl from an interface file
351 352 353 354 355
   (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
356

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

360 361 362 363 364 365
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
366 367
   the ClassOpSig (in HsBinds), in the DefMethInfo field.
   (DefMethInfo is defined in Class.hs)
368 369 370 371 372 373 374

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

376 377 378 379 380
 - When parsing, every ClassOpSig gets a DefMeth with a suitable RdrName
   This is done by RdrHsSyn.mkClassOpSigDM

 - The renamer renames it to a Name

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

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

431
  - The occurrence name it chooses is derived from the instance decl (just for
432 433
    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
434 435
        instance Foo [Int]  where ...
        instance Foo [Bool] where ...
436 437
    These might both be dFooList

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

441
  - We can take this relaxed approach (changing the occurrence name later)
442 443 444 445 446 447 448 449 450
    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.
451

452 453
  - 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
454
-}
455

456
-- | Located Declaration of a Type or Class
457 458
type LTyClDecl name = Located (TyClDecl name)

459
-- | A type or class declaration.
460
data TyClDecl name
Yuras's avatar
Yuras committed
461
  = -- | @type/data family T :: *->*@
Alan Zimmerman's avatar
Alan Zimmerman committed
462 463 464
    --
    --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',
    --             'ApiAnnotation.AnnData',
465
    --             'ApiAnnotation.AnnFamily','ApiAnnotation.AnnDcolon',
Jan Stolarek's avatar
Jan Stolarek committed
466 467 468 469
    --             'ApiAnnotation.AnnWhere','ApiAnnotation.AnnOpenP',
    --             'ApiAnnotation.AnnDcolon','ApiAnnotation.AnnCloseP',
    --             'ApiAnnotation.AnnEqual','ApiAnnotation.AnnRarrow',
    --             'ApiAnnotation.AnnVbar'
Alan Zimmerman's avatar
Alan Zimmerman committed
470

471
    -- For details on above see note [Api annotations] in ApiAnnotation
472
    FamDecl { tcdFam :: FamilyDecl name }
473

474
  | -- | @type@ declaration
Alan Zimmerman's avatar
Alan Zimmerman committed
475 476 477
    --
    --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',
    --             'ApiAnnotation.AnnEqual',
478 479

    -- For details on above see note [Api annotations] in ApiAnnotation
480 481
    SynDecl { tcdLName  :: Located name           -- ^ Type constructor
            , tcdTyVars :: LHsQTyVars name        -- ^ Type variables; for an associated type
482
                                                  --   these include outer binders
483
            , tcdFixity :: LexicalFixity    -- ^ Fixity used in the declaration
484
            , tcdRhs    :: LHsType name           -- ^ RHS of type declaration
485
            , tcdFVs    :: PostRn name NameSet }
486 487

  | -- | @data@ declaration
Alan Zimmerman's avatar
Alan Zimmerman committed
488 489 490 491
    --
    --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnData',
    --              'ApiAnnotation.AnnFamily',
    --              'ApiAnnotation.AnnNewType',
492 493
    --              'ApiAnnotation.AnnNewType','ApiAnnotation.AnnDcolon'
    --              'ApiAnnotation.AnnWhere',
494 495

    -- For details on above see note [Api annotations] in ApiAnnotation
496
    DataDecl { tcdLName    :: Located name        -- ^ Type constructor
497
             , tcdTyVars   :: LHsQTyVars name  -- ^ Type variables; for an associated type
498
                                                  --   these include outer binders
499 500 501
                                                  -- Eg  class T a where
                                                  --       type F a :: *
                                                  --       type F a = a -> a
502
                                                  -- Here the type decl for 'f' includes 'a'
503
                                                  -- in its tcdTyVars
504
             , tcdFixity  :: LexicalFixity -- ^ Fixity used in the declaration
505
             , tcdDataDefn :: HsDataDefn name
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
506
             , tcdDataCusk :: PostRn name Bool    -- ^ does this have a CUSK?
507
             , tcdFVs      :: PostRn name NameSet }
508

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
509 510
  | ClassDecl { tcdCtxt    :: LHsContext name,          -- ^ Context...
                tcdLName   :: Located name,             -- ^ Name of the class
511
                tcdTyVars  :: LHsQTyVars name,          -- ^ Class type variables
512
                tcdFixity  :: LexicalFixity, -- ^ Fixity used in the declaration
Alan Zimmerman's avatar
Alan Zimmerman committed
513 514
                tcdFDs     :: [Located (FunDep (Located name))],
                                                        -- ^ Functional deps
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
515 516
                tcdSigs    :: [LSig name],              -- ^ Methods' signatures
                tcdMeths   :: LHsBinds name,            -- ^ Default methods
Alan Zimmerman's avatar
Alan Zimmerman committed
517
                tcdATs     :: [LFamilyDecl name],       -- ^ Associated types;
518
                tcdATDefs  :: [LTyFamDefltEqn name],    -- ^ Associated type defaults
519
                tcdDocs    :: [LDocDecl],               -- ^ Haddock docs
520
                tcdFVs     :: PostRn name NameSet
521
    }
Alan Zimmerman's avatar
Alan Zimmerman committed
522 523 524 525 526 527
        -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnClass',
        --           'ApiAnnotation.AnnWhere','ApiAnnotation.AnnOpen',
        --           'ApiAnnotation.AnnClose'
        --   - The tcdFDs will have 'ApiAnnotation.AnnVbar',
        --                          'ApiAnnotation.AnnComma'
        --                          'ApiAnnotation.AnnRarrow'
528

529 530
        -- For details on above see note [Api annotations] in ApiAnnotation

531
deriving instance (DataId id) => Data (TyClDecl id)
532

533

Jan Stolarek's avatar
Jan Stolarek committed
534 535
-- Simple classifiers for TyClDecl
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
536

537
-- | @True@ <=> argument is a @data@\/@newtype@
538 539
-- declaration.
isDataDecl :: TyClDecl name -> Bool
540 541
isDataDecl (DataDecl {}) = True
isDataDecl _other        = False
542

543 544
-- | type or type instance declaration
isSynDecl :: TyClDecl name -> Bool
545 546
isSynDecl (SynDecl {})   = True
isSynDecl _other        = False
547

548 549
-- | type class
isClassDecl :: TyClDecl name -> Bool
550
isClassDecl (ClassDecl {}) = True
551
isClassDecl _              = False
552

553
-- | type/data family declaration
554
isFamilyDecl :: TyClDecl name -> Bool
555
isFamilyDecl (FamDecl {})  = True
556
isFamilyDecl _other        = False
557 558 559

-- | type family declaration
isTypeFamilyDecl :: TyClDecl name -> Bool
560 561 562 563 564
isTypeFamilyDecl (FamDecl (FamilyDecl { fdInfo = info })) = case info of
  OpenTypeFamily      -> True
  ClosedTypeFamily {} -> True
  _                   -> False
isTypeFamilyDecl _ = False
565

566 567 568 569 570 571 572 573 574 575
-- | open type family info
isOpenTypeFamilyInfo :: FamilyInfo name -> Bool
isOpenTypeFamilyInfo OpenTypeFamily = True
isOpenTypeFamilyInfo _              = False

-- | closed type family info
isClosedTypeFamilyInfo :: FamilyInfo name -> Bool
isClosedTypeFamilyInfo (ClosedTypeFamily {}) = True
isClosedTypeFamilyInfo _                     = False

576 577
-- | data family declaration
isDataFamilyDecl :: TyClDecl name -> Bool
578
isDataFamilyDecl (FamDecl (FamilyDecl { fdInfo = DataFamily })) = True
579
isDataFamilyDecl _other      = False
580

Austin Seipp's avatar
Austin Seipp committed
581
-- Dealing with names
582

583
tyFamInstDeclName :: TyFamInstDecl name -> name
584 585
tyFamInstDeclName = unLoc . tyFamInstDeclLName

586
tyFamInstDeclLName :: TyFamInstDecl name -> Located name
587
tyFamInstDeclLName (TyFamInstDecl { tfid_eqn =
588
                     (L _ (TyFamEqn { tfe_tycon = ln })) })
589 590 591 592 593
  = ln

tyClDeclLName :: TyClDecl name -> Located name
tyClDeclLName (FamDecl { tcdFam = FamilyDecl { fdLName = ln } }) = ln
tyClDeclLName decl = tcdLName decl
594

595
tcdName :: TyClDecl name -> name
596 597
tcdName = unLoc . tyClDeclLName

598
tyClDeclTyVars :: TyClDecl name -> LHsQTyVars name
599 600
tyClDeclTyVars (FamDecl { tcdFam = FamilyDecl { fdTyVars = tvs } }) = tvs
tyClDeclTyVars d = tcdTyVars d
601

602 603
countTyClDecls :: [TyClDecl name] -> (Int, Int, Int, Int, Int)
        -- class, synonym decls, data, newtype, family decls
604
countTyClDecls decls
605 606 607 608
 = (count isClassDecl    decls,
    count isSynDecl      decls,  -- excluding...
    count isDataTy       decls,  -- ...family...
    count isNewTy        decls,  -- ...instances
609
    count isFamilyDecl   decls)
sof's avatar
sof committed
610
 where
611 612
   isDataTy DataDecl{ tcdDataDefn = HsDataDefn { dd_ND = DataType } } = True
   isDataTy _                                                       = False
613

614 615
   isNewTy DataDecl{ tcdDataDefn = HsDataDefn { dd_ND = NewType } } = True
   isNewTy _                                                      = False
616 617 618

-- | Does this declaration have a complete, user-supplied kind signature?
-- See Note [Complete user-supplied kind signatures]
619
hsDeclHasCusk :: TyClDecl Name -> Bool
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
620
hsDeclHasCusk (FamDecl { tcdFam = fam_decl }) = famDeclHasCusk Nothing fam_decl
621
hsDeclHasCusk (SynDecl { tcdTyVars = tyvars, tcdRhs = rhs })
622
  -- NB: Keep this synchronized with 'getInitialKind'
623 624 625 626 627 628
  = hsTvbAllKinded tyvars && rhs_annotated rhs
  where
    rhs_annotated (L _ ty) = case ty of
      HsParTy lty  -> rhs_annotated lty
      HsKindSig {} -> True
      _            -> False
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
629
hsDeclHasCusk (DataDecl { tcdDataCusk = cusk }) = cusk
630 631
hsDeclHasCusk (ClassDecl { tcdTyVars = tyvars }) = hsTvbAllKinded tyvars

Jan Stolarek's avatar
Jan Stolarek committed
632 633
-- Pretty-printing TyClDecl
-- ~~~~~~~~~~~~~~~~~~~~~~~~
634

635
instance (OutputableBndrId name) => Outputable (TyClDecl name) where
636

637
    ppr (FamDecl { tcdFam = decl }) = ppr decl
638 639
    ppr (SynDecl { tcdLName = ltycon, tcdTyVars = tyvars, tcdFixity = fixity
                 , tcdRhs = rhs })
640
      = hang (text "type" <+>
641
              pp_vanilla_decl_head ltycon tyvars fixity [] <+> equals)
642
          4 (ppr rhs)
643

644 645 646
    ppr (DataDecl { tcdLName = ltycon, tcdTyVars = tyvars, tcdFixity = fixity
                  , tcdDataDefn = defn })
      = pp_data_defn (pp_vanilla_decl_head ltycon tyvars fixity) defn
647

648
    ppr (ClassDecl {tcdCtxt = context, tcdLName = lclas, tcdTyVars = tyvars,
649
                    tcdFixity = fixity,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
650
                    tcdFDs  = fds,
651 652 653
                    tcdSigs = sigs, tcdMeths = methods,
                    tcdATs = ats, tcdATDefs = at_defs})
      | null sigs && isEmptyBag methods && null ats && null at_defs -- No "where" part
654 655
      = top_matter

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
656
      | otherwise       -- Laid out
657
      = vcat [ top_matter <+> text "where"
658
             , nest 2 $ pprDeclList (map (pprFamilyDecl NotTopLevel . unLoc) ats ++
659
                                     map ppr_fam_deflt_eqn at_defs ++
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
660
                                     pprLHsBindsForUser methods sigs) ]
661
      where
662
        top_matter = text "class"
663 664
                    <+> pp_vanilla_decl_head lclas tyvars fixity (unLoc context)
                    <+> pprFundeps (map unLoc fds)
665

666
instance (OutputableBndrId name) => Outputable (TyClGroup name) where
667 668 669 670 671
  ppr (TyClGroup { group_tyclds = tyclds
                 , group_roles = roles
                 , group_instds = instds
                 }
      )
672
    = ppr tyclds $$
673 674
      ppr roles $$
      ppr instds
675

676
pp_vanilla_decl_head :: (OutputableBndrId name) => Located name
677
   -> LHsQTyVars name
678
   -> LexicalFixity
Jan Stolarek's avatar
Jan Stolarek committed
679 680
   -> HsContext name
   -> SDoc
681
pp_vanilla_decl_head thing (HsQTvs { hsq_explicit = tyvars }) fixity context
Alan Zimmerman's avatar
Alan Zimmerman committed
682 683 684
 = hsep [pprHsContext context, pp_tyvars tyvars]
  where
    pp_tyvars (varl:varsr)
685
      | fixity == Infix
Alan Zimmerman's avatar
Alan Zimmerman committed
686 687 688 689 690
         = 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
691 692

pprTyClDeclFlavour :: TyClDecl a -> SDoc
693 694
pprTyClDeclFlavour (ClassDecl {})   = text "class"
pprTyClDeclFlavour (SynDecl {})     = text "type"
Jan Stolarek's avatar
Jan Stolarek committed
695
pprTyClDeclFlavour (FamDecl { tcdFam = FamilyDecl { fdInfo = info }})
696
  = pprFlavour info <+> text "family"
Jan Stolarek's avatar
Jan Stolarek committed
697 698 699 700
pprTyClDeclFlavour (DataDecl { tcdDataDefn = HsDataDefn { dd_ND = nd } })
  = ppr nd


701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 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
{- 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.
-}

764
-- | Type or Class Group
765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791
data TyClGroup name  -- See Note [TyClGroups and dependency analysis]
  = TyClGroup { group_tyclds :: [LTyClDecl name]
              , group_roles  :: [LRoleAnnotDecl name]
              , group_instds :: [LInstDecl name] }
deriving instance (DataId id) => Data (TyClGroup id)

emptyTyClGroup :: TyClGroup name
emptyTyClGroup = TyClGroup [] [] []

tyClGroupTyClDecls :: [TyClGroup name] -> [LTyClDecl name]
tyClGroupTyClDecls = concatMap group_tyclds

tyClGroupInstDecls :: [TyClGroup name] -> [LInstDecl name]
tyClGroupInstDecls = concatMap group_instds

tyClGroupRoleDecls :: [TyClGroup name] -> [LRoleAnnotDecl name]
tyClGroupRoleDecls = concatMap group_roles

mkTyClGroup :: [LTyClDecl name] -> [LInstDecl name] -> TyClGroup name
mkTyClGroup decls instds = TyClGroup
  { group_tyclds = decls
  , group_roles = []
  , group_instds = instds
  }



Jan Stolarek's avatar
Jan Stolarek committed
792 793 794 795 796 797
{- *********************************************************************
*                                                                      *
               Data and type family declarations
*                                                                      *
********************************************************************* -}

798 799
{- Note [FamilyResultSig]
~~~~~~~~~~~~~~~~~~~~~~~~~
Jan Stolarek's avatar
Jan Stolarek committed
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 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859
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
860

861
-- | Located type Family Result Signature
Jan Stolarek's avatar
Jan Stolarek committed
862
type LFamilyResultSig name = Located (FamilyResultSig name)
863 864

-- | type Family Result Signature
Jan Stolarek's avatar
Jan Stolarek committed
865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886
data FamilyResultSig name = -- see Note [FamilyResultSig]
    NoSig
  -- ^ - 'ApiAnnotation.AnnKeywordId' :

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

  | KindSig  (LHsKind name)
  -- ^ - 'ApiAnnotation.AnnKeywordId' :
  --             'ApiAnnotation.AnnOpenP','ApiAnnotation.AnnDcolon',
  --             'ApiAnnotation.AnnCloseP'

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

  | TyVarSig (LHsTyVarBndr name)
  -- ^ - 'ApiAnnotation.AnnKeywordId' :
  --             'ApiAnnotation.AnnOpenP','ApiAnnotation.AnnDcolon',
  --             'ApiAnnotation.AnnCloseP', 'ApiAnnotation.AnnEqual'

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

deriving instance (DataId name) => Data (FamilyResultSig name)

887
-- | Located type Family Declaration
Jan Stolarek's avatar
Jan Stolarek committed
888
type LFamilyDecl name = Located (FamilyDecl name)
889 890

-- | type Family Declaration
Jan Stolarek's avatar
Jan Stolarek committed
891 892 893
data FamilyDecl name = FamilyDecl
  { fdInfo           :: FamilyInfo name              -- type/data, closed/open
  , fdLName          :: Located name                 -- type constructor
894
  , fdTyVars         :: LHsQTyVars name              -- type variables
895
  , fdFixity         :: LexicalFixity         -- Fixity used in the declaration
Jan Stolarek's avatar
Jan Stolarek committed
896 897 898 899 900 901 902 903 904 905 906 907 908 909
  , fdResultSig      :: LFamilyResultSig name        -- result signature
  , fdInjectivityAnn :: Maybe (LInjectivityAnn name) -- optional injectivity ann
  }
  -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',
  --             'ApiAnnotation.AnnData', 'ApiAnnotation.AnnFamily',
  --             'ApiAnnotation.AnnWhere', 'ApiAnnotation.AnnOpenP',
  --             'ApiAnnotation.AnnDcolon', 'ApiAnnotation.AnnCloseP',
  --             'ApiAnnotation.AnnEqual', 'ApiAnnotation.AnnRarrow',
  --             'ApiAnnotation.AnnVbar'

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

deriving instance (DataId id) => Data (FamilyDecl id)

910
-- | Located Injectivity Annotation