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

6 7
{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, DeriveFoldable,
             DeriveTraversable #-}
8 9 10 11 12
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
                                      -- in module PlaceHolder
{-# LANGUAGE ConstraintKinds #-}
13
{-# LANGUAGE TypeFamilies #-}
14

15 16
-- | Abstract syntax of global declarations.
--
17
-- Definitions for: @SynDecl@ and @ConDecl@, @ClassDecl@,
18
-- @InstDecl@, @DefaultDecl@ and @ForeignDecl@.
19
module HsDecls (
20
  -- * Toplevel declarations
21
  HsDecl(..), LHsDecl, HsDataDefn(..), HsDeriving, LHsFunDep,
22
  HsDerivingClause(..), LHsDerivingClause, NewOrData(..), newOrDataToFlavour,
23

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

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

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

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

85
    ) where
86 87

-- friends:
88 89
import GhcPrelude

90
import {-# SOURCE #-}   HsExpr( HsExpr, HsSplice, pprExpr,
91
                                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 BasicTypes
99
import Coercion
100
import ForeignCall
101
import HsExtension
102
import NameSet
103 104

-- others:
105
import Class
106
import Outputable
107 108
import Util
import SrcLoc
Ryan Scott's avatar
Ryan Scott committed
109
import Type
110

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 p = Located (HsDecl p)
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 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162
data HsDecl p
  = TyClD      (XTyClD p)      (TyClDecl p)      -- ^ Type or Class Declaration
  | InstD      (XInstD p)      (InstDecl  p)     -- ^ Instance declaration
  | DerivD     (XDerivD p)     (DerivDecl p)     -- ^ Deriving declaration
  | ValD       (XValD p)       (HsBind p)        -- ^ Value declaration
  | SigD       (XSigD p)       (Sig p)           -- ^ Signature declaration
  | DefD       (XDefD p)       (DefaultDecl p)   -- ^ 'default' declaration
  | ForD       (XForD p)       (ForeignDecl p)   -- ^ Foreign declaration
  | WarningD   (XWarningD p)   (WarnDecls p)     -- ^ Warning declaration
  | AnnD       (XAnnD p)       (AnnDecl p)       -- ^ Annotation declaration
  | RuleD      (XRuleD p)      (RuleDecls p)     -- ^ Rule declaration
  | SpliceD    (XSpliceD p)    (SpliceDecl p)    -- ^ Splice declaration
                                                 -- (Includes quasi-quotes)
  | DocD       (XDocD p)       (DocDecl)  -- ^ Documentation comment declaration
  | RoleAnnotD (XRoleAnnotD p) (RoleAnnotDecl p) -- ^Role annotation declaration
  | XHsDecl    (XXHsDecl p)

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

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

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

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

193
        hs_derivds :: [LDerivDecl p],
194

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

199 200 201 202 203
        hs_defds  :: [LDefaultDecl p],
        hs_fords  :: [LForeignDecl p],
        hs_warnds :: [LWarnDecls p],
        hs_annds  :: [LAnnDecl p],
        hs_ruleds :: [LRuleDecls p],
204

205
        hs_docs   :: [LDocDecl]
206 207 208 209 210
    }
  | XHsGroup (XXHsGroup p)

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

212 213

emptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup (GhcPass p)
214 215 216
emptyRdrGroup = emptyGroup { hs_valds = emptyValBindsIn }
emptyRnGroup  = emptyGroup { hs_valds = emptyValBindsOut }

217 218 219
hsGroupInstDecls :: HsGroup id -> [LInstDecl id]
hsGroupInstDecls = (=<<) group_instds . hs_tyclds

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

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

272
instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsDecl p) where
273 274 275 276 277 278 279 280 281 282 283 284 285 286
    ppr (TyClD _ dcl)             = ppr dcl
    ppr (ValD _ binds)            = ppr binds
    ppr (DefD _ def)              = ppr def
    ppr (InstD _ inst)            = ppr inst
    ppr (DerivD _ deriv)          = ppr deriv
    ppr (ForD _ fd)               = ppr fd
    ppr (SigD _ sd)               = ppr sd
    ppr (RuleD _ rd)              = ppr rd
    ppr (WarningD _ wd)           = ppr wd
    ppr (AnnD _ ad)               = ppr ad
    ppr (SpliceD _ dd)            = ppr dd
    ppr (DocD _ doc)              = ppr doc
    ppr (RoleAnnotD _ ra)         = ppr ra
    ppr (XHsDecl x)               = ppr x
287

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

          vcat_mb :: SDoc -> [Maybe SDoc] -> SDoc
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
315
          -- Concatenate vertically with white-space between non-blanks
316 317 318
          vcat_mb _    []             = empty
          vcat_mb gap (Nothing : ds) = vcat_mb gap ds
          vcat_mb gap (Just d  : ds) = gap $$ d $$ vcat_mb blankLine ds
319
    ppr (XHsGroup x) = ppr x
320

321
-- | Located Splice Declaration
322
type LSpliceDecl pass = Located (SpliceDecl pass)
323 324

-- | Splice Declaration
325
data SpliceDecl p
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
326
  = SpliceDecl                  -- Top level splice
327 328
        (XSpliceDecl p)
        (Located (HsSplice p))
329
        SpliceExplicitFlag
330 331 332 333
  | XSpliceDecl (XXSpliceDecl p)

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

335 336
instance (p ~ GhcPass pass, OutputableBndrId p)
       => Outputable (SpliceDecl p) where
337 338
   ppr (SpliceDecl _ (L _ e) f) = pprSpliceDecl e f
   ppr (XSpliceDecl x) = ppr x
339

Austin Seipp's avatar
Austin Seipp committed
340 341 342
{-
************************************************************************
*                                                                      *
343
            Type and class declarations
Austin Seipp's avatar
Austin Seipp committed
344 345
*                                                                      *
************************************************************************
346

347 348
Note [The Naming story]
~~~~~~~~~~~~~~~~~~~~~~~
349 350
Here is the story about the implicit names that go with type, class,
and instance decls.  It's a bit tricky, so pay attention!
351 352 353

"Implicit" (or "system") binders
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
354
  Each data type decl defines
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
355 356
        a worker name for each constructor
        to-T and from-T convertors
357
  Each class decl defines
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
358 359 360 361
        a tycon for the class
        a data constructor for that tycon
        the worker for that constructor
        a selector for each superclass
362

363 364
All have occurrence names that are derived uniquely from their parent
declaration.
365 366 367 368 369 370 371

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:
372
 - Ensure they "point to" the parent data/class decl
373
   when loading that decl from an interface file
374 375 376 377 378
   (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
379

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

383 384 385 386 387 388
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
389 390
   the ClassOpSig (in HsBinds), in the DefMethInfo field.
   (DefMethInfo is defined in Class.hs)
391 392 393 394 395 396 397

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

399 400 401 402 403
 - When parsing, every ClassOpSig gets a DefMeth with a suitable RdrName
   This is done by RdrHsSyn.mkClassOpSigDM

 - The renamer renames it to a Name

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

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

454
  - The occurrence name it chooses is derived from the instance decl (just for
455 456
    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
457 458
        instance Foo [Int]  where ...
        instance Foo [Bool] where ...
459 460
    These might both be dFooList

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

464
  - We can take this relaxed approach (changing the occurrence name later)
465 466 467 468 469 470 471 472 473
    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.
474

475 476
  - 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
477
-}
478

479
-- | Located Declaration of a Type or Class
480
type LTyClDecl pass = Located (TyClDecl pass)
481

482
-- | A type or class declaration.
483
data TyClDecl pass
Yuras's avatar
Yuras committed
484
  = -- | @type/data family T :: *->*@
Alan Zimmerman's avatar
Alan Zimmerman committed
485 486 487
    --
    --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',
    --             'ApiAnnotation.AnnData',
488
    --             'ApiAnnotation.AnnFamily','ApiAnnotation.AnnDcolon',
Jan Stolarek's avatar
Jan Stolarek committed
489 490 491 492
    --             'ApiAnnotation.AnnWhere','ApiAnnotation.AnnOpenP',
    --             'ApiAnnotation.AnnDcolon','ApiAnnotation.AnnCloseP',
    --             'ApiAnnotation.AnnEqual','ApiAnnotation.AnnRarrow',
    --             'ApiAnnotation.AnnVbar'
Alan Zimmerman's avatar
Alan Zimmerman committed
493

494
    -- For details on above see note [Api annotations] in ApiAnnotation
495
    FamDecl { tcdFExt :: XFamDecl pass, tcdFam :: FamilyDecl pass }
496

497
  | -- | @type@ declaration
Alan Zimmerman's avatar
Alan Zimmerman committed
498 499 500
    --
    --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',
    --             'ApiAnnotation.AnnEqual',
501 502

    -- For details on above see note [Api annotations] in ApiAnnotation
503 504
    SynDecl { tcdSExt   :: XSynDecl pass          -- ^ Post renameer, FVs
            , tcdLName  :: Located (IdP pass)     -- ^ Type constructor
505 506 507
            , tcdTyVars :: LHsQTyVars pass        -- ^ Type variables; for an
                                                  -- associated type these
                                                  -- include outer binders
508
            , tcdFixity :: LexicalFixity    -- ^ Fixity used in the declaration
509
            , tcdRhs    :: LHsType pass }         -- ^ RHS of type declaration
510 511

  | -- | @data@ declaration
Alan Zimmerman's avatar
Alan Zimmerman committed
512 513 514 515
    --
    --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnData',
    --              'ApiAnnotation.AnnFamily',
    --              'ApiAnnotation.AnnNewType',
516 517
    --              'ApiAnnotation.AnnNewType','ApiAnnotation.AnnDcolon'
    --              'ApiAnnotation.AnnWhere',
518 519

    -- For details on above see note [Api annotations] in ApiAnnotation
520 521 522 523 524
    DataDecl { tcdDExt     :: XDataDecl pass       -- ^ Post renamer, CUSK flag, FVs
             , tcdLName    :: Located (IdP pass)   -- ^ Type constructor
             , tcdTyVars   :: LHsQTyVars pass      -- ^ Type variables
                              -- See Note [TyVar binders for associated declarations]
             , tcdFixity   :: LexicalFixity        -- ^ Fixity used in the declaration
525
             , tcdDataDefn :: HsDataDefn pass }
526

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

546
        -- For details on above see note [Api annotations] in ApiAnnotation
547 548
  | XTyClDecl (XXTyClDecl pass)

549 550
type LHsFunDep pass = Located (FunDep (Located (IdP pass)))

551 552 553 554
data DataDeclRn = DataDeclRn
             { tcdDataCusk :: Bool    -- ^ does this have a CUSK?
             , tcdFVs      :: NameSet }
  deriving Data
555

556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576
{- Note [TyVar binders for associated decls]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
For an /associated/ data, newtype, or type-family decl, the LHsQTyVars
/includes/ outer binders.  For example
    class T a where
       data D a c
       type F a b :: *
       type F a b = a -> a
Here the data decl for 'D', and type-family decl for 'F', both include 'a'
in their LHsQTyVars (tcdTyVars and fdTyVars resp).

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

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

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

577 578 579 580 581 582 583 584 585 586 587 588 589 590 591
type instance XFamDecl      (GhcPass _) = NoExt

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

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

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

type instance XXTyClDecl    (GhcPass _) = NoExt
592

Jan Stolarek's avatar
Jan Stolarek committed
593 594
-- Simple classifiers for TyClDecl
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
595

596
-- | @True@ <=> argument is a @data@\/@newtype@
597
-- declaration.
598
isDataDecl :: TyClDecl pass -> Bool
599 600
isDataDecl (DataDecl {}) = True
isDataDecl _other        = False
601

602
-- | type or type instance declaration
603
isSynDecl :: TyClDecl pass -> Bool
604 605
isSynDecl (SynDecl {})   = True
isSynDecl _other        = False
606

607
-- | type class
608
isClassDecl :: TyClDecl pass -> Bool
609
isClassDecl (ClassDecl {}) = True
610
isClassDecl _              = False
611

612
-- | type/data family declaration
613
isFamilyDecl :: TyClDecl pass -> Bool
614
isFamilyDecl (FamDecl {})  = True
615
isFamilyDecl _other        = False
616 617

-- | type family declaration
618
isTypeFamilyDecl :: TyClDecl pass -> Bool
619
isTypeFamilyDecl (FamDecl _ (FamilyDecl { fdInfo = info })) = case info of
620 621 622 623
  OpenTypeFamily      -> True
  ClosedTypeFamily {} -> True
  _                   -> False
isTypeFamilyDecl _ = False
624

625
-- | open type family info
626
isOpenTypeFamilyInfo :: FamilyInfo pass -> Bool
627 628 629 630
isOpenTypeFamilyInfo OpenTypeFamily = True
isOpenTypeFamilyInfo _              = False

-- | closed type family info
631
isClosedTypeFamilyInfo :: FamilyInfo pass -> Bool
632 633 634
isClosedTypeFamilyInfo (ClosedTypeFamily {}) = True
isClosedTypeFamilyInfo _                     = False

635
-- | data family declaration
636
isDataFamilyDecl :: TyClDecl pass -> Bool
637
isDataFamilyDecl (FamDecl _ (FamilyDecl { fdInfo = DataFamily })) = True
638
isDataFamilyDecl _other      = False
639

Austin Seipp's avatar
Austin Seipp committed
640
-- Dealing with names
641

642
tyFamInstDeclName :: TyFamInstDecl pass -> (IdP pass)
643 644
tyFamInstDeclName = unLoc . tyFamInstDeclLName

645
tyFamInstDeclLName :: TyFamInstDecl pass -> Located (IdP pass)
646
tyFamInstDeclLName (TyFamInstDecl { tfid_eqn =
647
                     (HsIB { hsib_body = FamEqn { feqn_tycon = ln }}) })
648
  = ln
649 650 651 652
tyFamInstDeclLName (TyFamInstDecl (HsIB _ (XFamEqn _)))
  = panic "tyFamInstDeclLName"
tyFamInstDeclLName (TyFamInstDecl (XHsImplicitBndrs _))
  = panic "tyFamInstDeclLName"
653

654
tyClDeclLName :: TyClDecl pass -> Located (IdP pass)
655 656
tyClDeclLName (FamDecl { tcdFam = FamilyDecl { fdLName = ln } }) = ln
tyClDeclLName decl = tcdLName decl
657

658
tcdName :: TyClDecl pass -> (IdP pass)
659 660
tcdName = unLoc . tyClDeclLName

661
tyClDeclTyVars :: TyClDecl pass -> LHsQTyVars pass
662 663
tyClDeclTyVars (FamDecl { tcdFam = FamilyDecl { fdTyVars = tvs } }) = tvs
tyClDeclTyVars d = tcdTyVars d
664

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

677 678
   isNewTy DataDecl{ tcdDataDefn = HsDataDefn { dd_ND = NewType } } = True
   isNewTy _                                                      = False
679 680

-- | Does this declaration have a complete, user-supplied kind signature?
681
-- See Note [CUSKs: complete user-supplied kind signatures]
682
hsDeclHasCusk :: TyClDecl GhcRn -> Bool
683 684 685
hsDeclHasCusk (FamDecl { tcdFam = fam_decl })
  = famDeclHasCusk False fam_decl
    -- False: this is not: an associated type of a class with no cusk
686
hsDeclHasCusk (SynDecl { tcdTyVars = tyvars, tcdRhs = rhs })
687
  -- NB: Keep this synchronized with 'getInitialKind'
688 689 690
  = hsTvbAllKinded tyvars && rhs_annotated rhs
  where
    rhs_annotated (L _ ty) = case ty of
691 692 693
      HsParTy _ lty  -> rhs_annotated lty
      HsKindSig {}   -> True
      _              -> False
694
hsDeclHasCusk (DataDecl { tcdDExt = DataDeclRn { tcdDataCusk = cusk }}) = cusk
695
hsDeclHasCusk (ClassDecl { tcdTyVars = tyvars }) = hsTvbAllKinded tyvars
696
hsDeclHasCusk (XTyClDecl _) = panic "hsDeclHasCusk"
697

Jan Stolarek's avatar
Jan Stolarek committed
698 699
-- Pretty-printing TyClDecl
-- ~~~~~~~~~~~~~~~~~~~~~~~~
700

701
instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (TyClDecl p) where
702

703
    ppr (FamDecl { tcdFam = decl }) = ppr decl
704 705
    ppr (SynDecl { tcdLName = ltycon, tcdTyVars = tyvars, tcdFixity = fixity
                 , tcdRhs = rhs })
706
      = hang (text "type" <+>
707
              pp_vanilla_decl_head ltycon tyvars fixity noLHsContext <+> equals)
708
          4 (ppr rhs)
709

710 711 712
    ppr (DataDecl { tcdLName = ltycon, tcdTyVars = tyvars, tcdFixity = fixity
                  , tcdDataDefn = defn })
      = pp_data_defn (pp_vanilla_decl_head ltycon tyvars fixity) defn
713

714
    ppr (ClassDecl {tcdCtxt = context, tcdLName = lclas, tcdTyVars = tyvars,
715
                    tcdFixity = fixity,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
716
                    tcdFDs  = fds,
717 718 719
                    tcdSigs = sigs, tcdMeths = methods,
                    tcdATs = ats, tcdATDefs = at_defs})
      | null sigs && isEmptyBag methods && null ats && null at_defs -- No "where" part
720 721
      = top_matter

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
722
      | otherwise       -- Laid out
723
      = vcat [ top_matter <+> text "where"
724
             , nest 2 $ pprDeclList (map (pprFamilyDecl NotTopLevel . unLoc) ats ++
725
                                     map ppr_fam_deflt_eqn at_defs ++
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
726
                                     pprLHsBindsForUser methods sigs) ]
727
      where
728
        top_matter = text "class"
729
                    <+> pp_vanilla_decl_head lclas tyvars fixity context
730
                    <+> pprFundeps (map unLoc fds)
731

732
    ppr (XTyClDecl x) = ppr x
733

734 735
instance (p ~ GhcPass pass, OutputableBndrId p)
       => Outputable (TyClGroup p) where
736 737 738 739 740
  ppr (TyClGroup { group_tyclds = tyclds
                 , group_roles = roles
                 , group_instds = instds
                 }
      )
741
    = ppr tyclds $$
742 743
      ppr roles $$
      ppr instds
744
  ppr (XTyClGroup x) = ppr x
745

746 747 748
pp_vanilla_decl_head :: (OutputableBndrId (GhcPass p))
   => Located (IdP (GhcPass p))
   -> LHsQTyVars (GhcPass p)
749
   -> LexicalFixity
750
   -> LHsContext (GhcPass p)
Jan Stolarek's avatar
Jan Stolarek committed
751
   -> SDoc
752
pp_vanilla_decl_head thing (HsQTvs { hsq_explicit = tyvars }) fixity context
753
 = hsep [pprLHsContext context, pp_tyvars tyvars]
754 755
  where
    pp_tyvars (varl:varsr)
756 757 758 759
      | fixity == Infix && length varsr > 1
         = hsep [char '(',ppr (unLoc varl), pprInfixOcc (unLoc thing)
                , (ppr.unLoc) (head varsr), char ')'
                , hsep (map (ppr.unLoc) (tail varsr))]
760
      | fixity == Infix
761 762 763 764
         = hsep [ppr (unLoc varl), pprInfixOcc (unLoc thing)
         , hsep (map (ppr.unLoc) varsr)]
      | otherwise = hsep [ pprPrefixOcc (unLoc thing)
                  , hsep (map (ppr.unLoc) (varl:varsr))]
765
    pp_tyvars [] = pprPrefixOcc (unLoc thing)
766
pp_vanilla_decl_head _ (XLHsQTyVars x) _ _ = ppr x
Jan Stolarek's avatar
Jan Stolarek committed
767

768
pprTyClDeclFlavour :: TyClDecl (GhcPass p) -> SDoc
769 770
pprTyClDeclFlavour (ClassDecl {})   = text "class"
pprTyClDeclFlavour (SynDecl {})     = text "type"
Jan Stolarek's avatar
Jan Stolarek committed
771
pprTyClDeclFlavour (FamDecl { tcdFam = FamilyDecl { fdInfo = info }})
772
  = pprFlavour info <+> text "family"
773 774
pprTyClDeclFlavour (FamDecl { tcdFam = XFamilyDecl x})
  = ppr x
Jan Stolarek's avatar
Jan Stolarek committed
775 776
pprTyClDeclFlavour (DataDecl { tcdDataDefn = HsDataDefn { dd_ND = nd } })
  = ppr nd
777 778 779
pprTyClDeclFlavour (DataDecl { tcdDataDefn = XHsDataDefn x })
  = ppr x
pprTyClDeclFlavour (XTyClDecl x) = ppr x
Jan Stolarek's avatar
Jan Stolarek committed
780 781


782 783
{- Note [CUSKs: complete user-supplied kind signatures]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
784 785 786 787 788 789
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.

790 791 792 793 794 795 796 797 798 799 800
PRINCIPLE:
  a type declaration has a CUSK iff we could produce a separate kind signature
  for it, just like a type signature for a function,
  looking only at the header of the declaration.

Examples:
  * data T1 (a :: *->*) (b :: *) = ....
    -- Has CUSK; equivalant to   T1 :: (*->*) -> * -> *

 * data T2 a b = ...
   -- No CUSK; we do not want to guess T2 :: * -> * -> *
Gabor Greif's avatar
Gabor Greif committed
801
   -- because the full decl might be   data T a b = MkT (a b)
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

  * data T3 (a :: k -> *) (b :: *) = ...
    -- CUSK; equivalent to   T3 :: (k -> *) -> * -> *
    -- We lexically generalise over k to get
    --    T3 :: forall k. (k -> *) -> * -> *
    -- The generalisation is here is purely lexical, just like
    --    f3 :: a -> a
    -- means
    --    f3 :: forall a. a -> a

  * data T4 (a :: j k) = ...
     -- CUSK; equivalent to   T4 :: j k -> *
     -- which we lexically generalise to  T4 :: forall j k. j k -> *
     -- and then, if PolyKinds is on, we further generalise to
     --   T4 :: forall kk (j :: kk -> *) (k :: kk). j k -> *
     -- Again this is exactly like what happens as the term level
     -- when you write
     --    f4 :: forall a b. a b -> Int

NOTE THAT
  * A CUSK does /not/ mean that everything about the kind signature is
    fully specified by the user.  Look at T4 and f4: we had do do kind
    inference to figure out the kind-quantification.  But in both cases
    (T4 and f4) that inference is done looking /only/ at the header of T4
    (or signature for f4), not at the definition thereof.

  * The CUSK completely fixes the kind of the type constructor, forever.

  * The precise rules, for each declaration form, for whethher a declaration
    has a CUSK are given in the user manual section "Complete user-supplied
    kind signatures and polymorphic recursion".  BUt they simply implement
    PRINCIPLE above.

  * Open type families are interesting:
      type family T5 a b :: *
    There simply /is/ no accompanying declaration, so that info is all
    we'll ever get.  So we it has a CUSK by definition, and we default
    any un-fixed kind variables to *.

  * Associated types are a bit tricker:
      class C6 a where
         type family T6 a b :: *
         op :: a Int -> Int
    Here C6 does not have a CUSK (in fact we ultimately discover that
    a :: * -> *).  And hence neither does T6, the associated family,
    because we can't fix its kind until we have settled C6.  Another
    way to say it: unlike a top-level, we /may/ discover more about
    a's kind from C6's definition.

  * 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.)
Simon Peyton Jones's avatar
Simon Peyton Jones committed
856 857 858

    This last point is much more debatable than the others; see
    Trac #15142 comment:22
859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892
-}


{- *********************************************************************
*                                                                      *
                         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.
-}

893
-- | Type or Class Group
894
data TyClGroup pass  -- See Note [TyClGroups and dependency analysis]
895 896
  = TyClGroup { group_ext    :: XCTyClGroup pass
              , group_tyclds :: [LTyClDecl pass]
897 898
              , group_roles  :: [LRoleAnnotDecl pass]
              , group_instds :: [LInstDecl pass] }
899
  | XTyClGroup (XXTyClGroup pass)
900

901 902 903 904 905 906
type instance XCTyClGroup (GhcPass _) = NoExt
type instance XXTyClGroup (GhcPass _) = NoExt


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

908
tyClGroupTyClDecls :: [TyClGroup pass] -> [LTyClDecl pass]
909 910
tyClGroupTyClDecls = concatMap group_tyclds

911
tyClGroupInstDecls :: [TyClGroup pass] -> [LInstDecl pass]
912 913
tyClGroupInstDecls = concatMap group_instds

914
tyClGroupRoleDecls :: [TyClGroup pass] -> [LRoleAnnotDecl pass]
915 916
tyClGroupRoleDecls = concatMap group_roles

917 918
mkTyClGroup :: [LTyClDecl (GhcPass p)] -> [LInstDecl (GhcPass p)]
            -> TyClGroup (GhcPass p)
919
mkTyClGroup decls instds = TyClGroup
920 921
  { group_ext = noExt
  , group_tyclds = decls
922 923 924 925 926 927
  , group_roles = []
  , group_instds = instds
  }



Jan Stolarek's avatar
Jan Stolarek committed
928 929 930 931 932 933
{- *********************************************************************
*                                                                      *
               Data and type family declarations
*                                                                      *
********************************************************************* -}

934 935
{- Note [FamilyResultSig]
~~~~~~~~~~~~~~~~~~~~~~~~~
Jan Stolarek's avatar
Jan Stolarek committed
936

937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995
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
996

997
-- | Located type Family Result Signature
998
type LFamilyResultSig pass = Located (FamilyResultSig pass)
999 1000

-- | type Family Result Signature
1001
data FamilyResultSig pass = -- see Note [FamilyResultSig]
1002
    NoSig (XNoSig pass)
Jan Stolarek's avatar
Jan Stolarek committed
1003 1004 1005 1006
  -- ^ - 'ApiAnnotation.AnnKeywordId' :

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

1007
  | KindSig  (XCKindSig pass) (LHsKind pass)
Jan Stolarek's avatar
Jan Stolarek committed
1008 1009 1010 1011 1012 1013
  -- ^ - 'ApiAnnotation.AnnKeywordId' :
  --             'ApiAnnotation.AnnOpenP','ApiAnnotation.AnnDcolon',
  --             'ApiAnnotation.AnnCloseP'

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

1014
  | TyVarSig (XTyVarSig pass) (LHsTyVarBndr pass)
Jan Stolarek's avatar
Jan Stolarek committed
1015 1016 1017
  -- ^ - 'ApiAnnotation.AnnKeywordId' :
  --             'ApiAnnotation.AnnOpenP','ApiAnnotation.AnnDcolon',
  --             'ApiAnnotation.AnnCloseP', 'ApiAnnotation.AnnEqual'
1018
  | XFamilyResultSig (XXFamilyResultSig pass)
Jan Stolarek's avatar
Jan Stolarek committed
1019 1020 1021

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

1022 1023 1024 1025 1026 1027
type instance XNoSig            (GhcPass _) = NoExt
type instance XCKindSig         (GhcPass _) = NoExt
type instance XTyVarSig         (GhcPass _) = NoExt
type instance XXFamilyResultSig (GhcPass _) = NoExt


1028
-- | Located type Family Declaration
1029
type LFamilyDecl pass = Located (FamilyDecl pass)
1030 1031

-- | type Family Declaration
1032
data FamilyDecl pass = FamilyDecl
1033 1034
  { fdExt            :: XCFamilyDecl pass
  , fdInfo           :: FamilyInfo pass              -- type/data, closed/open
1035 1036
  , fdLName          :: Located (IdP pass)           -- type constructor
  , fdTyVars         :: LHsQTyVars pass              -- type variables
1037
                       -- See Note [TyVar binders for associated declarations]
1038
  , fdFixity         :: LexicalFixity                -- Fixity used in the declaration
1039 1040
  , fdResultSig      :: LFamilyResultSig pass        -- result signature
  , fdInjectivityAnn :: Maybe (LInjectivityAnn pass) -- optional injectivity ann
Jan Stolarek's avatar
Jan Stolarek committed
1041
  }
1042
  | XFamilyDecl (XXFamilyDecl pass)
Jan Stolarek's avatar
Jan Stolarek committed
1043 1044 1045 1046 1047 1048 1049 1050 1051
  -- ^ - '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

1052 1053 1054 1055
type instance XCFamilyDecl    (GhcPass _) = NoExt
type instance XXFamilyDecl    (GhcPass _) = NoExt


1056
-- | Located Injectivity Annotation
Alan Zimmerman's avatar