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