Add -fwarn-context-quantification (#4426)
[ghc.git] / compiler / hsSyn / HsDecls.lhs
1 %
2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 %
5
6 \begin{code}
7 {-# LANGUAGE CPP #-}
8 {-# LANGUAGE DeriveDataTypeable, DeriveFunctor, DeriveFoldable,
9              DeriveTraversable #-}
10 {-# LANGUAGE StandaloneDeriving #-}
11 {-# LANGUAGE FlexibleContexts #-}
12 {-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
13                                       -- in module PlaceHolder
14 {-# LANGUAGE ConstraintKinds #-}
15
16 -- | Abstract syntax of global declarations.
17 --
18 -- Definitions for: @SynDecl@ and @ConDecl@, @ClassDecl@,
19 -- @InstDecl@, @DefaultDecl@ and @ForeignDecl@.
20 module HsDecls (
21   -- * Toplevel declarations
22   HsDecl(..), LHsDecl, HsDataDefn(..),
23   -- ** Class or type declarations
24   TyClDecl(..), LTyClDecl,
25   TyClGroup(..), tyClGroupConcat, mkTyClGroup,
26   isClassDecl, isDataDecl, isSynDecl, tcdName,
27   isFamilyDecl, isTypeFamilyDecl, isDataFamilyDecl,
28   isOpenTypeFamilyInfo, isClosedTypeFamilyInfo,
29   tyFamInstDeclName, tyFamInstDeclLName,
30   countTyClDecls, pprTyClDeclFlavour,
31   tyClDeclLName, tyClDeclTyVars,
32   hsDeclHasCusk, famDeclHasCusk,
33   FamilyDecl(..), LFamilyDecl,
34
35   -- ** Instance declarations
36   InstDecl(..), LInstDecl, NewOrData(..), FamilyInfo(..),
37   TyFamInstDecl(..), LTyFamInstDecl, instDeclDataFamInsts,
38   DataFamInstDecl(..), LDataFamInstDecl, pprDataFamInstFlavour,
39   TyFamEqn(..), TyFamInstEqn, LTyFamInstEqn, TyFamDefltEqn, LTyFamDefltEqn,
40   LClsInstDecl, ClsInstDecl(..),
41
42   -- ** Standalone deriving declarations
43   DerivDecl(..), LDerivDecl,
44   -- ** @RULE@ declarations
45   RuleDecl(..), LRuleDecl, RuleBndr(..),
46   collectRuleBndrSigTys,
47   -- ** @VECTORISE@ declarations
48   VectDecl(..), LVectDecl,
49   lvectDeclName, lvectInstDecl,
50   -- ** @default@ declarations
51   DefaultDecl(..), LDefaultDecl,
52   -- ** Template haskell declaration splice
53   SpliceExplicitFlag(..),
54   SpliceDecl(..), LSpliceDecl,
55   -- ** Foreign function interface declarations
56   ForeignDecl(..), LForeignDecl, ForeignImport(..), ForeignExport(..),
57   noForeignImportCoercionYet, noForeignExportCoercionYet,
58   CImportSpec(..),
59   -- ** Data-constructor declarations
60   ConDecl(..), LConDecl, ResType(..), 
61   HsConDeclDetails, hsConDeclArgTys, 
62   -- ** Document comments
63   DocDecl(..), LDocDecl, docDeclDoc,
64   -- ** Deprecations
65   WarnDecl(..),  LWarnDecl,
66   -- ** Annotations
67   AnnDecl(..), LAnnDecl, 
68   AnnProvenance(..), annProvenanceName_maybe,
69   -- ** Role annotations
70   RoleAnnotDecl(..), LRoleAnnotDecl, roleAnnotDeclName,
71
72   -- * Grouping
73   HsGroup(..),  emptyRdrGroup, emptyRnGroup, appendGroups
74
75     ) where
76
77 -- friends:
78 import {-# SOURCE #-}   HsExpr( LHsExpr, HsExpr, HsSplice, pprExpr, pprUntypedSplice )
79         -- Because Expr imports Decls via HsBracket
80
81 import HsBinds
82 import HsPat
83 import HsTypes
84 import HsDoc
85 import TyCon
86 import Name
87 import BasicTypes
88 import Coercion
89 import ForeignCall
90 import PlaceHolder ( PostTc,PostRn,PlaceHolder(..),DataId )
91 import NameSet
92
93 -- others:
94 import InstEnv
95 import Class
96 import Outputable       
97 import Util
98 import SrcLoc
99 import FastString
100
101 import Bag
102 import Data.Data        hiding (TyCon,Fixity)
103 #if __GLASGOW_HASKELL__ < 709
104 import Data.Foldable ( Foldable )
105 import Data.Traversable ( Traversable )
106 #endif
107 import Data.Maybe
108 \end{code}
109
110 %************************************************************************
111 %*                                                                      *
112 \subsection[HsDecl]{Declarations}
113 %*                                                                      *
114 %************************************************************************
115
116 \begin{code}
117 type LHsDecl id = Located (HsDecl id)
118
119 -- | A Haskell Declaration
120 data HsDecl id
121   = TyClD       (TyClDecl id)     -- ^ A type or class declaration.
122   | InstD       (InstDecl  id)    -- ^ An instance declaration.
123   | DerivD      (DerivDecl id)
124   | ValD        (HsBind id)
125   | SigD        (Sig id)
126   | DefD        (DefaultDecl id)
127   | ForD        (ForeignDecl id)
128   | WarningD    (WarnDecl id)
129   | AnnD        (AnnDecl id)
130   | RuleD       (RuleDecl id)
131   | VectD       (VectDecl id)
132   | SpliceD     (SpliceDecl id)
133   | DocD        (DocDecl)
134   | QuasiQuoteD (HsQuasiQuote id)
135   | RoleAnnotD  (RoleAnnotDecl id)
136   deriving (Typeable)
137 deriving instance (DataId id) => Data (HsDecl id)
138
139
140 -- NB: all top-level fixity decls are contained EITHER
141 -- EITHER SigDs
142 -- OR     in the ClassDecls in TyClDs
143 --
144 -- The former covers
145 --      a) data constructors
146 --      b) class methods (but they can be also done in the
147 --              signatures of class decls)
148 --      c) imported functions (that have an IfacSig)
149 --      d) top level decls
150 --
151 -- The latter is for class methods only
152
153 -- | A 'HsDecl' is categorised into a 'HsGroup' before being
154 -- fed to the renamer.
155 data HsGroup id
156   = HsGroup {
157         hs_valds  :: HsValBinds id,
158         hs_splcds :: [LSpliceDecl id],
159
160         hs_tyclds :: [TyClGroup id],
161                 -- A list of mutually-recursive groups
162                 -- No family-instances here; they are in hs_instds
163                 -- Parser generates a singleton list;
164                 -- renamer does dependency analysis
165
166         hs_instds  :: [LInstDecl id],
167                 -- Both class and family instance declarations in here
168
169         hs_derivds :: [LDerivDecl id],
170
171         hs_fixds  :: [LFixitySig id],
172                 -- Snaffled out of both top-level fixity signatures,
173                 -- and those in class declarations
174
175         hs_defds  :: [LDefaultDecl id],
176         hs_fords  :: [LForeignDecl id],
177         hs_warnds :: [LWarnDecl id],
178         hs_annds  :: [LAnnDecl id],
179         hs_ruleds :: [LRuleDecl id],
180         hs_vects  :: [LVectDecl id],
181
182         hs_docs   :: [LDocDecl]
183   } deriving (Typeable)
184 deriving instance (DataId id) => Data (HsGroup id)
185
186 emptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup a
187 emptyRdrGroup = emptyGroup { hs_valds = emptyValBindsIn }
188 emptyRnGroup  = emptyGroup { hs_valds = emptyValBindsOut }
189
190 emptyGroup = HsGroup { hs_tyclds = [], hs_instds = [], 
191                        hs_derivds = [],
192                        hs_fixds = [], hs_defds = [], hs_annds = [],
193                        hs_fords = [], hs_warnds = [], hs_ruleds = [], hs_vects = [],
194                        hs_valds = error "emptyGroup hs_valds: Can't happen",
195                        hs_splcds = [],
196                        hs_docs = [] }
197
198 appendGroups :: HsGroup a -> HsGroup a -> HsGroup a
199 appendGroups 
200     HsGroup { 
201         hs_valds  = val_groups1,
202         hs_splcds = spliceds1,
203         hs_tyclds = tyclds1, 
204         hs_instds = instds1,
205         hs_derivds = derivds1,
206         hs_fixds  = fixds1, 
207         hs_defds  = defds1,
208         hs_annds  = annds1,
209         hs_fords  = fords1, 
210         hs_warnds = warnds1,
211         hs_ruleds = rulds1,
212         hs_vects = vects1,
213   hs_docs   = docs1 }
214     HsGroup { 
215         hs_valds  = val_groups2,
216         hs_splcds = spliceds2,
217         hs_tyclds = tyclds2, 
218         hs_instds = instds2,
219         hs_derivds = derivds2,
220         hs_fixds  = fixds2, 
221         hs_defds  = defds2,
222         hs_annds  = annds2,
223         hs_fords  = fords2, 
224         hs_warnds = warnds2,
225         hs_ruleds = rulds2,
226         hs_vects  = vects2,
227         hs_docs   = docs2 }
228   = 
229     HsGroup { 
230         hs_valds  = val_groups1 `plusHsValBinds` val_groups2,
231         hs_splcds = spliceds1 ++ spliceds2, 
232         hs_tyclds = tyclds1 ++ tyclds2, 
233         hs_instds = instds1 ++ instds2,
234         hs_derivds = derivds1 ++ derivds2,
235         hs_fixds  = fixds1 ++ fixds2,
236         hs_annds  = annds1 ++ annds2,
237         hs_defds  = defds1 ++ defds2,
238         hs_fords  = fords1 ++ fords2, 
239         hs_warnds = warnds1 ++ warnds2,
240         hs_ruleds = rulds1 ++ rulds2,
241         hs_vects  = vects1 ++ vects2,
242         hs_docs   = docs1  ++ docs2 }
243 \end{code}
244
245 \begin{code}
246 instance OutputableBndr name => Outputable (HsDecl name) where
247     ppr (TyClD dcl)             = ppr dcl
248     ppr (ValD binds)            = ppr binds
249     ppr (DefD def)              = ppr def
250     ppr (InstD inst)            = ppr inst
251     ppr (DerivD deriv)          = ppr deriv
252     ppr (ForD fd)               = ppr fd
253     ppr (SigD sd)               = ppr sd
254     ppr (RuleD rd)              = ppr rd
255     ppr (VectD vect)            = ppr vect
256     ppr (WarningD wd)           = ppr wd
257     ppr (AnnD ad)               = ppr ad
258     ppr (SpliceD dd)            = ppr dd
259     ppr (DocD doc)              = ppr doc
260     ppr (QuasiQuoteD qq)        = ppr qq
261     ppr (RoleAnnotD ra)         = ppr ra
262
263 instance OutputableBndr name => Outputable (HsGroup name) where
264     ppr (HsGroup { hs_valds  = val_decls,
265                    hs_tyclds = tycl_decls,
266                    hs_instds = inst_decls,
267                    hs_derivds = deriv_decls,
268                    hs_fixds  = fix_decls,
269                    hs_warnds = deprec_decls,
270                    hs_annds  = ann_decls,
271                    hs_fords  = foreign_decls,
272                    hs_defds  = default_decls,
273                    hs_ruleds = rule_decls,
274                    hs_vects  = vect_decls })
275         = vcat_mb empty 
276             [ppr_ds fix_decls, ppr_ds default_decls, 
277              ppr_ds deprec_decls, ppr_ds ann_decls,
278              ppr_ds rule_decls,
279              ppr_ds vect_decls,
280              if isEmptyValBinds val_decls 
281                 then Nothing 
282                 else Just (ppr val_decls),
283              ppr_ds (tyClGroupConcat tycl_decls), 
284              ppr_ds inst_decls,
285              ppr_ds deriv_decls,
286              ppr_ds foreign_decls]
287         where
288           ppr_ds :: Outputable a => [a] -> Maybe SDoc
289           ppr_ds [] = Nothing
290           ppr_ds ds = Just (vcat (map ppr ds))
291
292           vcat_mb :: SDoc -> [Maybe SDoc] -> SDoc
293           -- Concatenate vertically with white-space between non-blanks
294           vcat_mb _    []             = empty
295           vcat_mb gap (Nothing : ds) = vcat_mb gap ds
296           vcat_mb gap (Just d  : ds) = gap $$ d $$ vcat_mb blankLine ds
297
298 data SpliceExplicitFlag = ExplicitSplice | -- <=> $(f x y)
299                           ImplicitSplice   -- <=> f x y,  i.e. a naked top level expression
300     deriving (Data, Typeable)
301
302 type LSpliceDecl name = Located (SpliceDecl name)
303 data SpliceDecl id
304   = SpliceDecl                  -- Top level splice
305         (Located (HsSplice id))
306         SpliceExplicitFlag
307     deriving (Typeable)
308 deriving instance (DataId id) => Data (SpliceDecl id)
309
310 instance OutputableBndr name => Outputable (SpliceDecl name) where
311    ppr (SpliceDecl (L _ e) _) = pprUntypedSplice e
312 \end{code}
313
314
315 %************************************************************************
316 %*                                                                      *
317 \subsection[SynDecl]{@data@, @newtype@ or @type@ (synonym) type declaration}
318 %*                                                                      *
319 %************************************************************************
320
321                 --------------------------------
322                         THE NAMING STORY
323                 --------------------------------
324
325 Here is the story about the implicit names that go with type, class,
326 and instance decls.  It's a bit tricky, so pay attention!
327
328 "Implicit" (or "system") binders
329 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
330   Each data type decl defines 
331         a worker name for each constructor
332         to-T and from-T convertors
333   Each class decl defines
334         a tycon for the class
335         a data constructor for that tycon
336         the worker for that constructor
337         a selector for each superclass
338
339 All have occurrence names that are derived uniquely from their parent
340 declaration.
341
342 None of these get separate definitions in an interface file; they are
343 fully defined by the data or class decl.  But they may *occur* in
344 interface files, of course.  Any such occurrence must haul in the
345 relevant type or class decl.
346
347 Plan of attack:
348  - Ensure they "point to" the parent data/class decl 
349    when loading that decl from an interface file
350    (See RnHiFiles.getSysBinders)
351
352  - When typechecking the decl, we build the implicit TyCons and Ids.
353    When doing so we look them up in the name cache (RnEnv.lookupSysName),
354    to ensure correct module and provenance is set
355
356 These are the two places that we have to conjure up the magic derived
357 names.  (The actual magic is in OccName.mkWorkerOcc, etc.)
358
359 Default methods
360 ~~~~~~~~~~~~~~~
361  - Occurrence name is derived uniquely from the method name
362    E.g. $dmmax
363
364  - If there is a default method name at all, it's recorded in
365    the ClassOpSig (in HsBinds), in the DefMeth field.
366    (DefMeth is defined in Class.lhs)
367
368 Source-code class decls and interface-code class decls are treated subtly
369 differently, which has given me a great deal of confusion over the years.
370 Here's the deal.  (We distinguish the two cases because source-code decls
371 have (Just binds) in the tcdMeths field, whereas interface decls have Nothing.
372
373 In *source-code* class declarations:
374
375  - When parsing, every ClassOpSig gets a DefMeth with a suitable RdrName
376    This is done by RdrHsSyn.mkClassOpSigDM
377
378  - The renamer renames it to a Name
379
380  - During typechecking, we generate a binding for each $dm for 
381    which there's a programmer-supplied default method:
382         class Foo a where
383           op1 :: <type>
384           op2 :: <type>
385           op1 = ...
386    We generate a binding for $dmop1 but not for $dmop2.
387    The Class for Foo has a NoDefMeth for op2 and a DefMeth for op1.
388    The Name for $dmop2 is simply discarded.
389
390 In *interface-file* class declarations:
391   - When parsing, we see if there's an explicit programmer-supplied default method
392     because there's an '=' sign to indicate it:
393         class Foo a where
394           op1 = :: <type>       -- NB the '='
395           op2   :: <type>
396     We use this info to generate a DefMeth with a suitable RdrName for op1,
397     and a NoDefMeth for op2
398   - The interface file has a separate definition for $dmop1, with unfolding etc.
399   - The renamer renames it to a Name.
400   - The renamer treats $dmop1 as a free variable of the declaration, so that
401     the binding for $dmop1 will be sucked in.  (See RnHsSyn.tyClDeclFVs)  
402     This doesn't happen for source code class decls, because they *bind* the default method.
403
404 Dictionary functions
405 ~~~~~~~~~~~~~~~~~~~~
406 Each instance declaration gives rise to one dictionary function binding.
407
408 The type checker makes up new source-code instance declarations
409 (e.g. from 'deriving' or generic default methods --- see
410 TcInstDcls.tcInstDecls1).  So we can't generate the names for
411 dictionary functions in advance (we don't know how many we need).
412
413 On the other hand for interface-file instance declarations, the decl
414 specifies the name of the dictionary function, and it has a binding elsewhere
415 in the interface file:
416         instance {Eq Int} = dEqInt
417         dEqInt :: {Eq Int} <pragma info>
418
419 So again we treat source code and interface file code slightly differently.
420
421 Source code:
422   - Source code instance decls have a Nothing in the (Maybe name) field
423     (see data InstDecl below)
424
425   - The typechecker makes up a Local name for the dict fun for any source-code
426     instance decl, whether it comes from a source-code instance decl, or whether
427     the instance decl is derived from some other construct (e.g. 'deriving').
428
429   - The occurrence name it chooses is derived from the instance decl (just for 
430     documentation really) --- e.g. dNumInt.  Two dict funs may share a common
431     occurrence name, but will have different uniques.  E.g.
432         instance Foo [Int]  where ...
433         instance Foo [Bool] where ...
434     These might both be dFooList
435
436   - The CoreTidy phase externalises the name, and ensures the occurrence name is
437     unique (this isn't special to dict funs).  So we'd get dFooList and dFooList1.
438
439   - We can take this relaxed approach (changing the occurrence name later) 
440     because dict fun Ids are not captured in a TyCon or Class (unlike default
441     methods, say).  Instead, they are kept separately in the InstEnv.  This
442     makes it easy to adjust them after compiling a module.  (Once we've finished
443     compiling that module, they don't change any more.)
444
445
446 Interface file code:
447   - The instance decl gives the dict fun name, so the InstDecl has a (Just name)
448     in the (Maybe name) field.
449
450   - RnHsSyn.instDeclFVs treats the dict fun name as free in the decl, so that we
451     suck in the dfun binding
452
453
454 \begin{code}
455 type LTyClDecl name = Located (TyClDecl name)
456
457 -- | A type or class declaration.
458 data TyClDecl name
459   = ForeignType { 
460                 tcdLName    :: Located name,
461                 tcdExtName  :: Maybe FastString
462     }
463
464   | -- | @type/data family T :: *->*@
465     FamDecl { tcdFam :: FamilyDecl name }
466
467   | -- | @type@ declaration
468     SynDecl { tcdLName  :: Located name            -- ^ Type constructor
469             , tcdTyVars :: LHsTyVarBndrs name      -- ^ Type variables; for an associated type
470                                                   --   these include outer binders
471             , tcdRhs    :: LHsType name            -- ^ RHS of type declaration
472             , tcdFVs    :: PostRn name NameSet }
473
474   | -- | @data@ declaration
475     DataDecl { tcdLName    :: Located name        -- ^ Type constructor
476              , tcdTyVars   :: LHsTyVarBndrs name  -- ^ Type variables; for an assoicated type
477                                                   --   these include outer binders
478                                                   -- Eg  class T a where
479                                                   --       type F a :: *
480                                                   --       type F a = a -> a
481                                                   -- Here the type decl for 'f' includes 'a' 
482                                                   -- in its tcdTyVars
483              , tcdDataDefn :: HsDataDefn name
484              , tcdFVs      :: PostRn name NameSet }
485
486   | ClassDecl { tcdCtxt    :: LHsContext name,          -- ^ Context...
487                 tcdLName   :: Located name,             -- ^ Name of the class
488                 tcdTyVars  :: LHsTyVarBndrs name,       -- ^ Class type variables
489                 tcdFDs     :: [Located (FunDep name)],  -- ^ Functional deps
490                 tcdSigs    :: [LSig name],              -- ^ Methods' signatures
491                 tcdMeths   :: LHsBinds name,            -- ^ Default methods
492                 tcdATs     :: [LFamilyDecl name],       -- ^ Associated types; ie
493                 tcdATDefs  :: [LTyFamDefltEqn name],    -- ^ Associated type defaults
494                 tcdDocs    :: [LDocDecl],               -- ^ Haddock docs
495                 tcdFVs     :: PostRn name NameSet
496     }
497
498   deriving (Typeable)
499 deriving instance (DataId id) => Data (TyClDecl id)
500
501  -- This is used in TcTyClsDecls to represent
502  -- strongly connected components of decls
503  -- No familiy instances in here
504  -- The role annotations must be grouped with their decls for the
505  -- type-checker to infer roles correctly
506 data TyClGroup name
507   = TyClGroup { group_tyclds :: [LTyClDecl name]
508               , group_roles  :: [LRoleAnnotDecl name] }
509     deriving (Typeable)
510 deriving instance (DataId id) => Data (TyClGroup id)
511
512 tyClGroupConcat :: [TyClGroup name] -> [LTyClDecl name]
513 tyClGroupConcat = concatMap group_tyclds
514
515 mkTyClGroup :: [LTyClDecl name] -> TyClGroup name
516 mkTyClGroup decls = TyClGroup { group_tyclds = decls, group_roles = [] }
517
518 type LFamilyDecl name = Located (FamilyDecl name)
519 data FamilyDecl name = FamilyDecl
520   { fdInfo    :: FamilyInfo name            -- type or data, closed or open
521   , fdLName   :: Located name               -- type constructor
522   , fdTyVars  :: LHsTyVarBndrs name         -- type variables
523   , fdKindSig :: Maybe (LHsKind name) }     -- result kind
524   deriving( Typeable )
525 deriving instance (DataId id) => Data (FamilyDecl id)
526
527 data FamilyInfo name
528   = DataFamily
529   | OpenTypeFamily
530      -- this list might be empty, if we're in an hs-boot file and the user
531      -- said "type family Foo x where .."
532   | ClosedTypeFamily [LTyFamInstEqn name]
533   deriving( Typeable )
534 deriving instance (DataId name) => Data (FamilyInfo name)
535
536 \end{code}
537
538 ------------------------------
539 Simple classifiers
540
541 \begin{code}
542 -- | @True@ <=> argument is a @data@\/@newtype@
543 -- declaration.
544 isDataDecl :: TyClDecl name -> Bool
545 isDataDecl (DataDecl {}) = True
546 isDataDecl _other        = False
547
548 -- | type or type instance declaration
549 isSynDecl :: TyClDecl name -> Bool
550 isSynDecl (SynDecl {})   = True
551 isSynDecl _other        = False
552
553 -- | type class
554 isClassDecl :: TyClDecl name -> Bool
555 isClassDecl (ClassDecl {}) = True
556 isClassDecl _              = False
557
558 -- | type/data family declaration
559 isFamilyDecl :: TyClDecl name -> Bool
560 isFamilyDecl (FamDecl {})  = True
561 isFamilyDecl _other        = False
562
563 -- | type family declaration
564 isTypeFamilyDecl :: TyClDecl name -> Bool
565 isTypeFamilyDecl (FamDecl (FamilyDecl { fdInfo = info })) = case info of
566   OpenTypeFamily      -> True
567   ClosedTypeFamily {} -> True
568   _                   -> False
569 isTypeFamilyDecl _ = False
570
571 -- | open type family info
572 isOpenTypeFamilyInfo :: FamilyInfo name -> Bool
573 isOpenTypeFamilyInfo OpenTypeFamily = True
574 isOpenTypeFamilyInfo _              = False
575
576 -- | closed type family info
577 isClosedTypeFamilyInfo :: FamilyInfo name -> Bool
578 isClosedTypeFamilyInfo (ClosedTypeFamily {}) = True
579 isClosedTypeFamilyInfo _                     = False
580
581 -- | data family declaration
582 isDataFamilyDecl :: TyClDecl name -> Bool
583 isDataFamilyDecl (FamDecl (FamilyDecl { fdInfo = DataFamily })) = True
584 isDataFamilyDecl _other      = False
585
586 \end{code}
587
588 Dealing with names
589
590 \begin{code}
591 tyFamInstDeclName :: OutputableBndr name
592                   => TyFamInstDecl name -> name
593 tyFamInstDeclName = unLoc . tyFamInstDeclLName
594
595 tyFamInstDeclLName :: OutputableBndr name
596                    => TyFamInstDecl name -> Located name
597 tyFamInstDeclLName (TyFamInstDecl { tfid_eqn =
598                      (L _ (TyFamEqn { tfe_tycon = ln })) })
599   = ln
600
601 tyClDeclLName :: TyClDecl name -> Located name
602 tyClDeclLName (FamDecl { tcdFam = FamilyDecl { fdLName = ln } }) = ln
603 tyClDeclLName decl = tcdLName decl
604
605 tcdName :: TyClDecl name -> name
606 tcdName = unLoc . tyClDeclLName
607
608 tyClDeclTyVars :: OutputableBndr name => TyClDecl name -> LHsTyVarBndrs name
609 tyClDeclTyVars decl@(ForeignType {}) = pprPanic "tyClDeclTyVars" (ppr decl)
610 tyClDeclTyVars (FamDecl { tcdFam = FamilyDecl { fdTyVars = tvs } }) = tvs
611 tyClDeclTyVars d = tcdTyVars d
612 \end{code}
613
614 \begin{code}
615 countTyClDecls :: [TyClDecl name] -> (Int, Int, Int, Int, Int)
616         -- class, synonym decls, data, newtype, family decls
617 countTyClDecls decls 
618  = (count isClassDecl    decls,
619     count isSynDecl      decls,  -- excluding...
620     count isDataTy       decls,  -- ...family...
621     count isNewTy        decls,  -- ...instances
622     count isFamilyDecl   decls)
623  where
624    isDataTy DataDecl{ tcdDataDefn = HsDataDefn { dd_ND = DataType } } = True
625    isDataTy _                                                       = False
626    
627    isNewTy DataDecl{ tcdDataDefn = HsDataDefn { dd_ND = NewType } } = True
628    isNewTy _                                                      = False
629
630 -- | Does this declaration have a complete, user-supplied kind signature?
631 -- See Note [Complete user-supplied kind signatures]
632 hsDeclHasCusk :: TyClDecl name -> Bool
633 hsDeclHasCusk (ForeignType {}) = True
634 hsDeclHasCusk (FamDecl { tcdFam = fam_decl }) = famDeclHasCusk fam_decl
635 hsDeclHasCusk (SynDecl { tcdTyVars = tyvars, tcdRhs = rhs })
636   = hsTvbAllKinded tyvars && rhs_annotated rhs
637   where
638     rhs_annotated (L _ ty) = case ty of
639       HsParTy lty  -> rhs_annotated lty
640       HsKindSig {} -> True
641       _            -> False
642 hsDeclHasCusk (DataDecl { tcdTyVars = tyvars })  = hsTvbAllKinded tyvars
643 hsDeclHasCusk (ClassDecl { tcdTyVars = tyvars }) = hsTvbAllKinded tyvars
644
645 -- | Does this family declaration have a complete, user-supplied kind signature?
646 famDeclHasCusk :: FamilyDecl name -> Bool
647 famDeclHasCusk (FamilyDecl { fdInfo = ClosedTypeFamily _
648                            , fdTyVars = tyvars
649                            , fdKindSig = m_sig })
650   = hsTvbAllKinded tyvars && isJust m_sig
651 famDeclHasCusk _ = True  -- all open families have CUSKs!
652 \end{code}
653
654 Note [Complete user-supplied kind signatures]
655 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
656 We kind-check declarations differently if they have a complete, user-supplied
657 kind signature (CUSK). This is because we can safely generalise a CUSKed
658 declaration before checking all of the others, supporting polymorphic recursion.
659 See https://ghc.haskell.org/trac/ghc/wiki/GhcKinds/KindInference#Proposednewstrategy
660 and #9200 for lots of discussion of how we got here.
661
662 A declaration has a CUSK if we can know its complete kind without doing any inference,
663 at all. Here are the rules:
664
665  - A class or datatype is said to have a CUSK if and only if all of its type
666 variables are annotated. Its result kind is, by construction, Constraint or *
667 respectively.
668
669  - A type synonym has a CUSK if and only if all of its type variables and its
670 RHS are annotated with kinds.
671
672  - A closed type family is said to have a CUSK if and only if all of its type
673 variables and its return type are annotated.
674
675  - An open type family always has a CUSK -- unannotated type variables (and return type) default to *.
676
677 \begin{code}
678 instance OutputableBndr name
679               => Outputable (TyClDecl name) where
680
681     ppr (ForeignType {tcdLName = ltycon})
682         = hsep [ptext (sLit "foreign import type dotnet"), ppr ltycon]
683
684     ppr (FamDecl { tcdFam = decl }) = ppr decl
685     ppr (SynDecl { tcdLName = ltycon, tcdTyVars = tyvars, tcdRhs = rhs })
686       = hang (ptext (sLit "type") <+>
687               pp_vanilla_decl_head ltycon tyvars [] <+> equals)
688           4 (ppr rhs) 
689
690     ppr (DataDecl { tcdLName = ltycon, tcdTyVars = tyvars, tcdDataDefn = defn })
691       = pp_data_defn (pp_vanilla_decl_head ltycon tyvars) defn
692
693     ppr (ClassDecl {tcdCtxt = context, tcdLName = lclas, tcdTyVars = tyvars, 
694                     tcdFDs  = fds,
695                     tcdSigs = sigs, tcdMeths = methods,
696                     tcdATs = ats, tcdATDefs = at_defs})
697       | null sigs && isEmptyBag methods && null ats && null at_defs -- No "where" part
698       = top_matter
699
700       | otherwise       -- Laid out
701       = vcat [ top_matter <+> ptext (sLit "where")
702              , nest 2 $ pprDeclList (map ppr ats ++
703                                      map ppr_fam_deflt_eqn at_defs ++
704                                      pprLHsBindsForUser methods sigs) ]
705       where
706         top_matter = ptext (sLit "class") 
707                      <+> pp_vanilla_decl_head lclas tyvars (unLoc context)
708                      <+> pprFundeps (map unLoc fds)
709
710 instance OutputableBndr name => Outputable (TyClGroup name) where
711   ppr (TyClGroup { group_tyclds = tyclds, group_roles = roles })
712     = ppr tyclds $$
713       ppr roles
714
715 instance (OutputableBndr name) => Outputable (FamilyDecl name) where
716   ppr (FamilyDecl { fdInfo = info, fdLName = ltycon, 
717                     fdTyVars = tyvars, fdKindSig = mb_kind})
718       = vcat [ pprFlavour info <+> pp_vanilla_decl_head ltycon tyvars [] <+> pp_kind <+> pp_where
719              , nest 2 $ pp_eqns ]
720         where
721           pp_kind = case mb_kind of
722                       Nothing   -> empty
723                       Just kind -> dcolon <+> ppr kind
724           (pp_where, pp_eqns) = case info of
725             ClosedTypeFamily eqns -> ( ptext (sLit "where")
726                                      , if null eqns
727                                        then ptext (sLit "..")
728                                        else vcat $ map ppr_fam_inst_eqn eqns )
729             _                     -> (empty, empty)
730
731 pprFlavour :: FamilyInfo name -> SDoc
732 pprFlavour DataFamily            = ptext (sLit "data family")
733 pprFlavour OpenTypeFamily        = ptext (sLit "type family")
734 pprFlavour (ClosedTypeFamily {}) = ptext (sLit "type family")
735
736 instance Outputable (FamilyInfo name) where
737   ppr = pprFlavour
738
739 pp_vanilla_decl_head :: OutputableBndr name
740    => Located name
741    -> LHsTyVarBndrs name
742    -> HsContext name
743    -> SDoc
744 pp_vanilla_decl_head thing tyvars context
745  = hsep [pprHsContext context, pprPrefixOcc (unLoc thing), ppr tyvars]
746
747 pp_fam_inst_lhs :: OutputableBndr name
748    => Located name
749    -> HsTyPats name
750    -> HsContext name
751    -> SDoc
752 pp_fam_inst_lhs thing (HsWB { hswb_cts = typats }) context -- explicit type patterns
753    = hsep [ pprHsContext context, pprPrefixOcc (unLoc thing)
754           , hsep (map (pprParendHsType.unLoc) typats)]
755
756 pprTyClDeclFlavour :: TyClDecl a -> SDoc
757 pprTyClDeclFlavour (ClassDecl {})   = ptext (sLit "class")
758 pprTyClDeclFlavour (SynDecl {})     = ptext (sLit "type")
759 pprTyClDeclFlavour (ForeignType {}) = ptext (sLit "foreign type")
760 pprTyClDeclFlavour (FamDecl { tcdFam = FamilyDecl { fdInfo = info }})
761   = pprFlavour info
762 pprTyClDeclFlavour (DataDecl { tcdDataDefn = HsDataDefn { dd_ND = nd } })
763   = ppr nd
764 \end{code}
765
766 %************************************************************************
767 %*                                                                      *
768 \subsection[ConDecl]{A data-constructor declaration}
769 %*                                                                      *
770 %************************************************************************
771
772 \begin{code}
773
774 data HsDataDefn name   -- The payload of a data type defn
775                        -- Used *both* for vanilla data declarations,
776                        --       *and* for data family instances
777   = -- | Declares a data type or newtype, giving its constructors
778     -- @
779     --  data/newtype T a = <constrs>
780     --  data/newtype instance T [a] = <constrs>
781     -- @
782     HsDataDefn { dd_ND     :: NewOrData,
783                  dd_ctxt   :: LHsContext name,           -- ^ Context
784                  dd_cType  :: Maybe CType,
785                  dd_kindSig:: Maybe (LHsKind name),
786                      -- ^ Optional kind signature.
787                      --
788                      -- @(Just k)@ for a GADT-style @data@, 
789                      -- or @data instance@ decl, with explicit kind sig
790                      --
791                      -- Always @Nothing@ for H98-syntax decls
792
793                  dd_cons   :: [LConDecl name],
794                      -- ^ Data constructors
795                      --
796                      -- For @data T a = T1 | T2 a@
797                      --   the 'LConDecl's all have 'ResTyH98'.
798                      -- For @data T a where { T1 :: T a }@
799                      --   the 'LConDecls' all have 'ResTyGADT'.
800
801                  dd_derivs :: Maybe [LHsType name]
802                      -- ^ Derivings; @Nothing@ => not specified,
803                      --              @Just []@ => derive exactly what is asked
804                      --
805                      -- These "types" must be of form
806                      -- @
807                      --      forall ab. C ty1 ty2
808                      -- @
809                      -- Typically the foralls and ty args are empty, but they
810                      -- are non-empty for the newtype-deriving case
811     }
812     deriving( Typeable )
813 deriving instance (DataId id) => Data (HsDataDefn id)
814
815 data NewOrData
816   = NewType                     -- ^ @newtype Blah ...@
817   | DataType                    -- ^ @data Blah ...@
818   deriving( Eq, Data, Typeable )                -- Needed because Demand derives Eq
819
820 type LConDecl name = Located (ConDecl name)
821
822 -- data T b = forall a. Eq a => MkT a b
823 --   MkT :: forall b a. Eq a => MkT a b
824
825 -- data T b where
826 --      MkT1 :: Int -> T Int
827
828 -- data T = Int `MkT` Int
829 --        | MkT2
830
831 -- data T a where
832 --      Int `MkT` Int :: T Int
833
834 data ConDecl name
835   = ConDecl
836     { con_name      :: Located name
837         -- ^ Constructor name.  This is used for the DataCon itself, and for
838         -- the user-callable wrapper Id.
839
840     , con_explicit  :: HsExplicitFlag
841         -- ^ Is there an user-written forall? (cf. 'HsTypes.HsForAllTy')
842
843     , con_qvars     :: LHsTyVarBndrs name
844         -- ^ Type variables.  Depending on 'con_res' this describes the
845         -- following entities
846         --
847         --  - ResTyH98:  the constructor's *existential* type variables
848         --  - ResTyGADT: *all* the constructor's quantified type variables
849         --
850         -- If con_explicit is Implicit, then con_qvars is irrelevant
851         -- until after renaming.  
852
853     , con_cxt       :: LHsContext name
854         -- ^ The context.  This /does not/ include the \"stupid theta\" which
855         -- lives only in the 'TyData' decl.
856
857     , con_details   :: HsConDeclDetails name
858         -- ^ The main payload
859
860     , con_res       :: ResType (LHsType name)
861         -- ^ Result type of the constructor
862
863     , con_doc       :: Maybe LHsDocString
864         -- ^ A possible Haddock comment.
865
866     , con_old_rec :: Bool
867         -- ^ TEMPORARY field; True <=> user has employed now-deprecated syntax for
868         --                             GADT-style record decl   C { blah } :: T a b
869         -- Remove this when we no longer parse this stuff, and hence do not
870         -- need to report decprecated use
871     } deriving (Typeable)
872 deriving instance (DataId name) => Data (ConDecl name)
873
874 type HsConDeclDetails name = HsConDetails (LBangType name) [ConDeclField name]
875
876 hsConDeclArgTys :: HsConDeclDetails name -> [LBangType name]
877 hsConDeclArgTys (PrefixCon tys)    = tys
878 hsConDeclArgTys (InfixCon ty1 ty2) = [ty1,ty2]
879 hsConDeclArgTys (RecCon flds)      = map cd_fld_type flds
880
881 data ResType ty
882    = ResTyH98           -- Constructor was declared using Haskell 98 syntax
883    | ResTyGADT ty       -- Constructor was declared using GADT-style syntax,
884                         --      and here is its result type
885    deriving (Data, Typeable)
886
887 instance Outputable ty => Outputable (ResType ty) where
888          -- Debugging only
889    ppr ResTyH98       = ptext (sLit "ResTyH98")
890    ppr (ResTyGADT ty) = ptext (sLit "ResTyGADT") <+> ppr ty
891 \end{code}
892
893
894 \begin{code}
895 pp_data_defn :: OutputableBndr name
896                   => (HsContext name -> SDoc)   -- Printing the header
897                   -> HsDataDefn name
898                   -> SDoc 
899 pp_data_defn pp_hdr (HsDataDefn { dd_ND = new_or_data, dd_ctxt = L _ context
900                                 , dd_kindSig = mb_sig 
901                                 , dd_cons = condecls, dd_derivs = derivings })
902   | null condecls
903   = ppr new_or_data <+> pp_hdr context <+> pp_sig
904
905   | otherwise
906   = hang (ppr new_or_data <+> pp_hdr context <+> pp_sig)
907        2 (pp_condecls condecls $$ pp_derivings)
908   where
909     pp_sig = case mb_sig of
910                Nothing   -> empty
911                Just kind -> dcolon <+> ppr kind
912     pp_derivings = case derivings of
913                      Nothing -> empty
914                      Just ds -> hsep [ptext (sLit "deriving"), parens (interpp'SP ds)]
915
916 instance OutputableBndr name => Outputable (HsDataDefn name) where
917    ppr d = pp_data_defn (\_ -> ptext (sLit "Naked HsDataDefn")) d
918
919 instance Outputable NewOrData where
920   ppr NewType  = ptext (sLit "newtype")
921   ppr DataType = ptext (sLit "data")
922
923 pp_condecls :: OutputableBndr name => [LConDecl name] -> SDoc
924 pp_condecls cs@(L _ ConDecl{ con_res = ResTyGADT _ } : _) -- In GADT syntax
925   = hang (ptext (sLit "where")) 2 (vcat (map ppr cs))
926 pp_condecls cs                    -- In H98 syntax
927   = equals <+> sep (punctuate (ptext (sLit " |")) (map ppr cs))
928
929 instance (OutputableBndr name) => Outputable (ConDecl name) where
930     ppr = pprConDecl
931
932 pprConDecl :: OutputableBndr name => ConDecl name -> SDoc
933 pprConDecl (ConDecl { con_name = con, con_explicit = expl, con_qvars = tvs
934                     , con_cxt = cxt, con_details = details
935                     , con_res = ResTyH98, con_doc = doc })
936   = sep [ppr_mbDoc doc, pprHsForAll expl tvs cxt, ppr_details details]
937   where
938     ppr_details (InfixCon t1 t2) = hsep [ppr t1, pprInfixOcc (unLoc con), ppr t2]
939     ppr_details (PrefixCon tys)  = hsep (pprPrefixOcc (unLoc con) : map (pprParendHsType . unLoc) tys)
940     ppr_details (RecCon fields)  = ppr con <+> pprConDeclFields fields
941
942 pprConDecl (ConDecl { con_name = con, con_explicit = expl, con_qvars = tvs
943                     , con_cxt = cxt, con_details = PrefixCon arg_tys
944                     , con_res = ResTyGADT res_ty })
945   = ppr con <+> dcolon <+> 
946     sep [pprHsForAll expl tvs cxt, ppr (foldr mk_fun_ty res_ty arg_tys)]
947   where
948     mk_fun_ty a b = noLoc (HsFunTy a b)
949
950 pprConDecl (ConDecl { con_name = con, con_explicit = expl, con_qvars = tvs
951                     , con_cxt = cxt, con_details = RecCon fields, con_res = ResTyGADT res_ty })
952   = sep [ppr con <+> dcolon <+> pprHsForAll expl tvs cxt, 
953          pprConDeclFields fields <+> arrow <+> ppr res_ty]
954
955 pprConDecl decl@(ConDecl { con_details = InfixCon ty1 ty2, con_res = ResTyGADT {} })
956   = pprConDecl (decl { con_details = PrefixCon [ty1,ty2] })
957         -- In GADT syntax we don't allow infix constructors
958         -- but the renamer puts them in this form (Note [Infix GADT constructors] in RnSource)
959 \end{code}
960
961 %************************************************************************
962 %*                                                                      *
963                 Instance declarations
964 %*                                                                      *
965 %************************************************************************
966
967 Note [Type family instance declarations in HsSyn]
968 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
969 The data type TyFamEqn represents one equation of a type family instance.
970 It is parameterised over its tfe_pats field:
971
972  * An ordinary type family instance declaration looks like this in source Haskell
973       type instance T [a] Int = a -> a
974    (or something similar for a closed family)
975    It is represented by a TyFamInstEqn, with *type* in the tfe_pats field.
976
977  * On the other hand, the *default instance* of an associated type looksl like
978    this in source Haskell
979       class C a where
980         type T a b
981         type T a b = a -> b   -- The default instance
982    It is represented by a TyFamDefltEqn, with *type variables8 in the tfe_pats field.
983
984 \begin{code}
985 ----------------- Type synonym family instances -------------
986 type LTyFamInstEqn  name = Located (TyFamInstEqn  name)
987 type LTyFamDefltEqn name = Located (TyFamDefltEqn name)
988
989 type HsTyPats name = HsWithBndrs name [LHsType name]
990             -- ^ Type patterns (with kind and type bndrs)
991             -- See Note [Family instance declaration binders]
992
993 type TyFamInstEqn  name = TyFamEqn name (HsTyPats name)
994 type TyFamDefltEqn name = TyFamEqn name (LHsTyVarBndrs name)
995   -- See Note [Type family instance declarations in HsSyn]
996
997 -- | One equation in a type family instance declaration
998 -- See Note [Type family instance declarations in HsSyn]
999 data TyFamEqn name pats
1000   = TyFamEqn
1001        { tfe_tycon :: Located name
1002        , tfe_pats  :: pats
1003        , tfe_rhs   :: LHsType name }
1004   deriving( Typeable )
1005 deriving instance (DataId name, Data pats) => Data (TyFamEqn name pats)
1006
1007 type LTyFamInstDecl name = Located (TyFamInstDecl name)
1008 data TyFamInstDecl name
1009   = TyFamInstDecl
1010        { tfid_eqn  :: LTyFamInstEqn name
1011        , tfid_fvs  :: PostRn name NameSet }
1012   deriving( Typeable )
1013 deriving instance (DataId name) => Data (TyFamInstDecl name)
1014
1015 ----------------- Data family instances -------------
1016
1017 type LDataFamInstDecl name = Located (DataFamInstDecl name)
1018 data DataFamInstDecl name
1019   = DataFamInstDecl
1020        { dfid_tycon :: Located name
1021        , dfid_pats  :: HsTyPats name      -- LHS
1022        , dfid_defn  :: HsDataDefn  name   -- RHS
1023        , dfid_fvs   :: PostRn name NameSet } -- Rree vars for
1024                                                -- dependency analysis
1025   deriving( Typeable )
1026 deriving instance (DataId name) => Data (DataFamInstDecl name)
1027
1028
1029 ----------------- Class instances -------------
1030
1031 type LClsInstDecl name = Located (ClsInstDecl name)
1032 data ClsInstDecl name
1033   = ClsInstDecl
1034       { cid_poly_ty :: LHsType name    -- Context => Class Instance-type
1035                                        -- Using a polytype means that the renamer conveniently
1036                                        -- figures out the quantified type variables for us.
1037       , cid_binds         :: LHsBinds name           -- Class methods
1038       , cid_sigs          :: [LSig name]             -- User-supplied pragmatic info
1039       , cid_tyfam_insts   :: [LTyFamInstDecl name]   -- Type family instances
1040       , cid_datafam_insts :: [LDataFamInstDecl name] -- Data family instances
1041       , cid_overlap_mode :: Maybe OverlapMode
1042       }
1043   deriving (Typeable)
1044 deriving instance (DataId id) => Data (ClsInstDecl id)
1045
1046
1047 ----------------- Instances of all kinds -------------
1048
1049 type LInstDecl name = Located (InstDecl name)
1050 data InstDecl name  -- Both class and family instances
1051   = ClsInstD    
1052       { cid_inst  :: ClsInstDecl name }
1053   | DataFamInstD              -- data family instance
1054       { dfid_inst :: DataFamInstDecl name }
1055   | TyFamInstD              -- type family instance
1056       { tfid_inst :: TyFamInstDecl name }
1057   deriving (Typeable)
1058 deriving instance (DataId id) => Data (InstDecl id)
1059 \end{code}
1060
1061 Note [Family instance declaration binders]
1062 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1063 A {Ty|Data}FamInstDecl is a data/type family instance declaration
1064 the pats field is LHS patterns, and the tvs of the HsBSig
1065 tvs are fv(pat_tys), *including* ones that are already in scope
1066
1067    Eg   class C s t where
1068           type F t p :: *
1069         instance C w (a,b) where
1070           type F (a,b) x = x->a
1071    The tcdTyVars of the F decl are {a,b,x}, even though the F decl
1072    is nested inside the 'instance' decl. 
1073
1074    However after the renamer, the uniques will match up:
1075         instance C w7 (a8,b9) where
1076           type F (a8,b9) x10 = x10->a8
1077    so that we can compare the type patter in the 'instance' decl and
1078    in the associated 'type' decl
1079
1080 \begin{code}
1081 instance (OutputableBndr name) => Outputable (TyFamInstDecl name) where
1082   ppr = pprTyFamInstDecl TopLevel
1083
1084 pprTyFamInstDecl :: OutputableBndr name => TopLevelFlag -> TyFamInstDecl name -> SDoc
1085 pprTyFamInstDecl top_lvl (TyFamInstDecl { tfid_eqn = eqn })
1086    = ptext (sLit "type") <+> ppr_instance_keyword top_lvl <+> ppr_fam_inst_eqn eqn
1087
1088 ppr_instance_keyword :: TopLevelFlag -> SDoc
1089 ppr_instance_keyword TopLevel    = ptext (sLit "instance")
1090 ppr_instance_keyword NotTopLevel = empty
1091
1092 ppr_fam_inst_eqn :: OutputableBndr name => LTyFamInstEqn name -> SDoc
1093 ppr_fam_inst_eqn (L _ (TyFamEqn { tfe_tycon = tycon
1094                                 , tfe_pats  = pats
1095                                 , tfe_rhs   = rhs }))
1096     = pp_fam_inst_lhs tycon pats [] <+> equals <+> ppr rhs
1097
1098 ppr_fam_deflt_eqn :: OutputableBndr name => LTyFamDefltEqn name -> SDoc
1099 ppr_fam_deflt_eqn (L _ (TyFamEqn { tfe_tycon = tycon
1100                                  , tfe_pats  = tvs
1101                                  , tfe_rhs   = rhs }))
1102     = pp_vanilla_decl_head tycon tvs [] <+> equals <+> ppr rhs
1103
1104 instance (OutputableBndr name) => Outputable (DataFamInstDecl name) where
1105   ppr = pprDataFamInstDecl TopLevel
1106
1107 pprDataFamInstDecl :: OutputableBndr name => TopLevelFlag -> DataFamInstDecl name -> SDoc
1108 pprDataFamInstDecl top_lvl (DataFamInstDecl { dfid_tycon = tycon
1109                                             , dfid_pats  = pats  
1110                                             , dfid_defn  = defn })
1111   = pp_data_defn pp_hdr defn
1112   where
1113     pp_hdr ctxt = ppr_instance_keyword top_lvl <+> pp_fam_inst_lhs tycon pats ctxt
1114
1115 pprDataFamInstFlavour :: DataFamInstDecl name -> SDoc
1116 pprDataFamInstFlavour (DataFamInstDecl { dfid_defn = (HsDataDefn { dd_ND = nd }) })
1117   = ppr nd
1118
1119 instance (OutputableBndr name) => Outputable (ClsInstDecl name) where
1120     ppr (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = binds
1121                      , cid_sigs = sigs, cid_tyfam_insts = ats
1122                      , cid_overlap_mode = mbOverlap
1123                      , cid_datafam_insts = adts })
1124       | null sigs, null ats, null adts, isEmptyBag binds  -- No "where" part
1125       = top_matter
1126
1127       | otherwise       -- Laid out
1128       = vcat [ top_matter <+> ptext (sLit "where")
1129              , nest 2 $ pprDeclList $
1130                map (pprTyFamInstDecl NotTopLevel . unLoc)   ats ++
1131                map (pprDataFamInstDecl NotTopLevel . unLoc) adts ++
1132                pprLHsBindsForUser binds sigs ]
1133       where
1134         top_matter = ptext (sLit "instance") <+> ppOverlapPragma mbOverlap
1135                                              <+> ppr inst_ty
1136
1137 ppOverlapPragma :: Maybe OverlapMode -> SDoc
1138 ppOverlapPragma mb =
1139   case mb of
1140     Nothing           -> empty
1141     Just NoOverlap    -> ptext (sLit "{-# NO_OVERLAP #-}")
1142     Just Overlappable -> ptext (sLit "{-# OVERLAPPABLE #-}")
1143     Just Overlapping  -> ptext (sLit "{-# OVERLAPPING #-}")
1144     Just Overlaps     -> ptext (sLit "{-# OVERLAPS #-}")
1145     Just Incoherent   -> ptext (sLit "{-# INCOHERENT #-}")
1146
1147
1148
1149
1150 instance (OutputableBndr name) => Outputable (InstDecl name) where
1151     ppr (ClsInstD     { cid_inst  = decl }) = ppr decl
1152     ppr (TyFamInstD   { tfid_inst = decl }) = ppr decl
1153     ppr (DataFamInstD { dfid_inst = decl }) = ppr decl
1154
1155 -- Extract the declarations of associated data types from an instance
1156
1157 instDeclDataFamInsts :: [LInstDecl name] -> [DataFamInstDecl name]
1158 instDeclDataFamInsts inst_decls 
1159   = concatMap do_one inst_decls
1160   where
1161     do_one (L _ (ClsInstD { cid_inst = ClsInstDecl { cid_datafam_insts = fam_insts } }))
1162       = map unLoc fam_insts
1163     do_one (L _ (DataFamInstD { dfid_inst = fam_inst }))      = [fam_inst]
1164     do_one (L _ (TyFamInstD {}))                              = []
1165 \end{code}
1166
1167 %************************************************************************
1168 %*                                                                      *
1169 \subsection[DerivDecl]{A stand-alone instance deriving declaration}
1170 %*                                                                      *
1171 %************************************************************************
1172
1173 \begin{code}
1174 type LDerivDecl name = Located (DerivDecl name)
1175
1176 data DerivDecl name = DerivDecl { deriv_type :: LHsType name
1177                                 , deriv_overlap_mode :: Maybe OverlapMode
1178                                 }
1179   deriving (Typeable)
1180 deriving instance (DataId name) => Data (DerivDecl name)
1181
1182 instance (OutputableBndr name) => Outputable (DerivDecl name) where
1183     ppr (DerivDecl ty o)
1184         = hsep [ptext (sLit "deriving instance"), ppOverlapPragma o, ppr ty]
1185 \end{code}
1186
1187 %************************************************************************
1188 %*                                                                      *
1189 \subsection[DefaultDecl]{A @default@ declaration}
1190 %*                                                                      *
1191 %************************************************************************
1192
1193 There can only be one default declaration per module, but it is hard
1194 for the parser to check that; we pass them all through in the abstract
1195 syntax, and that restriction must be checked in the front end.
1196
1197 \begin{code}
1198 type LDefaultDecl name = Located (DefaultDecl name)
1199
1200 data DefaultDecl name
1201   = DefaultDecl [LHsType name]
1202   deriving (Typeable)
1203 deriving instance (DataId name) => Data (DefaultDecl name)
1204
1205 instance (OutputableBndr name)
1206               => Outputable (DefaultDecl name) where
1207
1208     ppr (DefaultDecl tys)
1209       = ptext (sLit "default") <+> parens (interpp'SP tys)
1210 \end{code}
1211
1212 %************************************************************************
1213 %*                                                                      *
1214 \subsection{Foreign function interface declaration}
1215 %*                                                                      *
1216 %************************************************************************
1217
1218 \begin{code}
1219
1220 -- foreign declarations are distinguished as to whether they define or use a
1221 -- Haskell name
1222 --
1223 --  * the Boolean value indicates whether the pre-standard deprecated syntax
1224 --   has been used
1225 --
1226 type LForeignDecl name = Located (ForeignDecl name)
1227
1228 data ForeignDecl name
1229   = ForeignImport (Located name) -- defines this name
1230                   (LHsType name) -- sig_ty
1231                   (PostTc name Coercion) -- rep_ty ~ sig_ty
1232                   ForeignImport
1233   | ForeignExport (Located name) -- uses this name
1234                   (LHsType name) -- sig_ty
1235                   (PostTc name Coercion)  -- sig_ty ~ rep_ty
1236                   ForeignExport
1237   deriving (Typeable)
1238 deriving instance (DataId name) => Data (ForeignDecl name)
1239 {-
1240     In both ForeignImport and ForeignExport:
1241         sig_ty is the type given in the Haskell code
1242         rep_ty is the representation for this type, i.e. with newtypes
1243                coerced away and type functions evaluated.
1244     Thus if the declaration is valid, then rep_ty will only use types
1245     such as Int and IO that we know how to make foreign calls with.
1246 -}
1247
1248 noForeignImportCoercionYet :: PlaceHolder
1249 noForeignImportCoercionYet = PlaceHolder
1250
1251 noForeignExportCoercionYet :: PlaceHolder
1252 noForeignExportCoercionYet = PlaceHolder
1253
1254 -- Specification Of an imported external entity in dependence on the calling
1255 -- convention 
1256 --
1257 data ForeignImport = -- import of a C entity
1258                      --
1259                      --  * the two strings specifying a header file or library
1260                      --   may be empty, which indicates the absence of a
1261                      --   header or object specification (both are not used
1262                      --   in the case of `CWrapper' and when `CFunction'
1263                      --   has a dynamic target)
1264                      --
1265                      --  * the calling convention is irrelevant for code
1266                      --   generation in the case of `CLabel', but is needed
1267                      --   for pretty printing 
1268                      --
1269                      --  * `Safety' is irrelevant for `CLabel' and `CWrapper'
1270                      --
1271                      CImport  CCallConv       -- ccall or stdcall
1272                               Safety          -- interruptible, safe or unsafe
1273                               (Maybe Header)  -- name of C header
1274                               CImportSpec     -- details of the C entity
1275   deriving (Data, Typeable)
1276
1277 -- details of an external C entity
1278 --
1279 data CImportSpec = CLabel    CLabelString     -- import address of a C label
1280                  | CFunction CCallTarget      -- static or dynamic function
1281                  | CWrapper                   -- wrapper to expose closures
1282                                               -- (former f.e.d.)
1283   deriving (Data, Typeable)
1284
1285 -- specification of an externally exported entity in dependence on the calling
1286 -- convention
1287 --
1288 data ForeignExport = CExport  CExportSpec    -- contains the calling convention
1289   deriving (Data, Typeable)
1290
1291 -- pretty printing of foreign declarations
1292 --
1293
1294 instance OutputableBndr name => Outputable (ForeignDecl name) where
1295   ppr (ForeignImport n ty _ fimport) =
1296     hang (ptext (sLit "foreign import") <+> ppr fimport <+> ppr n)
1297        2 (dcolon <+> ppr ty)
1298   ppr (ForeignExport n ty _ fexport) =
1299     hang (ptext (sLit "foreign export") <+> ppr fexport <+> ppr n)
1300        2 (dcolon <+> ppr ty)
1301
1302 instance Outputable ForeignImport where
1303   ppr (CImport  cconv safety mHeader spec) =
1304     ppr cconv <+> ppr safety <+> 
1305     char '"' <> pprCEntity spec <> char '"'
1306     where
1307       pp_hdr = case mHeader of
1308                Nothing -> empty
1309                Just (Header header) -> ftext header
1310
1311       pprCEntity (CLabel lbl) = 
1312         ptext (sLit "static") <+> pp_hdr <+> char '&' <> ppr lbl
1313       pprCEntity (CFunction (StaticTarget lbl _ isFun)) = 
1314             ptext (sLit "static")
1315         <+> pp_hdr
1316         <+> (if isFun then empty else ptext (sLit "value"))
1317         <+> ppr lbl
1318       pprCEntity (CFunction (DynamicTarget)) =
1319         ptext (sLit "dynamic")
1320       pprCEntity (CWrapper) = ptext (sLit "wrapper")
1321
1322 instance Outputable ForeignExport where
1323   ppr (CExport  (CExportStatic lbl cconv)) = 
1324     ppr cconv <+> char '"' <> ppr lbl <> char '"'
1325 \end{code}
1326
1327
1328 %************************************************************************
1329 %*                                                                      *
1330 \subsection{Transformation rules}
1331 %*                                                                      *
1332 %************************************************************************
1333
1334 \begin{code}
1335 type LRuleDecl name = Located (RuleDecl name)
1336
1337 data RuleDecl name
1338   = HsRule                      -- Source rule
1339         RuleName                -- Rule name
1340         Activation
1341         [RuleBndr name]         -- Forall'd vars; after typechecking this includes tyvars
1342         (Located (HsExpr name)) -- LHS
1343         (PostRn name NameSet)        -- Free-vars from the LHS
1344         (Located (HsExpr name)) -- RHS
1345         (PostRn name NameSet)        -- Free-vars from the RHS
1346   deriving (Typeable)
1347 deriving instance (DataId name) => Data (RuleDecl name)
1348
1349 data RuleBndr name
1350   = RuleBndr (Located name)
1351   | RuleBndrSig (Located name) (HsWithBndrs name (LHsType name))
1352   deriving (Typeable)
1353 deriving instance (DataId name) => Data (RuleBndr name)
1354
1355 collectRuleBndrSigTys :: [RuleBndr name] -> [HsWithBndrs name (LHsType name)]
1356 collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ ty <- bndrs]
1357
1358 instance OutputableBndr name => Outputable (RuleDecl name) where
1359   ppr (HsRule name act ns lhs _fv_lhs rhs _fv_rhs)
1360         = sep [text "{-# RULES" <+> doubleQuotes (ftext name) <+> ppr act,
1361                nest 4 (pp_forall <+> pprExpr (unLoc lhs)), 
1362                nest 4 (equals <+> pprExpr (unLoc rhs) <+> text "#-}") ]
1363         where
1364           pp_forall | null ns   = empty
1365                     | otherwise = forAllLit <+> fsep (map ppr ns) <> dot
1366
1367 instance OutputableBndr name => Outputable (RuleBndr name) where
1368    ppr (RuleBndr name) = ppr name
1369    ppr (RuleBndrSig name ty) = ppr name <> dcolon <> ppr ty
1370 \end{code}
1371
1372
1373 %************************************************************************
1374 %*                                                                      *
1375 \subsection{Vectorisation declarations}
1376 %*                                                                      *
1377 %************************************************************************
1378
1379 A vectorisation pragma, one of
1380
1381   {-# VECTORISE f = closure1 g (scalar_map g) #-}
1382   {-# VECTORISE SCALAR f #-}
1383   {-# NOVECTORISE f #-}
1384
1385   {-# VECTORISE type T = ty #-}
1386   {-# VECTORISE SCALAR type T #-}
1387   
1388 \begin{code}
1389 type LVectDecl name = Located (VectDecl name)
1390
1391 data VectDecl name
1392   = HsVect
1393       (Located name)
1394       (LHsExpr name)
1395   | HsNoVect
1396       (Located name)
1397   | HsVectTypeIn                -- pre type-checking
1398       Bool                      -- 'TRUE' => SCALAR declaration
1399       (Located name)
1400       (Maybe (Located name))    -- 'Nothing' => no right-hand side
1401   | HsVectTypeOut               -- post type-checking
1402       Bool                      -- 'TRUE' => SCALAR declaration
1403       TyCon
1404       (Maybe TyCon)             -- 'Nothing' => no right-hand side
1405   | HsVectClassIn               -- pre type-checking
1406       (Located name)
1407   | HsVectClassOut              -- post type-checking
1408       Class
1409   | HsVectInstIn                -- pre type-checking (always SCALAR)  !!!FIXME: should be superfluous now
1410       (LHsType name)
1411   | HsVectInstOut               -- post type-checking (always SCALAR) !!!FIXME: should be superfluous now
1412       ClsInst
1413   deriving (Typeable)
1414 deriving instance (DataId name) => Data (VectDecl name)
1415
1416 lvectDeclName :: NamedThing name => LVectDecl name -> Name
1417 lvectDeclName (L _ (HsVect         (L _ name) _))   = getName name
1418 lvectDeclName (L _ (HsNoVect       (L _ name)))     = getName name
1419 lvectDeclName (L _ (HsVectTypeIn   _ (L _ name) _)) = getName name
1420 lvectDeclName (L _ (HsVectTypeOut  _ tycon _))      = getName tycon
1421 lvectDeclName (L _ (HsVectClassIn  (L _ name)))     = getName name
1422 lvectDeclName (L _ (HsVectClassOut cls))            = getName cls
1423 lvectDeclName (L _ (HsVectInstIn   _))              = panic "HsDecls.lvectDeclName: HsVectInstIn"
1424 lvectDeclName (L _ (HsVectInstOut  _))              = panic "HsDecls.lvectDeclName: HsVectInstOut"
1425
1426 lvectInstDecl :: LVectDecl name -> Bool
1427 lvectInstDecl (L _ (HsVectInstIn _))  = True
1428 lvectInstDecl (L _ (HsVectInstOut _)) = True
1429 lvectInstDecl _                       = False
1430
1431 instance OutputableBndr name => Outputable (VectDecl name) where
1432   ppr (HsVect v rhs)
1433     = sep [text "{-# VECTORISE" <+> ppr v,
1434            nest 4 $ 
1435              pprExpr (unLoc rhs) <+> text "#-}" ]
1436   ppr (HsNoVect v)
1437     = sep [text "{-# NOVECTORISE" <+> ppr v <+> text "#-}" ]
1438   ppr (HsVectTypeIn False t Nothing)
1439     = sep [text "{-# VECTORISE type" <+> ppr t <+> text "#-}" ]
1440   ppr (HsVectTypeIn False t (Just t'))
1441     = sep [text "{-# VECTORISE type" <+> ppr t, text "=", ppr t', text "#-}" ]
1442   ppr (HsVectTypeIn True t Nothing)
1443     = sep [text "{-# VECTORISE SCALAR type" <+> ppr t <+> text "#-}" ]
1444   ppr (HsVectTypeIn True t (Just t'))
1445     = sep [text "{-# VECTORISE SCALAR type" <+> ppr t, text "=", ppr t', text "#-}" ]
1446   ppr (HsVectTypeOut False t Nothing)
1447     = sep [text "{-# VECTORISE type" <+> ppr t <+> text "#-}" ]
1448   ppr (HsVectTypeOut False t (Just t'))
1449     = sep [text "{-# VECTORISE type" <+> ppr t, text "=", ppr t', text "#-}" ]
1450   ppr (HsVectTypeOut True t Nothing)
1451     = sep [text "{-# VECTORISE SCALAR type" <+> ppr t <+> text "#-}" ]
1452   ppr (HsVectTypeOut True t (Just t'))
1453     = sep [text "{-# VECTORISE SCALAR type" <+> ppr t, text "=", ppr t', text "#-}" ]
1454   ppr (HsVectClassIn c)
1455     = sep [text "{-# VECTORISE class" <+> ppr c <+> text "#-}" ]
1456   ppr (HsVectClassOut c)
1457     = sep [text "{-# VECTORISE class" <+> ppr c <+> text "#-}" ]
1458   ppr (HsVectInstIn ty)
1459     = sep [text "{-# VECTORISE SCALAR instance" <+> ppr ty <+> text "#-}" ]
1460   ppr (HsVectInstOut i)
1461     = sep [text "{-# VECTORISE SCALAR instance" <+> ppr i <+> text "#-}" ]
1462 \end{code}
1463
1464 %************************************************************************
1465 %*                                                                      *
1466 \subsection[DocDecl]{Document comments}
1467 %*                                                                      *
1468 %************************************************************************
1469
1470 \begin{code}
1471
1472 type LDocDecl = Located (DocDecl)
1473
1474 data DocDecl
1475   = DocCommentNext HsDocString
1476   | DocCommentPrev HsDocString
1477   | DocCommentNamed String HsDocString
1478   | DocGroup Int HsDocString
1479   deriving (Data, Typeable)
1480  
1481 -- Okay, I need to reconstruct the document comments, but for now:
1482 instance Outputable DocDecl where
1483   ppr _ = text "<document comment>"
1484
1485 docDeclDoc :: DocDecl -> HsDocString
1486 docDeclDoc (DocCommentNext d) = d
1487 docDeclDoc (DocCommentPrev d) = d
1488 docDeclDoc (DocCommentNamed _ d) = d
1489 docDeclDoc (DocGroup _ d) = d
1490
1491 \end{code}
1492
1493 %************************************************************************
1494 %*                                                                      *
1495 \subsection[DeprecDecl]{Deprecations}
1496 %*                                                                      *
1497 %************************************************************************
1498
1499 We use exported entities for things to deprecate.
1500
1501 \begin{code}
1502 type LWarnDecl name = Located (WarnDecl name)
1503
1504 data WarnDecl name = Warning name WarningTxt
1505   deriving (Data, Typeable)
1506
1507 instance OutputableBndr name => Outputable (WarnDecl name) where
1508     ppr (Warning thing txt)
1509       = hsep [text "{-# DEPRECATED", ppr thing, doubleQuotes (ppr txt), text "#-}"]
1510 \end{code}
1511
1512 %************************************************************************
1513 %*                                                                      *
1514 \subsection[AnnDecl]{Annotations}
1515 %*                                                                      *
1516 %************************************************************************
1517
1518 \begin{code}
1519 type LAnnDecl name = Located (AnnDecl name)
1520
1521 data AnnDecl name = HsAnnotation (AnnProvenance name) (Located (HsExpr name))
1522   deriving (Typeable)
1523 deriving instance (DataId name) => Data (AnnDecl name)
1524
1525 instance (OutputableBndr name) => Outputable (AnnDecl name) where
1526     ppr (HsAnnotation provenance expr)
1527       = hsep [text "{-#", pprAnnProvenance provenance, pprExpr (unLoc expr), text "#-}"]
1528
1529
1530 data AnnProvenance name = ValueAnnProvenance name
1531                         | TypeAnnProvenance name
1532                         | ModuleAnnProvenance
1533   deriving (Data, Typeable, Functor, Foldable, Traversable)
1534
1535 annProvenanceName_maybe :: AnnProvenance name -> Maybe name
1536 annProvenanceName_maybe (ValueAnnProvenance name) = Just name
1537 annProvenanceName_maybe (TypeAnnProvenance name)  = Just name
1538 annProvenanceName_maybe ModuleAnnProvenance       = Nothing
1539
1540 pprAnnProvenance :: OutputableBndr name => AnnProvenance name -> SDoc
1541 pprAnnProvenance ModuleAnnProvenance       = ptext (sLit "ANN module")
1542 pprAnnProvenance (ValueAnnProvenance name) = ptext (sLit "ANN") <+> ppr name
1543 pprAnnProvenance (TypeAnnProvenance name)  = ptext (sLit "ANN type") <+> ppr name
1544 \end{code}
1545
1546 %************************************************************************
1547 %*                                                                      *
1548 \subsection[RoleAnnot]{Role annotations}
1549 %*                                                                      *
1550 %************************************************************************
1551
1552 \begin{code}
1553 type LRoleAnnotDecl name = Located (RoleAnnotDecl name)
1554
1555 -- See #8185 for more info about why role annotations are
1556 -- top-level declarations
1557 data RoleAnnotDecl name
1558   = RoleAnnotDecl (Located name)         -- type constructor
1559                   [Located (Maybe Role)] -- optional annotations
1560   deriving (Data, Typeable)
1561
1562 instance OutputableBndr name => Outputable (RoleAnnotDecl name) where
1563   ppr (RoleAnnotDecl ltycon roles)
1564     = ptext (sLit "type role") <+> ppr ltycon <+>
1565       hsep (map (pp_role . unLoc) roles)
1566     where
1567       pp_role Nothing  = underscore
1568       pp_role (Just r) = ppr r
1569
1570 roleAnnotDeclName :: RoleAnnotDecl name -> name
1571 roleAnnotDeclName (RoleAnnotDecl (L _ name) _) = name
1572
1573 \end{code}