HsDecls.hs 86.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,
22
  HsDerivingClause(..), LHsDerivingClause, NewOrData(..), newOrDataToFlavour,
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, 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 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
Ben Gamari's avatar
Ben Gamari committed
102
import PlaceHolder ( PlaceHolder(..) )
103
import HsExtension
104
import NameSet
105 106

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

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

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

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

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

133
-- | A Haskell Declaration
134
data HsDecl id
135 136 137 138 139 140 141 142 143 144 145 146 147 148 149
  = 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
Ben Gamari's avatar
Ben Gamari committed
150
deriving instance (DataId id) => Data (HsDecl id)
151

152 153

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

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

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

181
        hs_derivds :: [LDerivDecl id],
182

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

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

194
        hs_docs   :: [LDocDecl]
195
  }
Ben Gamari's avatar
Ben Gamari committed
196
deriving instance (DataId id) => Data (HsGroup id)
197

Ben Gamari's avatar
Ben Gamari committed
198
emptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup a
199 200 201
emptyRdrGroup = emptyGroup { hs_valds = emptyValBindsIn }
emptyRnGroup  = emptyGroup { hs_valds = emptyValBindsOut }

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

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

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

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

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

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

308
-- | Located Splice Declaration
309
type LSpliceDecl pass = Located (SpliceDecl pass)
310 311

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

Ben Gamari's avatar
Ben Gamari committed
318 319
instance (SourceTextX pass, OutputableBndrId pass)
       => Outputable (SpliceDecl pass) where
Alan Zimmerman's avatar
Alan Zimmerman committed
320
   ppr (SpliceDecl (L _ e) f) = pprSpliceDecl e f
321

Austin Seipp's avatar
Austin Seipp committed
322 323 324
{-
************************************************************************
*                                                                      *
325
            Type and class declarations
Austin Seipp's avatar
Austin Seipp committed
326 327
*                                                                      *
************************************************************************
328

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

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

345 346
All have occurrence names that are derived uniquely from their parent
declaration.
347 348 349 350 351 352 353

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

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

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

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

381 382 383 384 385
 - When parsing, every ClassOpSig gets a DefMeth with a suitable RdrName
   This is done by RdrHsSyn.mkClassOpSigDM

 - The renamer renames it to a Name

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

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

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

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

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

457 458
  - 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
459
-}
460

461
-- | Located Declaration of a Type or Class
462
type LTyClDecl pass = Located (TyClDecl pass)
463

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

476
    -- For details on above see note [Api annotations] in ApiAnnotation
477
    FamDecl { tcdFam :: FamilyDecl pass }
478

479
  | -- | @type@ declaration
Alan Zimmerman's avatar
Alan Zimmerman committed
480 481 482
    --
    --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',
    --             'ApiAnnotation.AnnEqual',
483 484

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

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

    -- For details on above see note [Api annotations] in ApiAnnotation
502 503 504 505 506 507 508 509 510
    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
511
             , tcdFixity  :: LexicalFixity -- ^ Fixity used in the declaration
512 513 514
             , tcdDataDefn :: HsDataDefn pass
             , tcdDataCusk :: PostRn pass Bool    -- ^ does this have a CUSK?
             , tcdFVs      :: PostRn pass NameSet }
515

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

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

Ben Gamari's avatar
Ben Gamari committed
539
deriving instance (DataId id) => Data (TyClDecl id)
540

541

Jan Stolarek's avatar
Jan Stolarek committed
542 543
-- Simple classifiers for TyClDecl
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
544

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

551
-- | type or type instance declaration
552
isSynDecl :: TyClDecl pass -> Bool
553 554
isSynDecl (SynDecl {})   = True
isSynDecl _other        = False
555

556
-- | type class
557
isClassDecl :: TyClDecl pass -> Bool
558
isClassDecl (ClassDecl {}) = True
559
isClassDecl _              = False
560

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

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

574
-- | open type family info
575
isOpenTypeFamilyInfo :: FamilyInfo pass -> Bool
576 577 578 579
isOpenTypeFamilyInfo OpenTypeFamily = True
isOpenTypeFamilyInfo _              = False

-- | closed type family info
580
isClosedTypeFamilyInfo :: FamilyInfo pass -> Bool
581 582 583
isClosedTypeFamilyInfo (ClosedTypeFamily {}) = True
isClosedTypeFamilyInfo _                     = False

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

Austin Seipp's avatar
Austin Seipp committed
589
-- Dealing with names
590

591
tyFamInstDeclName :: TyFamInstDecl pass -> (IdP pass)
592 593
tyFamInstDeclName = unLoc . tyFamInstDeclLName

594
tyFamInstDeclLName :: TyFamInstDecl pass -> Located (IdP pass)
595
tyFamInstDeclLName (TyFamInstDecl { tfid_eqn =
596
                     (HsIB { hsib_body = FamEqn { feqn_tycon = ln }}) })
597 598
  = ln

599
tyClDeclLName :: TyClDecl pass -> Located (IdP pass)
600 601
tyClDeclLName (FamDecl { tcdFam = FamilyDecl { fdLName = ln } }) = ln
tyClDeclLName decl = tcdLName decl
602

603
tcdName :: TyClDecl pass -> (IdP pass)
604 605
tcdName = unLoc . tyClDeclLName

606
tyClDeclTyVars :: TyClDecl pass -> LHsQTyVars pass
607 608
tyClDeclTyVars (FamDecl { tcdFam = FamilyDecl { fdTyVars = tvs } }) = tvs
tyClDeclTyVars d = tcdTyVars d
609

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

622 623
   isNewTy DataDecl{ tcdDataDefn = HsDataDefn { dd_ND = NewType } } = True
   isNewTy _                                                      = False
624 625 626

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

Jan Stolarek's avatar
Jan Stolarek committed
640 641
-- Pretty-printing TyClDecl
-- ~~~~~~~~~~~~~~~~~~~~~~~~
642

Ben Gamari's avatar
Ben Gamari committed
643 644
instance (SourceTextX pass, OutputableBndrId pass)
       => Outputable (TyClDecl pass) where
645

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

653 654 655
    ppr (DataDecl { tcdLName = ltycon, tcdTyVars = tyvars, tcdFixity = fixity
                  , tcdDataDefn = defn })
      = pp_data_defn (pp_vanilla_decl_head ltycon tyvars fixity) defn
656

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

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

Ben Gamari's avatar
Ben Gamari committed
675 676
instance (SourceTextX pass, OutputableBndrId pass)
       => Outputable (TyClGroup pass) where
677 678 679 680 681
  ppr (TyClGroup { group_tyclds = tyclds
                 , group_roles = roles
                 , group_instds = instds
                 }
      )
682
    = ppr tyclds $$
683 684
      ppr roles $$
      ppr instds
685

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

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


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 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778
{- 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.
-}

779
-- | Type or Class Group
780 781 782 783
data TyClGroup pass  -- See Note [TyClGroups and dependency analysis]
  = TyClGroup { group_tyclds :: [LTyClDecl pass]
              , group_roles  :: [LRoleAnnotDecl pass]
              , group_instds :: [LInstDecl pass] }
Ben Gamari's avatar
Ben Gamari committed
784
deriving instance (DataId id) => Data (TyClGroup id)
785

786
emptyTyClGroup :: TyClGroup pass
787 788
emptyTyClGroup = TyClGroup [] [] []

789
tyClGroupTyClDecls :: [TyClGroup pass] -> [LTyClDecl pass]
790 791
tyClGroupTyClDecls = concatMap group_tyclds

792
tyClGroupInstDecls :: [TyClGroup pass] -> [LInstDecl pass]
793 794
tyClGroupInstDecls = concatMap group_instds

795
tyClGroupRoleDecls :: [TyClGroup pass] -> [LRoleAnnotDecl pass]
796 797
tyClGroupRoleDecls = concatMap group_roles

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



Jan Stolarek's avatar
Jan Stolarek committed
807 808 809 810 811 812
{- *********************************************************************
*                                                                      *
               Data and type family declarations
*                                                                      *
********************************************************************* -}

813 814
{- Note [FamilyResultSig]
~~~~~~~~~~~~~~~~~~~~~~~~~
Jan Stolarek's avatar
Jan Stolarek committed
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 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874
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
875

876
-- | Located type Family Result Signature
877
type LFamilyResultSig pass = Located (FamilyResultSig pass)
878 879

-- | type Family Result Signature
880
data FamilyResultSig pass = -- see Note [FamilyResultSig]
Jan Stolarek's avatar
Jan Stolarek committed
881 882 883 884 885
    NoSig
  -- ^ - 'ApiAnnotation.AnnKeywordId' :

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

886
  | KindSig  (LHsKind pass)
Jan Stolarek's avatar
Jan Stolarek committed
887 888 889 890 891 892
  -- ^ - 'ApiAnnotation.AnnKeywordId' :
  --             'ApiAnnotation.AnnOpenP','ApiAnnotation.AnnDcolon',
  --             'ApiAnnotation.AnnCloseP'

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

893
  | TyVarSig (LHsTyVarBndr pass)
Jan Stolarek's avatar
Jan Stolarek committed
894 895 896 897 898 899
  -- ^ - 'ApiAnnotation.AnnKeywordId' :
  --             'ApiAnnotation.AnnOpenP','ApiAnnotation.AnnDcolon',
  --             'ApiAnnotation.AnnCloseP', 'ApiAnnotation.AnnEqual'

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

Ben Gamari's avatar
Ben Gamari committed
900
deriving instance (DataId pass) => Data (FamilyResultSig pass)
Jan Stolarek's avatar
Jan Stolarek committed
901

902
-- | Located type Family Declaration
903
type LFamilyDecl pass = Located (FamilyDecl pass)
904 905

-- | type Family Declaration
906 907 908 909
data FamilyDecl pass = FamilyDecl
  { fdInfo           :: FamilyInfo pass              -- type/data, closed/open
  , fdLName          :: Located (IdP pass)           -- type constructor
  , fdTyVars         :: LHsQTyVars pass              -- type variables