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