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