compiler/hsSyn/HsDecls.lhs

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