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