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