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