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