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