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