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
   7
   8 \begin{code}
   9 {-# OPTIONS -fno-warn-incomplete-patterns #-}
  10 -- The above warning supression flag is a temporary kludge.
  11 -- While working on this module you are encouraged to remove it and fix
  12 -- any warnings in the module. See
  13 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
  14 -- for details
  15 {-# LANGUAGE DeriveDataTypeable #-}
  16
  17 -- | Abstract syntax of global declarations.
  18 --
  19 -- Definitions for: @TyDecl@ and @ConDecl@, @ClassDecl@,
  20 -- @InstDecl@, @DefaultDecl@ and @ForeignDecl@.
  21 module HsDecls (
  22   -- * Toplevel declarations
  23   HsDecl(..), LHsDecl,
  24   -- ** Class or type declarations
  25   TyClDecl(..), LTyClDecl,
  26   isClassDecl, isSynDecl, isDataDecl, isTypeDecl, isFamilyDecl,
  27   isFamInstDecl, tcdName, tyClDeclNames, tyClDeclTyVars,
  28   countTyClDecls,
  29   -- ** Instance declarations
  30   InstDecl(..), LInstDecl, NewOrData(..), FamilyFlavour(..),
  31   instDeclATs,
  32   -- ** Standalone deriving declarations
  33   DerivDecl(..), LDerivDecl,
  34   -- ** @RULE@ declarations
  35   RuleDecl(..), LRuleDecl, RuleBndr(..),
  36   collectRuleBndrSigTys,
  37   -- ** @default@ declarations
  38   DefaultDecl(..), LDefaultDecl,
  39   -- ** Top-level template haskell splice
  40   SpliceDecl(..),
  41   -- ** Foreign function interface declarations
  42   ForeignDecl(..), LForeignDecl, ForeignImport(..), ForeignExport(..),
  43   CImportSpec(..),
  44   -- ** Data-constructor declarations
  45   ConDecl(..), LConDecl, ResType(..),
  46   HsConDeclDetails, hsConDeclArgTys, hsConDeclsNames,
  47   -- ** Document comments
  48   DocDecl(..), LDocDecl, docDeclDoc,
  49   -- ** Deprecations
  50   WarnDecl(..),  LWarnDecl,
  51   -- ** Annotations
  52   AnnDecl(..), LAnnDecl,
  53   AnnProvenance(..), annProvenanceName_maybe, modifyAnnProvenanceNameM,
  54
  55   -- * Grouping
  56   HsGroup(..),  emptyRdrGroup, emptyRnGroup, appendGroups
  57     ) where
  58
  59 -- friends:
  60 import {-# SOURCE #-}   HsExpr( HsExpr, pprExpr )
  61         -- Because Expr imports Decls via HsBracket
  62
  63 import HsBinds
  64 import HsPat
  65 import HsTypes
  66 import HsDoc
  67 import NameSet
  68 import {- Kind parts of -} Type
  69 import BasicTypes
  70 import ForeignCall
  71
  72 -- others:
  73 import Class
  74 import Outputable
  75 import Util
  76 import SrcLoc
  77 import FastString
  78
  79 import Control.Monad    ( liftM )
  80 import Data.Data
  81 import Data.Maybe       ( isJust )
  82 \end{code}
  83
  84 %************************************************************************
  85 %*                                                                      *
  86 \subsection[HsDecl]{Declarations}
  87 %*                                                                      *
  88 %************************************************************************
  89
  90 \begin{code}
  91 type LHsDecl id = Located (HsDecl id)
  92
  93 -- | A Haskell Declaration
  94 data HsDecl id
  95   = TyClD       (TyClDecl id)     -- ^ A type or class declaration.
  96   | InstD       (InstDecl  id)    -- ^ An instance declaration.
  97   | DerivD      (DerivDecl id)
  98   | ValD        (HsBind id)
  99   | SigD        (Sig id)
 100   | DefD        (DefaultDecl id)
 101   | ForD        (ForeignDecl id)
 102   | WarningD    (WarnDecl id)
 103   | AnnD        (AnnDecl id)
 104   | RuleD       (RuleDecl id)
 105   | SpliceD     (SpliceDecl id)
 106   | DocD        (DocDecl)
 107   | QuasiQuoteD (HsQuasiQuote id)
 108   deriving (Data, Typeable)
 109
 110
 111 -- NB: all top-level fixity decls are contained EITHER
 112 -- EITHER SigDs
 113 -- OR     in the ClassDecls in TyClDs
 114 --
 115 -- The former covers
 116 --      a) data constructors
 117 --      b) class methods (but they can be also done in the
 118 --              signatures of class decls)
 119 --      c) imported functions (that have an IfacSig)
 120 --      d) top level decls
 121 --
 122 -- The latter is for class methods only
 123
 124 -- | A 'HsDecl' is categorised into a 'HsGroup' before being
 125 -- fed to the renamer.
 126 data HsGroup id
 127   = HsGroup {
 128         hs_valds  :: HsValBinds id,
 129         hs_tyclds :: [LTyClDecl id],
 130         hs_instds :: [LInstDecl id],
 131         hs_derivds :: [LDerivDecl id],
 132
 133         hs_fixds  :: [LFixitySig id],
 134                 -- Snaffled out of both top-level fixity signatures,
 135                 -- and those in class declarations
 136
 137         hs_defds  :: [LDefaultDecl id],
 138         hs_fords  :: [LForeignDecl id],
 139         hs_warnds :: [LWarnDecl id],
 140         hs_annds   :: [LAnnDecl id],
 141         hs_ruleds :: [LRuleDecl id],
 142
 143         hs_docs   :: [LDocDecl]
 144   } deriving (Data, Typeable)
 145
 146 emptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup a
 147 emptyRdrGroup = emptyGroup { hs_valds = emptyValBindsIn }
 148 emptyRnGroup  = emptyGroup { hs_valds = emptyValBindsOut }
 149
 150 emptyGroup = HsGroup { hs_tyclds = [], hs_instds = [], hs_derivds = [],
 151                        hs_fixds = [], hs_defds = [], hs_annds = [],
 152                        hs_fords = [], hs_warnds = [], hs_ruleds = [],
 153                        hs_valds = error "emptyGroup hs_valds: Can't happen",
 154                        hs_docs = [] }
 155
 156 appendGroups :: HsGroup a -> HsGroup a -> HsGroup a
 157 appendGroups
 158     HsGroup {
 159         hs_valds  = val_groups1,
 160         hs_tyclds = tyclds1,
 161         hs_instds = instds1,
 162         hs_derivds = derivds1,
 163         hs_fixds  = fixds1,
 164         hs_defds  = defds1,
 165         hs_annds  = annds1,
 166         hs_fords  = fords1,
 167         hs_warnds = warnds1,
 168         hs_ruleds = rulds1,
 169   hs_docs   = docs1 }
 170     HsGroup {
 171         hs_valds  = val_groups2,
 172         hs_tyclds = tyclds2,
 173         hs_instds = instds2,
 174         hs_derivds = derivds2,
 175         hs_fixds  = fixds2,
 176         hs_defds  = defds2,
 177         hs_annds  = annds2,
 178         hs_fords  = fords2,
 179         hs_warnds = warnds2,
 180         hs_ruleds = rulds2,
 181   hs_docs   = docs2 }
 182   =
 183     HsGroup {
 184         hs_valds  = val_groups1 `plusHsValBinds` val_groups2,
 185         hs_tyclds = tyclds1 ++ tyclds2,
 186         hs_instds = instds1 ++ instds2,
 187         hs_derivds = derivds1 ++ derivds2,
 188         hs_fixds  = fixds1 ++ fixds2,
 189         hs_annds  = annds1 ++ annds2,
 190         hs_defds  = defds1 ++ defds2,
 191         hs_fords  = fords1 ++ fords2,
 192         hs_warnds = warnds1 ++ warnds2,
 193         hs_ruleds = rulds1 ++ rulds2,
 194   hs_docs   = docs1  ++ docs2 }
 195 \end{code}
 196
 197 \begin{code}
 198 instance OutputableBndr name => Outputable (HsDecl name) where
 199     ppr (TyClD dcl)             = ppr dcl
 200     ppr (ValD binds)            = ppr binds
 201     ppr (DefD def)              = ppr def
 202     ppr (InstD inst)            = ppr inst
 203     ppr (DerivD deriv)          = ppr deriv
 204     ppr (ForD fd)               = ppr fd
 205     ppr (SigD sd)               = ppr sd
 206     ppr (RuleD rd)              = ppr rd
 207     ppr (WarningD wd)           = ppr wd
 208     ppr (AnnD ad)               = ppr ad
 209     ppr (SpliceD dd)            = ppr dd
 210     ppr (DocD doc)              = ppr doc
 211     ppr (QuasiQuoteD qq)        = ppr qq
 212
 213 instance OutputableBndr name => Outputable (HsGroup name) where
 214     ppr (HsGroup { hs_valds  = val_decls,
 215                    hs_tyclds = tycl_decls,
 216                    hs_instds = inst_decls,
 217                    hs_derivds = deriv_decls,
 218                    hs_fixds  = fix_decls,
 219                    hs_warnds = deprec_decls,
 220                    hs_annds  = ann_decls,
 221                    hs_fords  = foreign_decls,
 222                    hs_defds  = default_decls,
 223                    hs_ruleds = rule_decls })
 224         = vcat [ppr_ds fix_decls, ppr_ds default_decls,
 225                 ppr_ds deprec_decls, ppr_ds ann_decls,
 226                 ppr_ds rule_decls,
 227                 ppr val_decls,
 228                 ppr_ds tycl_decls, ppr_ds inst_decls,
 229                 ppr_ds deriv_decls,
 230                 ppr_ds foreign_decls]
 231         where
 232           ppr_ds [] = empty
 233           ppr_ds ds = blankLine $$ vcat (map ppr ds)
 234
 235 data SpliceDecl id
 236   = SpliceDecl                  -- Top level splice
 237         (Located (HsExpr id))
 238         HsExplicitFlag          -- Explicit <=> $(f x y)
 239                                 -- Implicit <=> f x y,  i.e. a naked top level expression
 240     deriving (Data, Typeable)
 241
 242 instance OutputableBndr name => Outputable (SpliceDecl name) where
 243    ppr (SpliceDecl e _) = ptext (sLit "$") <> parens (pprExpr (unLoc e))
 244 \end{code}
 245
 246
 247 %************************************************************************
 248 %*                                                                      *
 249 \subsection[TyDecl]{@data@, @newtype@ or @type@ (synonym) type declaration}
 250 %*                                                                      *
 251 %************************************************************************
 252
 253                 --------------------------------
 254                         THE NAMING STORY
 255                 --------------------------------
 256
 257 Here is the story about the implicit names that go with type, class,
 258 and instance decls.  It's a bit tricky, so pay attention!
 259
 260 "Implicit" (or "system") binders
 261 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 262   Each data type decl defines
 263         a worker name for each constructor
 264         to-T and from-T convertors
 265   Each class decl defines
 266         a tycon for the class
 267         a data constructor for that tycon
 268         the worker for that constructor
 269         a selector for each superclass
 270
 271 All have occurrence names that are derived uniquely from their parent
 272 declaration.
 273
 274 None of these get separate definitions in an interface file; they are
 275 fully defined by the data or class decl.  But they may *occur* in
 276 interface files, of course.  Any such occurrence must haul in the
 277 relevant type or class decl.
 278
 279 Plan of attack:
 280  - Ensure they "point to" the parent data/class decl
 281    when loading that decl from an interface file
 282    (See RnHiFiles.getSysBinders)
 283
 284  - When typechecking the decl, we build the implicit TyCons and Ids.
 285    When doing so we look them up in the name cache (RnEnv.lookupSysName),
 286    to ensure correct module and provenance is set
 287
 288 These are the two places that we have to conjure up the magic derived
 289 names.  (The actual magic is in OccName.mkWorkerOcc, etc.)
 290
 291 Default methods
 292 ~~~~~~~~~~~~~~~
 293  - Occurrence name is derived uniquely from the method name
 294    E.g. $dmmax
 295
 296  - If there is a default method name at all, it's recorded in
 297    the ClassOpSig (in HsBinds), in the DefMeth field.
 298    (DefMeth is defined in Class.lhs)
 299
 300 Source-code class decls and interface-code class decls are treated subtly
 301 differently, which has given me a great deal of confusion over the years.
 302 Here's the deal.  (We distinguish the two cases because source-code decls
 303 have (Just binds) in the tcdMeths field, whereas interface decls have Nothing.
 304
 305 In *source-code* class declarations:
 306
 307  - When parsing, every ClassOpSig gets a DefMeth with a suitable RdrName
 308    This is done by RdrHsSyn.mkClassOpSigDM
 309
 310  - The renamer renames it to a Name
 311
 312  - During typechecking, we generate a binding for each $dm for
 313    which there's a programmer-supplied default method:
 314         class Foo a where
 315           op1 :: <type>
 316           op2 :: <type>
 317           op1 = ...
 318    We generate a binding for $dmop1 but not for $dmop2.
 319    The Class for Foo has a NoDefMeth for op2 and a DefMeth for op1.
 320    The Name for $dmop2 is simply discarded.
 321
 322 In *interface-file* class declarations:
 323   - When parsing, we see if there's an explicit programmer-supplied default method
 324     because there's an '=' sign to indicate it:
 325         class Foo a where
 326           op1 = :: <type>       -- NB the '='
 327           op2   :: <type>
 328     We use this info to generate a DefMeth with a suitable RdrName for op1,
 329     and a NoDefMeth for op2
 330   - The interface file has a separate definition for $dmop1, with unfolding etc.
 331   - The renamer renames it to a Name.
 332   - The renamer treats $dmop1 as a free variable of the declaration, so that
 333     the binding for $dmop1 will be sucked in.  (See RnHsSyn.tyClDeclFVs)
 334     This doesn't happen for source code class decls, because they *bind* the default method.
 335
 336 Dictionary functions
 337 ~~~~~~~~~~~~~~~~~~~~
 338 Each instance declaration gives rise to one dictionary function binding.
 339
 340 The type checker makes up new source-code instance declarations
 341 (e.g. from 'deriving' or generic default methods --- see
 342 TcInstDcls.tcInstDecls1).  So we can't generate the names for
 343 dictionary functions in advance (we don't know how many we need).
 344
 345 On the other hand for interface-file instance declarations, the decl
 346 specifies the name of the dictionary function, and it has a binding elsewhere
 347 in the interface file:
 348         instance {Eq Int} = dEqInt
 349         dEqInt :: {Eq Int} <pragma info>
 350
 351 So again we treat source code and interface file code slightly differently.
 352
 353 Source code:
 354   - Source code instance decls have a Nothing in the (Maybe name) field
 355     (see data InstDecl below)
 356
 357   - The typechecker makes up a Local name for the dict fun for any source-code
 358     instance decl, whether it comes from a source-code instance decl, or whether
 359     the instance decl is derived from some other construct (e.g. 'deriving').
 360
 361   - The occurrence name it chooses is derived from the instance decl (just for
 362     documentation really) --- e.g. dNumInt.  Two dict funs may share a common
 363     occurrence name, but will have different uniques.  E.g.
 364         instance Foo [Int]  where ...
 365         instance Foo [Bool] where ...
 366     These might both be dFooList
 367
 368   - The CoreTidy phase externalises the name, and ensures the occurrence name is
 369     unique (this isn't special to dict funs).  So we'd get dFooList and dFooList1.
 370
 371   - We can take this relaxed approach (changing the occurrence name later)
 372     because dict fun Ids are not captured in a TyCon or Class (unlike default
 373     methods, say).  Instead, they are kept separately in the InstEnv.  This
 374     makes it easy to adjust them after compiling a module.  (Once we've finished
 375     compiling that module, they don't change any more.)
 376
 377
 378 Interface file code:
 379   - The instance decl gives the dict fun name, so the InstDecl has a (Just name)
 380     in the (Maybe name) field.
 381
 382   - RnHsSyn.instDeclFVs treats the dict fun name as free in the decl, so that we
 383     suck in the dfun binding
 384
 385
 386 \begin{code}
 387 -- Representation of indexed types
 388 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 389 -- Family kind signatures are represented by the variant `TyFamily'.  It
 390 -- covers "type family", "newtype family", and "data family" declarations,
 391 -- distinguished by the value of the field `tcdFlavour'.
 392 --
 393 -- Indexed types are represented by 'TyData' and 'TySynonym' using the field
 394 -- 'tcdTyPats::Maybe [LHsType name]', with the following meaning:
 395 --
 396 --   * If it is 'Nothing', we have a *vanilla* data type declaration or type
 397 --     synonym declaration and 'tcdVars' contains the type parameters of the
 398 --     type constructor.
 399 --
 400 --   * If it is 'Just pats', we have the definition of an indexed type.  Then,
 401 --     'pats' are type patterns for the type-indexes of the type constructor
 402 --     and 'tcdTyVars' are the variables in those patterns.  Hence, the arity of
 403 --     the indexed type (ie, the number of indexes) is 'length tcdTyPats' and
 404 --     *not* 'length tcdVars'.
 405 --
 406 -- In both cases, 'tcdVars' collects all variables we need to quantify over.
 407
 408 type LTyClDecl name = Located (TyClDecl name)
 409
 410 -- | A type or class declaration.
 411 data TyClDecl name
 412   = ForeignType {
 413                 tcdLName    :: Located name,
 414                 tcdExtName  :: Maybe FastString
 415     }
 416
 417
 418   | -- | @type/data family T :: *->*@
 419     TyFamily {  tcdFlavour:: FamilyFlavour,             -- type or data
 420                 tcdLName  :: Located name,              -- type constructor
 421                 tcdTyVars :: [LHsTyVarBndr name],       -- type variables
 422                 tcdKind   :: Maybe Kind                 -- result kind
 423     }
 424
 425
 426   | -- | Declares a data type or newtype, giving its construcors
 427     -- @
 428     --  data/newtype T a = <constrs>
 429     --  data/newtype instance T [a] = <constrs>
 430     -- @
 431     TyData {    tcdND     :: NewOrData,
 432                 tcdCtxt   :: LHsContext name,           -- ^ Context
 433                 tcdLName  :: Located name,              -- ^ Type constructor
 434
 435                 tcdTyVars :: [LHsTyVarBndr name],       -- ^ Type variables
 436
 437                 tcdTyPats :: Maybe [LHsType name],
 438                         -- ^ Type patterns.
 439                         --
 440                         -- @Just [t1..tn]@ for @data instance T t1..tn = ...@
 441                         --      in this case @tcdTyVars = fv( tcdTyPats )@.
 442                         -- @Nothing@ for everything else.
 443
 444                 tcdKindSig:: Maybe Kind,
 445                         -- ^ Optional kind signature.
 446                         --
 447                         -- @(Just k)@ for a GADT-style @data@, or @data
 448                         -- instance@ decl with explicit kind sig
 449
 450                 tcdCons   :: [LConDecl name],
 451                         -- ^ Data constructors
 452                         --
 453                         -- For @data T a = T1 | T2 a@
 454                         --   the 'LConDecl's all have 'ResTyH98'.
 455                         -- For @data T a where { T1 :: T a }@
 456                         --   the 'LConDecls' all have 'ResTyGADT'.
 457
 458                 tcdDerivs :: Maybe [LHsType name]
 459                         -- ^ Derivings; @Nothing@ => not specified,
 460                         --              @Just []@ => derive exactly what is asked
 461                         --
 462                         -- These "types" must be of form
 463                         -- @
 464                         --      forall ab. C ty1 ty2
 465                         -- @
 466                         -- Typically the foralls and ty args are empty, but they
 467                         -- are non-empty for the newtype-deriving case
 468     }
 469
 470   | TySynonym { tcdLName  :: Located name,              -- ^ type constructor
 471                 tcdTyVars :: [LHsTyVarBndr name],       -- ^ type variables
 472                 tcdTyPats :: Maybe [LHsType name],      -- ^ Type patterns
 473                         -- See comments for tcdTyPats in TyData
 474                         -- 'Nothing' => vanilla type synonym
 475
 476                 tcdSynRhs :: LHsType name               -- ^ synonym expansion
 477     }
 478
 479   | ClassDecl { tcdCtxt    :: LHsContext name,          -- ^ Context...
 480                 tcdLName   :: Located name,             -- ^ Name of the class
 481                 tcdTyVars  :: [LHsTyVarBndr name],      -- ^ Class type variables
 482                 tcdFDs     :: [Located (FunDep name)],  -- ^ Functional deps
 483                 tcdSigs    :: [LSig name],              -- ^ Methods' signatures
 484                 tcdMeths   :: LHsBinds name,            -- ^ Default methods
 485                 tcdATs     :: [LTyClDecl name],         -- ^ Associated types; ie
 486                                                         --   only 'TyFamily' and
 487                                                         --   'TySynonym'; the
 488                                                         --   latter for defaults
 489                 tcdDocs    :: [LDocDecl]                -- ^ Haddock docs
 490     }
 491   deriving (Data, Typeable)
 492
 493 data NewOrData
 494   = NewType                     -- ^ @newtype Blah ...@
 495   | DataType                    -- ^ @data Blah ...@
 496   deriving( Eq, Data, Typeable )                -- Needed because Demand derives Eq
 497
 498 data FamilyFlavour
 499   = TypeFamily                  -- ^ @type family ...@
 500   | DataFamily                  -- ^ @data family ...@
 501   deriving (Data, Typeable)
 502 \end{code}
 503
 504 Simple classifiers
 505
 506 \begin{code}
 507 -- | @True@ <=> argument is a @data@\/@newtype@ or @data@\/@newtype instance@
 508 -- declaration.
 509 isDataDecl :: TyClDecl name -> Bool
 510 isDataDecl (TyData {}) = True
 511 isDataDecl _other      = False
 512
 513 -- | type or type instance declaration
 514 isTypeDecl :: TyClDecl name -> Bool
 515 isTypeDecl (TySynonym {}) = True
 516 isTypeDecl _other         = False
 517
 518 -- | vanilla Haskell type synonym (ie, not a type instance)
 519 isSynDecl :: TyClDecl name -> Bool
 520 isSynDecl (TySynonym {tcdTyPats = Nothing}) = True
 521 isSynDecl _other                            = False
 522
 523 -- | type class
 524 isClassDecl :: TyClDecl name -> Bool
 525 isClassDecl (ClassDecl {}) = True
 526 isClassDecl _              = False
 527
 528 -- | type family declaration
 529 isFamilyDecl :: TyClDecl name -> Bool
 530 isFamilyDecl (TyFamily {}) = True
 531 isFamilyDecl _other        = False
 532
 533 -- | family instance (types, newtypes, and data types)
 534 isFamInstDecl :: TyClDecl name -> Bool
 535 isFamInstDecl tydecl
 536    | isTypeDecl tydecl
 537      || isDataDecl tydecl = isJust (tcdTyPats tydecl)
 538    | otherwise            = False
 539 \end{code}
 540
 541 Dealing with names
 542
 543 \begin{code}
 544 tcdName :: TyClDecl name -> name
 545 tcdName decl = unLoc (tcdLName decl)
 546
 547 tyClDeclNames :: Eq name => TyClDecl name -> [Located name]
 548 -- ^ Returns all the /binding/ names of the decl, along with their SrcLocs.
 549 -- The first one is guaranteed to be the name of the decl. For record fields
 550 -- mentioned in multiple constructors, the SrcLoc will be from the first
 551 -- occurence.  We use the equality to filter out duplicate field names
 552
 553 tyClDeclNames (TyFamily    {tcdLName = name})    = [name]
 554 tyClDeclNames (TySynonym   {tcdLName = name})    = [name]
 555 tyClDeclNames (ForeignType {tcdLName = name})    = [name]
 556
 557 tyClDeclNames (ClassDecl {tcdLName = cls_name, tcdSigs = sigs, tcdATs = ats})
 558   = cls_name :
 559     concatMap (tyClDeclNames . unLoc) ats ++ [n | L _ (TypeSig n _) <- sigs]
 560
 561 tyClDeclNames (TyData {tcdLName = tc_name, tcdCons = cons})
 562   = tc_name : hsConDeclsNames cons
 563
 564 tyClDeclTyVars :: TyClDecl name -> [LHsTyVarBndr name]
 565 tyClDeclTyVars (TyFamily    {tcdTyVars = tvs}) = tvs
 566 tyClDeclTyVars (TySynonym   {tcdTyVars = tvs}) = tvs
 567 tyClDeclTyVars (TyData      {tcdTyVars = tvs}) = tvs
 568 tyClDeclTyVars (ClassDecl   {tcdTyVars = tvs}) = tvs
 569 tyClDeclTyVars (ForeignType {})                = []
 570 \end{code}
 571
 572 \begin{code}
 573 countTyClDecls :: [TyClDecl name] -> (Int, Int, Int, Int, Int, Int)
 574         -- class, synonym decls, data, newtype, family decls, family instances
 575 countTyClDecls decls
 576  = (count isClassDecl    decls,
 577     count isSynDecl      decls,  -- excluding...
 578     count isDataTy       decls,  -- ...family...
 579     count isNewTy        decls,  -- ...instances
 580     count isFamilyDecl   decls,
 581     count isFamInstDecl  decls)
 582  where
 583    isDataTy TyData{tcdND = DataType, tcdTyPats = Nothing} = True
 584    isDataTy _                                             = False
 585
 586    isNewTy TyData{tcdND = NewType, tcdTyPats = Nothing} = True
 587    isNewTy _                                            = False
 588 \end{code}
 589
 590 \begin{code}
 591 instance OutputableBndr name
 592               => Outputable (TyClDecl name) where
 593
 594     ppr (ForeignType {tcdLName = ltycon})
 595         = hsep [ptext (sLit "foreign import type dotnet"), ppr ltycon]
 596
 597     ppr (TyFamily {tcdFlavour = flavour, tcdLName = ltycon,
 598                    tcdTyVars = tyvars, tcdKind = mb_kind})
 599       = pp_flavour <+> pp_decl_head [] ltycon tyvars Nothing <+> pp_kind
 600         where
 601           pp_flavour = case flavour of
 602                          TypeFamily -> ptext (sLit "type family")
 603                          DataFamily -> ptext (sLit "data family")
 604
 605           pp_kind = case mb_kind of
 606                       Nothing   -> empty
 607                       Just kind -> dcolon <+> pprKind kind
 608
 609     ppr (TySynonym {tcdLName = ltycon, tcdTyVars = tyvars, tcdTyPats = typats,
 610                     tcdSynRhs = mono_ty})
 611       = hang (ptext (sLit "type") <+>
 612               (if isJust typats then ptext (sLit "instance") else empty) <+>
 613               pp_decl_head [] ltycon tyvars typats <+>
 614               equals)
 615              4 (ppr mono_ty)
 616
 617     ppr (TyData {tcdND = new_or_data, tcdCtxt = context, tcdLName = ltycon,
 618                  tcdTyVars = tyvars, tcdTyPats = typats, tcdKindSig = mb_sig,
 619                  tcdCons = condecls, tcdDerivs = derivings})
 620       = pp_tydecl (null condecls && isJust mb_sig)
 621                   (ppr new_or_data <+>
 622                    (if isJust typats then ptext (sLit "instance") else empty) <+>
 623                    pp_decl_head (unLoc context) ltycon tyvars typats <+>
 624                    ppr_sig mb_sig)
 625                   (pp_condecls condecls)
 626                   derivings
 627       where
 628         ppr_sig Nothing = empty
 629         ppr_sig (Just kind) = dcolon <+> pprKind kind
 630
 631     ppr (ClassDecl {tcdCtxt = context, tcdLName = lclas, tcdTyVars = tyvars,
 632                     tcdFDs = fds,
 633                     tcdSigs = sigs, tcdMeths = methods, tcdATs = ats})
 634       | null sigs && null ats  -- No "where" part
 635       = top_matter
 636
 637       | otherwise       -- Laid out
 638       = sep [hsep [top_matter, ptext (sLit "where {")],
 639              nest 4 (sep [ sep (map ppr_semi ats)
 640                          , sep (map ppr_semi sigs)
 641                          , pprLHsBinds methods
 642                          , char '}'])]
 643       where
 644         top_matter    =     ptext (sLit "class")
 645                         <+> pp_decl_head (unLoc context) lclas tyvars Nothing
 646                         <+> pprFundeps (map unLoc fds)
 647         ppr_semi decl = ppr decl <> semi
 648
 649 pp_decl_head :: OutputableBndr name
 650    => HsContext name
 651    -> Located name
 652    -> [LHsTyVarBndr name]
 653    -> Maybe [LHsType name]
 654    -> SDoc
 655 pp_decl_head context thing tyvars Nothing       -- no explicit type patterns
 656   = hsep [pprHsContext context, ppr thing, interppSP tyvars]
 657 pp_decl_head context thing _      (Just typats) -- explicit type patterns
 658   = hsep [ pprHsContext context, ppr thing
 659          , hsep (map (pprParendHsType.unLoc) typats)]
 660
 661 pp_condecls :: OutputableBndr name => [LConDecl name] -> SDoc
 662 pp_condecls cs@(L _ ConDecl{ con_res = ResTyGADT _ } : _) -- In GADT syntax
 663   = hang (ptext (sLit "where")) 2 (vcat (map ppr cs))
 664 pp_condecls cs                    -- In H98 syntax
 665   = equals <+> sep (punctuate (ptext (sLit " |")) (map ppr cs))
 666
 667 pp_tydecl :: OutputableBndr name => Bool -> SDoc -> SDoc -> Maybe [LHsType name] -> SDoc
 668 pp_tydecl True  pp_head _ _
 669   = pp_head
 670 pp_tydecl False pp_head pp_decl_rhs derivings
 671   = hang pp_head 4 (sep [
 672       pp_decl_rhs,
 673       case derivings of
 674         Nothing -> empty
 675         Just ds -> hsep [ptext (sLit "deriving"), parens (interpp'SP ds)]
 676     ])
 677
 678 instance Outputable NewOrData where
 679   ppr NewType  = ptext (sLit "newtype")
 680   ppr DataType = ptext (sLit "data")
 681 \end{code}
 682
 683
 684 %************************************************************************
 685 %*                                                                      *
 686 \subsection[ConDecl]{A data-constructor declaration}
 687 %*                                                                      *
 688 %************************************************************************
 689
 690 \begin{code}
 691 type LConDecl name = Located (ConDecl name)
 692
 693 -- data T b = forall a. Eq a => MkT a b
 694 --   MkT :: forall b a. Eq a => MkT a b
 695
 696 -- data T b where
 697 --      MkT1 :: Int -> T Int
 698
 699 -- data T = Int `MkT` Int
 700 --        | MkT2
 701
 702 -- data T a where
 703 --      Int `MkT` Int :: T Int
 704
 705 data ConDecl name
 706   = ConDecl
 707     { con_name      :: Located name
 708         -- ^ Constructor name.  This is used for the DataCon itself, and for
 709         -- the user-callable wrapper Id.
 710
 711     , con_explicit  :: HsExplicitFlag
 712         -- ^ Is there an user-written forall? (cf. 'HsTypes.HsForAllTy')
 713
 714     , con_qvars     :: [LHsTyVarBndr name]
 715         -- ^ Type variables.  Depending on 'con_res' this describes the
 716         -- follewing entities
 717         --
 718         --  - ResTyH98:  the constructor's *existential* type variables
 719         --  - ResTyGADT: *all* the constructor's quantified type variables
 720
 721     , con_cxt       :: LHsContext name
 722         -- ^ The context.  This /does not/ include the \"stupid theta\" which
 723         -- lives only in the 'TyData' decl.
 724
 725     , con_details   :: HsConDeclDetails name
 726         -- ^ The main payload
 727
 728     , con_res       :: ResType name
 729         -- ^ Result type of the constructor
 730
 731     , con_doc       :: Maybe LHsDocString
 732         -- ^ A possible Haddock comment.
 733
 734     , con_old_rec :: Bool
 735         -- ^ TEMPORARY field; True <=> user has employed now-deprecated syntax for
 736         --                             GADT-style record decl   C { blah } :: T a b
 737         -- Remove this when we no longer parse this stuff, and hence do not
 738         -- need to report decprecated use
 739     } deriving (Data, Typeable)
 740
 741 type HsConDeclDetails name = HsConDetails (LBangType name) [ConDeclField name]
 742
 743 hsConDeclArgTys :: HsConDeclDetails name -> [LBangType name]
 744 hsConDeclArgTys (PrefixCon tys)    = tys
 745 hsConDeclArgTys (InfixCon ty1 ty2) = [ty1,ty2]
 746 hsConDeclArgTys (RecCon flds)      = map cd_fld_type flds
 747
 748 data ResType name
 749    = ResTyH98           -- Constructor was declared using Haskell 98 syntax
 750    | ResTyGADT (LHsType name)   -- Constructor was declared using GADT-style syntax,
 751                                 --      and here is its result type
 752    deriving (Data, Typeable)
 753
 754 instance OutputableBndr name => Outputable (ResType name) where
 755          -- Debugging only
 756    ppr ResTyH98 = ptext (sLit "ResTyH98")
 757    ppr (ResTyGADT ty) = ptext (sLit "ResTyGADT") <+> pprParendHsType (unLoc ty)
 758 \end{code}
 759
 760 \begin{code}
 761 hsConDeclsNames :: (Eq name) => [LConDecl name] -> [Located name]
 762   -- See tyClDeclNames for what this does
 763   -- The function is boringly complicated because of the records
 764   -- And since we only have equality, we have to be a little careful
 765 hsConDeclsNames cons
 766   = snd (foldl do_one ([], []) cons)
 767   where
 768     do_one (flds_seen, acc) (L _ (ConDecl { con_name = lname, con_details = RecCon flds }))
 769         = (map unLoc new_flds ++ flds_seen, lname : new_flds ++ acc)
 770         where
 771           new_flds = filterOut (\f -> unLoc f `elem` flds_seen)
 772                                (map cd_fld_name flds)
 773
 774     do_one (flds_seen, acc) (L _ (ConDecl { con_name = lname }))
 775         = (flds_seen, lname:acc)
 776 \end{code}
 777
 778
 779 \begin{code}
 780 instance (OutputableBndr name) => Outputable (ConDecl name) where
 781     ppr = pprConDecl
 782
 783 pprConDecl :: OutputableBndr name => ConDecl name -> SDoc
 784 pprConDecl (ConDecl { con_name =con, con_explicit = expl, con_qvars = tvs
 785                     , con_cxt = cxt, con_details = details
 786                     , con_res = ResTyH98, con_doc = doc })
 787   = sep [ppr_mbDoc doc, pprHsForAll expl tvs cxt, ppr_details con details]
 788   where
 789     ppr_details con (InfixCon t1 t2) = hsep [ppr t1, pprHsInfix con, ppr t2]
 790     ppr_details con (PrefixCon tys)  = hsep (pprHsVar con : map ppr tys)
 791     ppr_details con (RecCon fields)  = ppr con <+> pprConDeclFields fields
 792
 793 pprConDecl (ConDecl { con_name = con, con_explicit = expl, con_qvars = tvs
 794                     , con_cxt = cxt, con_details = PrefixCon arg_tys
 795                     , con_res = ResTyGADT res_ty })
 796   = ppr con <+> dcolon <+>
 797     sep [pprHsForAll expl tvs cxt, ppr (foldr mk_fun_ty res_ty arg_tys)]
 798   where
 799     mk_fun_ty a b = noLoc (HsFunTy a b)
 800
 801 pprConDecl (ConDecl { con_name = con, con_explicit = expl, con_qvars = tvs
 802                     , con_cxt = cxt, con_details = RecCon fields, con_res = ResTyGADT res_ty })
 803   = sep [ppr con <+> dcolon <+> pprHsForAll expl tvs cxt,
 804          pprConDeclFields fields <+> arrow <+> ppr res_ty]
 805
 806 pprConDecl (ConDecl {con_name = con, con_details = InfixCon {}, con_res = ResTyGADT {} })
 807   = pprPanic "pprConDecl" (ppr con)
 808         -- In GADT syntax we don't allow infix constructors
 809 \end{code}
 810
 811 %************************************************************************
 812 %*                                                                      *
 813 \subsection[InstDecl]{An instance declaration
 814 %*                                                                      *
 815 %************************************************************************
 816
 817 \begin{code}
 818 type LInstDecl name = Located (InstDecl name)
 819
 820 data InstDecl name
 821   = InstDecl    (LHsType name)  -- Context => Class Instance-type
 822                                 -- Using a polytype means that the renamer conveniently
 823                                 -- figures out the quantified type variables for us.
 824                 (LHsBinds name)
 825                 [LSig name]     -- User-supplied pragmatic info
 826                 [LTyClDecl name]-- Associated types (ie, 'TyData' and
 827                                 -- 'TySynonym' only)
 828   deriving (Data, Typeable)
 829
 830 instance (OutputableBndr name) => Outputable (InstDecl name) where
 831
 832     ppr (InstDecl inst_ty binds uprags ats)
 833       = vcat [hsep [ptext (sLit "instance"), ppr inst_ty, ptext (sLit "where")]
 834              , nest 4 $ vcat (map ppr ats)
 835              , nest 4 $ vcat (map ppr uprags)
 836              , nest 4 $ pprLHsBinds binds ]
 837
 838 -- Extract the declarations of associated types from an instance
 839 --
 840 instDeclATs :: InstDecl name -> [LTyClDecl name]
 841 instDeclATs (InstDecl _ _ _ ats) = ats
 842 \end{code}
 843
 844 %************************************************************************
 845 %*                                                                      *
 846 \subsection[DerivDecl]{A stand-alone instance deriving declaration
 847 %*                                                                      *
 848 %************************************************************************
 849
 850 \begin{code}
 851 type LDerivDecl name = Located (DerivDecl name)
 852
 853 data DerivDecl name = DerivDecl (LHsType name)
 854   deriving (Data, Typeable)
 855
 856 instance (OutputableBndr name) => Outputable (DerivDecl name) where
 857     ppr (DerivDecl ty)
 858         = hsep [ptext (sLit "deriving instance"), ppr ty]
 859 \end{code}
 860
 861 %************************************************************************
 862 %*                                                                      *
 863 \subsection[DefaultDecl]{A @default@ declaration}
 864 %*                                                                      *
 865 %************************************************************************
 866
 867 There can only be one default declaration per module, but it is hard
 868 for the parser to check that; we pass them all through in the abstract
 869 syntax, and that restriction must be checked in the front end.
 870
 871 \begin{code}
 872 type LDefaultDecl name = Located (DefaultDecl name)
 873
 874 data DefaultDecl name
 875   = DefaultDecl [LHsType name]
 876   deriving (Data, Typeable)
 877
 878 instance (OutputableBndr name)
 879               => Outputable (DefaultDecl name) where
 880
 881     ppr (DefaultDecl tys)
 882       = ptext (sLit "default") <+> parens (interpp'SP tys)
 883 \end{code}
 884
 885 %************************************************************************
 886 %*                                                                      *
 887 \subsection{Foreign function interface declaration}
 888 %*                                                                      *
 889 %************************************************************************
 890
 891 \begin{code}
 892
 893 -- foreign declarations are distinguished as to whether they define or use a
 894 -- Haskell name
 895 --
 896 --  * the Boolean value indicates whether the pre-standard deprecated syntax
 897 --   has been used
 898 --
 899 type LForeignDecl name = Located (ForeignDecl name)
 900
 901 data ForeignDecl name
 902   = ForeignImport (Located name) (LHsType name) ForeignImport  -- defines name
 903   | ForeignExport (Located name) (LHsType name) ForeignExport  -- uses name
 904   deriving (Data, Typeable)
 905
 906 -- Specification Of an imported external entity in dependence on the calling
 907 -- convention
 908 --
 909 data ForeignImport = -- import of a C entity
 910                      --
 911                      --  * the two strings specifying a header file or library
 912                      --   may be empty, which indicates the absence of a
 913                      --   header or object specification (both are not used
 914                      --   in the case of `CWrapper' and when `CFunction'
 915                      --   has a dynamic target)
 916                      --
 917                      --  * the calling convention is irrelevant for code
 918                      --   generation in the case of `CLabel', but is needed
 919                      --   for pretty printing
 920                      --
 921                      --  * `Safety' is irrelevant for `CLabel' and `CWrapper'
 922                      --
 923                      CImport  CCallConv       -- ccall or stdcall
 924                               Safety          -- safe or unsafe
 925                               FastString      -- name of C header
 926                               CImportSpec     -- details of the C entity
 927   deriving (Data, Typeable)
 928
 929 -- details of an external C entity
 930 --
 931 data CImportSpec = CLabel    CLabelString     -- import address of a C label
 932                  | CFunction CCallTarget      -- static or dynamic function
 933                  | CWrapper                   -- wrapper to expose closures
 934                                               -- (former f.e.d.)
 935   deriving (Data, Typeable)
 936
 937 -- specification of an externally exported entity in dependence on the calling
 938 -- convention
 939 --
 940 data ForeignExport = CExport  CExportSpec    -- contains the calling convention
 941   deriving (Data, Typeable)
 942
 943 -- pretty printing of foreign declarations
 944 --
 945
 946 instance OutputableBndr name => Outputable (ForeignDecl name) where
 947   ppr (ForeignImport n ty fimport) =
 948     hang (ptext (sLit "foreign import") <+> ppr fimport <+> ppr n)
 949        2 (dcolon <+> ppr ty)
 950   ppr (ForeignExport n ty fexport) =
 951     hang (ptext (sLit "foreign export") <+> ppr fexport <+> ppr n)
 952        2 (dcolon <+> ppr ty)
 953
 954 instance Outputable ForeignImport where
 955   ppr (CImport  cconv safety header spec) =
 956     ppr cconv <+> ppr safety <+>
 957     char '"' <> pprCEntity spec <> char '"'
 958     where
 959       pp_hdr = if nullFS header then empty else ftext header
 960
 961       pprCEntity (CLabel lbl) =
 962         ptext (sLit "static") <+> pp_hdr <+> char '&' <> ppr lbl
 963       pprCEntity (CFunction (StaticTarget lbl _)) =
 964         ptext (sLit "static") <+> pp_hdr <+> ppr lbl
 965       pprCEntity (CFunction (DynamicTarget)) =
 966         ptext (sLit "dynamic")
 967       pprCEntity (CWrapper) = ptext (sLit "wrapper")
 968
 969 instance Outputable ForeignExport where
 970   ppr (CExport  (CExportStatic lbl cconv)) =
 971     ppr cconv <+> char '"' <> ppr lbl <> char '"'
 972 \end{code}
 973
 974
 975 %************************************************************************
 976 %*                                                                      *
 977 \subsection{Transformation rules}
 978 %*                                                                      *
 979 %************************************************************************
 980
 981 \begin{code}
 982 type LRuleDecl name = Located (RuleDecl name)
 983
 984 data RuleDecl name
 985   = HsRule                      -- Source rule
 986         RuleName                -- Rule name
 987         Activation
 988         [RuleBndr name]         -- Forall'd vars; after typechecking this includes tyvars
 989         (Located (HsExpr name)) -- LHS
 990         NameSet                 -- Free-vars from the LHS
 991         (Located (HsExpr name)) -- RHS
 992         NameSet                 -- Free-vars from the RHS
 993   deriving (Data, Typeable)
 994
 995 data RuleBndr name
 996   = RuleBndr (Located name)
 997   | RuleBndrSig (Located name) (LHsType name)
 998   deriving (Data, Typeable)
 999
1000 collectRuleBndrSigTys :: [RuleBndr name] -> [LHsType name]
1001 collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ ty <- bndrs]
1002
1003 instance OutputableBndr name => Outputable (RuleDecl name) where
1004   ppr (HsRule name act ns lhs _fv_lhs rhs _fv_rhs)
1005         = sep [text "{-# RULES" <+> doubleQuotes (ftext name) <+> ppr act,
1006                nest 4 (pp_forall <+> pprExpr (unLoc lhs)),
1007                nest 4 (equals <+> pprExpr (unLoc rhs) <+> text "#-}") ]
1008         where
1009           pp_forall | null ns   = empty
1010                     | otherwise = text "forall" <+> fsep (map ppr ns) <> dot
1011
1012 instance OutputableBndr name => Outputable (RuleBndr name) where
1013    ppr (RuleBndr name) = ppr name
1014    ppr (RuleBndrSig name ty) = ppr name <> dcolon <> ppr ty
1015 \end{code}
1016
1017 %************************************************************************
1018 %*                                                                      *
1019 \subsection[DocDecl]{Document comments}
1020 %*                                                                      *
1021 %************************************************************************
1022
1023 \begin{code}
1024
1025 type LDocDecl = Located (DocDecl)
1026
1027 data DocDecl
1028   = DocCommentNext HsDocString
1029   | DocCommentPrev HsDocString
1030   | DocCommentNamed String HsDocString
1031   | DocGroup Int HsDocString
1032   deriving (Data, Typeable)
1033
1034 -- Okay, I need to reconstruct the document comments, but for now:
1035 instance Outputable DocDecl where
1036   ppr _ = text "<document comment>"
1037
1038 docDeclDoc :: DocDecl -> HsDocString
1039 docDeclDoc (DocCommentNext d) = d
1040 docDeclDoc (DocCommentPrev d) = d
1041 docDeclDoc (DocCommentNamed _ d) = d
1042 docDeclDoc (DocGroup _ d) = d
1043
1044 \end{code}
1045
1046 %************************************************************************
1047 %*                                                                      *
1048 \subsection[DeprecDecl]{Deprecations}
1049 %*                                                                      *
1050 %************************************************************************
1051
1052 We use exported entities for things to deprecate.
1053
1054 \begin{code}
1055 type LWarnDecl name = Located (WarnDecl name)
1056
1057 data WarnDecl name = Warning name WarningTxt
1058   deriving (Data, Typeable)
1059
1060 instance OutputableBndr name => Outputable (WarnDecl name) where
1061     ppr (Warning thing txt)
1062       = hsep [text "{-# DEPRECATED", ppr thing, doubleQuotes (ppr txt), text "#-}"]
1063 \end{code}
1064
1065 %************************************************************************
1066 %*                                                                      *
1067 \subsection[AnnDecl]{Annotations}
1068 %*                                                                      *
1069 %************************************************************************
1070
1071 \begin{code}
1072 type LAnnDecl name = Located (AnnDecl name)
1073
1074 data AnnDecl name = HsAnnotation (AnnProvenance name) (Located (HsExpr name))
1075   deriving (Data, Typeable)
1076
1077 instance (OutputableBndr name) => Outputable (AnnDecl name) where
1078     ppr (HsAnnotation provenance expr)
1079       = hsep [text "{-#", pprAnnProvenance provenance, pprExpr (unLoc expr), text "#-}"]
1080
1081
1082 data AnnProvenance name = ValueAnnProvenance name
1083                         | TypeAnnProvenance name
1084                         | ModuleAnnProvenance
1085   deriving (Data, Typeable)
1086
1087 annProvenanceName_maybe :: AnnProvenance name -> Maybe name
1088 annProvenanceName_maybe (ValueAnnProvenance name) = Just name
1089 annProvenanceName_maybe (TypeAnnProvenance name)  = Just name
1090 annProvenanceName_maybe ModuleAnnProvenance       = Nothing
1091
1092 -- TODO: Replace with Traversable instance when GHC bootstrap version rises high enough
1093 modifyAnnProvenanceNameM :: Monad m => (before -> m after) -> AnnProvenance before -> m (AnnProvenance after)
1094 modifyAnnProvenanceNameM fm prov =
1095     case prov of
1096             ValueAnnProvenance name -> liftM ValueAnnProvenance (fm name)
1097             TypeAnnProvenance name -> liftM TypeAnnProvenance (fm name)
1098             ModuleAnnProvenance -> return ModuleAnnProvenance
1099
1100 pprAnnProvenance :: OutputableBndr name => AnnProvenance name -> SDoc
1101 pprAnnProvenance ModuleAnnProvenance       = ptext (sLit "ANN module")
1102 pprAnnProvenance (ValueAnnProvenance name) = ptext (sLit "ANN") <+> ppr name
1103 pprAnnProvenance (TypeAnnProvenance name)  = ptext (sLit "ANN type") <+> ppr name
1104 \end{code}