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