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