compiler/hsSyn/HsDecls.lhs

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