compiler/hsSyn/HsDecls.lhs

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