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