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
 403                         --   the LConDecls all have ResTyH98
 404                         -- For data T a where { T1 :: T a }
 405                         --   the LConDecls all have ResTyGADT
 406
 407                 tcdDerivs :: Maybe [LHsType name]
 408                         -- Derivings; Nothing => not specified
 409                         --            Just [] => derive exactly what is asked
 410                         -- These "types" must be of form
 411                         --      forall ab. C ty1 ty2
 412                         -- Typically the foralls and ty args are empty, but they
 413                         -- are non-empty for the newtype-deriving case
 414     }
 415
 416   | TySynonym { tcdLName  :: Located name,              -- type constructor
 417                 tcdTyVars :: [LHsTyVarBndr name],       -- type variables
 418                 tcdTyPats :: Maybe [LHsType name],      -- Type patterns
 419                         -- See comments for tcdTyPats in TyData
 420                         -- 'Nothing' => vanilla type synonym
 421
 422                 tcdSynRhs :: LHsType name               -- synonym expansion
 423     }
 424
 425   | ClassDecl { tcdCtxt    :: LHsContext name,          -- Context...
 426                 tcdLName   :: Located name,             -- Name of the class
 427                 tcdTyVars  :: [LHsTyVarBndr name],      -- Class type variables
 428                 tcdFDs     :: [Located (FunDep name)],  -- Functional deps
 429                 tcdSigs    :: [LSig name],              -- Methods' signatures
 430                 tcdMeths   :: LHsBinds name,            -- Default methods
 431                 tcdATs     :: [LTyClDecl name],         -- Associated types; ie
 432                                                         --   only 'TyFamily' and
 433                                                         --   'TySynonym'; the
 434                                                         --   latter for defaults
 435                 tcdDocs    :: [LDocDecl name]           -- Haddock docs
 436     }
 437
 438 data NewOrData
 439   = NewType                     -- "newtype Blah ..."
 440   | DataType                    -- "data Blah ..."
 441   deriving( Eq )                -- Needed because Demand derives Eq
 442
 443 data FamilyFlavour
 444   = TypeFamily                  -- "type family ..."
 445   | DataFamily                  -- "data family ..."
 446 \end{code}
 447
 448 Simple classifiers
 449
 450 \begin{code}
 451 isDataDecl, isTypeDecl, isSynDecl, isClassDecl, isFamilyDecl, isFamInstDecl ::
 452   TyClDecl name -> Bool
 453
 454 -- data/newtype or data/newtype instance declaration
 455 isDataDecl (TyData {}) = True
 456 isDataDecl _other      = False
 457
 458 -- type or type instance declaration
 459 isTypeDecl (TySynonym {}) = True
 460 isTypeDecl _other         = False
 461
 462 -- vanilla Haskell type synonym (ie, not a type instance)
 463 isSynDecl (TySynonym {tcdTyPats = Nothing}) = True
 464 isSynDecl _other                            = False
 465
 466 -- type class
 467 isClassDecl (ClassDecl {}) = True
 468 isClassDecl other          = False
 469
 470 -- type family declaration
 471 isFamilyDecl (TyFamily {}) = True
 472 isFamilyDecl _other        = False
 473
 474 -- family instance (types, newtypes, and data types)
 475 isFamInstDecl tydecl
 476    | isTypeDecl tydecl
 477      || isDataDecl tydecl = isJust (tcdTyPats tydecl)
 478    | otherwise            = False
 479 \end{code}
 480
 481 Dealing with names
 482
 483 \begin{code}
 484 tcdName :: TyClDecl name -> name
 485 tcdName decl = unLoc (tcdLName decl)
 486
 487 tyClDeclNames :: Eq name => TyClDecl name -> [Located name]
 488 -- Returns all the *binding* names of the decl, along with their SrcLocs
 489 -- The first one is guaranteed to be the name of the decl
 490 -- For record fields, the first one counts as the SrcLoc
 491 -- We use the equality to filter out duplicate field names
 492
 493 tyClDeclNames (TyFamily    {tcdLName = name})    = [name]
 494 tyClDeclNames (TySynonym   {tcdLName = name})    = [name]
 495 tyClDeclNames (ForeignType {tcdLName = name})    = [name]
 496
 497 tyClDeclNames (ClassDecl {tcdLName = cls_name, tcdSigs = sigs, tcdATs = ats})
 498   = cls_name :
 499     concatMap (tyClDeclNames . unLoc) ats ++ [n | L _ (TypeSig n _) <- sigs]
 500
 501 tyClDeclNames (TyData {tcdLName = tc_name, tcdCons = cons})
 502   = tc_name : conDeclsNames (map unLoc cons)
 503
 504 tyClDeclTyVars (TyFamily    {tcdTyVars = tvs}) = tvs
 505 tyClDeclTyVars (TySynonym   {tcdTyVars = tvs}) = tvs
 506 tyClDeclTyVars (TyData      {tcdTyVars = tvs}) = tvs
 507 tyClDeclTyVars (ClassDecl   {tcdTyVars = tvs}) = tvs
 508 tyClDeclTyVars (ForeignType {})                = []
 509 \end{code}
 510
 511 \begin{code}
 512 countTyClDecls :: [TyClDecl name] -> (Int, Int, Int, Int, Int, Int)
 513         -- class, synonym decls, data, newtype, family decls, family instances
 514 countTyClDecls decls
 515  = (count isClassDecl    decls,
 516     count isSynDecl      decls,  -- excluding...
 517     count isDataTy       decls,  -- ...family...
 518     count isNewTy        decls,  -- ...instances
 519     count isFamilyDecl   decls,
 520     count isFamInstDecl  decls)
 521  where
 522    isDataTy TyData{tcdND = DataType, tcdTyPats = Nothing} = True
 523    isDataTy _                                             = False
 524
 525    isNewTy TyData{tcdND = NewType, tcdTyPats = Nothing} = True
 526    isNewTy _                                            = False
 527 \end{code}
 528
 529 \begin{code}
 530 instance OutputableBndr name
 531               => Outputable (TyClDecl name) where
 532
 533     ppr (ForeignType {tcdLName = ltycon})
 534         = hsep [ptext SLIT("foreign import type dotnet"), ppr ltycon]
 535
 536     ppr (TyFamily {tcdFlavour = flavour, tcdLName = ltycon,
 537                    tcdTyVars = tyvars, tcdKind = mb_kind})
 538       = pp_flavour <+> pp_decl_head [] ltycon tyvars Nothing <+> pp_kind
 539         where
 540           pp_flavour = case flavour of
 541                          TypeFamily -> ptext SLIT("type family")
 542                          DataFamily -> ptext SLIT("data family")
 543
 544           pp_kind = case mb_kind of
 545                       Nothing   -> empty
 546                       Just kind -> dcolon <+> pprKind kind
 547
 548     ppr (TySynonym {tcdLName = ltycon, tcdTyVars = tyvars, tcdTyPats = typats,
 549                     tcdSynRhs = mono_ty})
 550       = hang (ptext SLIT("type") <+>
 551               (if isJust typats then ptext SLIT("instance") else empty) <+>
 552               pp_decl_head [] ltycon tyvars typats <+>
 553               equals)
 554              4 (ppr mono_ty)
 555
 556     ppr (TyData {tcdND = new_or_data, tcdCtxt = context, tcdLName = ltycon,
 557                  tcdTyVars = tyvars, tcdTyPats = typats, tcdKindSig = mb_sig,
 558                  tcdCons = condecls, tcdDerivs = derivings})
 559       = pp_tydecl (null condecls && isJust mb_sig)
 560                   (ppr new_or_data <+>
 561                    (if isJust typats then ptext SLIT("instance") else empty) <+>
 562                    pp_decl_head (unLoc context) ltycon tyvars typats <+>
 563                    ppr_sig mb_sig)
 564                   (pp_condecls condecls)
 565                   derivings
 566       where
 567         ppr_sig Nothing = empty
 568         ppr_sig (Just kind) = dcolon <+> pprKind kind
 569
 570     ppr (ClassDecl {tcdCtxt = context, tcdLName = lclas, tcdTyVars = tyvars,
 571                     tcdFDs = fds,
 572                     tcdSigs = sigs, tcdMeths = methods, tcdATs = ats})
 573       | null sigs && null ats  -- No "where" part
 574       = top_matter
 575
 576       | otherwise       -- Laid out
 577       = sep [hsep [top_matter, ptext SLIT("where {")],
 578              nest 4 (sep [ sep (map ppr_semi ats)
 579                          , sep (map ppr_semi sigs)
 580                          , pprLHsBinds methods
 581                          , char '}'])]
 582       where
 583         top_matter    =     ptext SLIT("class")
 584                         <+> pp_decl_head (unLoc context) lclas tyvars Nothing
 585                         <+> pprFundeps (map unLoc fds)
 586         ppr_semi decl = ppr decl <> semi
 587
 588 pp_decl_head :: OutputableBndr name
 589    => HsContext name
 590    -> Located name
 591    -> [LHsTyVarBndr name]
 592    -> Maybe [LHsType name]
 593    -> SDoc
 594 pp_decl_head context thing tyvars Nothing       -- no explicit type patterns
 595   = hsep [pprHsContext context, ppr thing, interppSP tyvars]
 596 pp_decl_head context thing _      (Just typats) -- explicit type patterns
 597   = hsep [ pprHsContext context, ppr thing
 598          , hsep (map (pprParendHsType.unLoc) typats)]
 599
 600 pp_condecls cs@(L _ ConDecl{ con_res = ResTyGADT _ } : _) -- In GADT syntax
 601   = hang (ptext SLIT("where")) 2 (vcat (map ppr cs))
 602 pp_condecls cs                    -- In H98 syntax
 603   = equals <+> sep (punctuate (ptext SLIT(" |")) (map ppr cs))
 604
 605 pp_tydecl True pp_head pp_decl_rhs derivings
 606   = pp_head
 607 pp_tydecl False pp_head pp_decl_rhs derivings
 608   = hang pp_head 4 (sep [
 609       pp_decl_rhs,
 610       case derivings of
 611         Nothing -> empty
 612         Just ds -> hsep [ptext SLIT("deriving"), parens (interpp'SP ds)]
 613     ])
 614
 615 instance Outputable NewOrData where
 616   ppr NewType  = ptext SLIT("newtype")
 617   ppr DataType = ptext SLIT("data")
 618 \end{code}
 619
 620
 621 %************************************************************************
 622 %*                                                                      *
 623 \subsection[ConDecl]{A data-constructor declaration}
 624 %*                                                                      *
 625 %************************************************************************
 626
 627 \begin{code}
 628 type LConDecl name = Located (ConDecl name)
 629
 630 -- data T b = forall a. Eq a => MkT a b
 631 --   MkT :: forall b a. Eq a => MkT a b
 632
 633 -- data T b where
 634 --      MkT1 :: Int -> T Int
 635
 636 -- data T = Int `MkT` Int
 637 --        | MkT2
 638
 639 -- data T a where
 640 --      Int `MkT` Int :: T Int
 641
 642 data ConDecl name
 643   = ConDecl
 644     { con_name      :: Located name         -- Constructor name; this is used for the
 645                                             -- DataCon itself, and for the user-callable wrapper Id
 646
 647     , con_explicit  :: HsExplicitForAll     -- Is there an user-written forall? (cf. HStypes.HsForAllTy)
 648
 649     , con_qvars     :: [LHsTyVarBndr name]  -- ResTyH98: the constructor's existential type variables
 650                                             -- ResTyGADT:    all the constructor's quantified type variables
 651
 652     , con_cxt       :: LHsContext name      -- The context.  This *does not* include the
 653                                             -- "stupid theta" which lives only in the TyData decl
 654
 655     , con_details   :: HsConDeclDetails name    -- The main payload
 656
 657     , con_res       :: ResType name         -- Result type of the constructor
 658
 659     , con_doc       :: Maybe (LHsDoc name)  -- A possible Haddock comment
 660     }
 661
 662 type HsConDeclDetails name = HsConDetails (LBangType name) [ConDeclField name]
 663
 664 hsConDeclArgTys :: HsConDeclDetails name -> [LBangType name]
 665 hsConDeclArgTys (PrefixCon tys)    = tys
 666 hsConDeclArgTys (InfixCon ty1 ty2) = [ty1,ty2]
 667 hsConDeclArgTys (RecCon flds)      = map cd_fld_type flds
 668
 669 data ConDeclField name  -- Record fields have Haddoc docs on them
 670   = ConDeclField { cd_fld_name :: Located name,
 671                    cd_fld_type :: LBangType name,
 672                    cd_fld_doc  :: Maybe (LHsDoc name) }
 673
 674 data ResType name
 675    = ResTyH98           -- Constructor was declared using Haskell 98 syntax
 676    | ResTyGADT (LHsType name)   -- Constructor was declared using GADT-style syntax,
 677                                 --      and here is its result type
 678 \end{code}
 679
 680 \begin{code}
 681 conDeclsNames :: forall name. Eq name => [ConDecl name] -> [Located name]
 682   -- See tyClDeclNames for what this does
 683   -- The function is boringly complicated because of the records
 684   -- And since we only have equality, we have to be a little careful
 685 conDeclsNames cons
 686   = snd (foldl do_one ([], []) cons)
 687   where
 688     do_one (flds_seen, acc) (ConDecl { con_name = lname, con_details = RecCon flds })
 689         = (map unLoc new_flds ++ flds_seen, lname : new_flds ++ acc)
 690         where
 691           new_flds = filterOut (\f -> unLoc f `elem` flds_seen)
 692                                (map cd_fld_name flds)
 693
 694     do_one (flds_seen, acc) c
 695         = (flds_seen, (con_name c):acc)
 696 \end{code}
 697
 698
 699 \begin{code}
 700 instance (OutputableBndr name) => Outputable (ConDecl name) where
 701     ppr = pprConDecl
 702
 703 pprConDecl :: OutputableBndr name => ConDecl name -> SDoc
 704 pprConDecl (ConDecl con expl tvs cxt details ResTyH98 doc)
 705   = sep [ppr_mbDoc doc, pprHsForAll expl tvs cxt, ppr_details con details]
 706   where
 707     ppr_details con (InfixCon t1 t2) = hsep [ppr t1, pprHsVar con, ppr t2]
 708     ppr_details con (PrefixCon tys)  = hsep (pprHsVar con : map ppr tys)
 709     ppr_details con (RecCon fields)  = ppr con <+> ppr_fields fields
 710
 711 pprConDecl (ConDecl con expl tvs cxt (PrefixCon arg_tys) (ResTyGADT res_ty) _)
 712   = ppr con <+> dcolon <+>
 713     sep [pprHsForAll expl tvs cxt, ppr (foldr mk_fun_ty res_ty arg_tys)]
 714   where
 715     mk_fun_ty a b = noLoc (HsFunTy a b)
 716
 717 pprConDecl (ConDecl con expl tvs cxt (RecCon fields) (ResTyGADT res_ty) _)
 718   = sep [pprHsForAll expl tvs cxt, ppr con <+> ppr_fields fields <+> dcolon <+> ppr res_ty]
 719
 720 ppr_fields fields = braces (sep (punctuate comma (map ppr_fld fields)))
 721   where
 722     ppr_fld (ConDeclField { cd_fld_name = n, cd_fld_type = ty,
 723                             cd_fld_doc = doc })
 724         = ppr n <+> dcolon <+> ppr ty <+> ppr_mbDoc doc
 725 \end{code}
 726
 727 %************************************************************************
 728 %*                                                                      *
 729 \subsection[InstDecl]{An instance declaration
 730 %*                                                                      *
 731 %************************************************************************
 732
 733 \begin{code}
 734 type LInstDecl name = Located (InstDecl name)
 735
 736 data InstDecl name
 737   = InstDecl    (LHsType name)  -- Context => Class Instance-type
 738                                 -- Using a polytype means that the renamer conveniently
 739                                 -- figures out the quantified type variables for us.
 740                 (LHsBinds name)
 741                 [LSig name]     -- User-supplied pragmatic info
 742                 [LTyClDecl name]-- Associated types (ie, 'TyData' and
 743                                 -- 'TySynonym' only)
 744
 745 instance (OutputableBndr name) => Outputable (InstDecl name) where
 746
 747     ppr (InstDecl inst_ty binds uprags ats)
 748       = vcat [hsep [ptext SLIT("instance"), ppr inst_ty, ptext SLIT("where")],
 749               nest 4 (ppr ats),
 750               nest 4 (ppr uprags),
 751               nest 4 (pprLHsBinds binds) ]
 752
 753 -- Extract the declarations of associated types from an instance
 754 --
 755 instDeclATs :: InstDecl name -> [LTyClDecl name]
 756 instDeclATs (InstDecl _ _ _ ats) = ats
 757 \end{code}
 758
 759 %************************************************************************
 760 %*                                                                      *
 761 \subsection[DerivDecl]{A stand-alone instance deriving declaration
 762 %*                                                                      *
 763 %************************************************************************
 764
 765 \begin{code}
 766 type LDerivDecl name = Located (DerivDecl name)
 767
 768 data DerivDecl name = DerivDecl (LHsType name)
 769
 770 instance (OutputableBndr name) => Outputable (DerivDecl name) where
 771     ppr (DerivDecl ty)
 772         = hsep [ptext SLIT("derived instance"), ppr ty]
 773 \end{code}
 774
 775 %************************************************************************
 776 %*                                                                      *
 777 \subsection[DefaultDecl]{A @default@ declaration}
 778 %*                                                                      *
 779 %************************************************************************
 780
 781 There can only be one default declaration per module, but it is hard
 782 for the parser to check that; we pass them all through in the abstract
 783 syntax, and that restriction must be checked in the front end.
 784
 785 \begin{code}
 786 type LDefaultDecl name = Located (DefaultDecl name)
 787
 788 data DefaultDecl name
 789   = DefaultDecl [LHsType name]
 790
 791 instance (OutputableBndr name)
 792               => Outputable (DefaultDecl name) where
 793
 794     ppr (DefaultDecl tys)
 795       = ptext SLIT("default") <+> parens (interpp'SP tys)
 796 \end{code}
 797
 798 %************************************************************************
 799 %*                                                                      *
 800 \subsection{Foreign function interface declaration}
 801 %*                                                                      *
 802 %************************************************************************
 803
 804 \begin{code}
 805
 806 -- foreign declarations are distinguished as to whether they define or use a
 807 -- Haskell name
 808 --
 809 --  * the Boolean value indicates whether the pre-standard deprecated syntax
 810 --   has been used
 811 --
 812 type LForeignDecl name = Located (ForeignDecl name)
 813
 814 data ForeignDecl name
 815   = ForeignImport (Located name) (LHsType name) ForeignImport  -- defines name
 816   | ForeignExport (Located name) (LHsType name) ForeignExport  -- uses name
 817
 818 -- Specification Of an imported external entity in dependence on the calling
 819 -- convention
 820 --
 821 data ForeignImport = -- import of a C entity
 822                      --
 823                      --  * the two strings specifying a header file or library
 824                      --   may be empty, which indicates the absence of a
 825                      --   header or object specification (both are not used
 826                      --   in the case of `CWrapper' and when `CFunction'
 827                      --   has a dynamic target)
 828                      --
 829                      --  * the calling convention is irrelevant for code
 830                      --   generation in the case of `CLabel', but is needed
 831                      --   for pretty printing
 832                      --
 833                      --  * `Safety' is irrelevant for `CLabel' and `CWrapper'
 834                      --
 835                      CImport  CCallConv       -- ccall or stdcall
 836                               Safety          -- safe or unsafe
 837                               FastString      -- name of C header
 838                               FastString      -- name of library object
 839                               CImportSpec     -- details of the C entity
 840
 841                      -- import of a .NET function
 842                      --
 843                    | DNImport DNCallSpec
 844
 845 -- details of an external C entity
 846 --
 847 data CImportSpec = CLabel    CLabelString     -- import address of a C label
 848                  | CFunction CCallTarget      -- static or dynamic function
 849                  | CWrapper                   -- wrapper to expose closures
 850                                               -- (former f.e.d.)
 851
 852 -- specification of an externally exported entity in dependence on the calling
 853 -- convention
 854 --
 855 data ForeignExport = CExport  CExportSpec    -- contains the calling convention
 856                    | DNExport                -- presently unused
 857
 858 -- abstract type imported from .NET
 859 --
 860 data FoType = DNType            -- In due course we'll add subtype stuff
 861             deriving (Eq)       -- Used for equality instance for TyClDecl
 862
 863
 864 -- pretty printing of foreign declarations
 865 --
 866
 867 instance OutputableBndr name => Outputable (ForeignDecl name) where
 868   ppr (ForeignImport n ty fimport) =
 869     hang (ptext SLIT("foreign import") <+> ppr fimport <+> ppr n)
 870        2 (dcolon <+> ppr ty)
 871   ppr (ForeignExport n ty fexport) =
 872     hang (ptext SLIT("foreign export") <+> ppr fexport <+> ppr n)
 873        2 (dcolon <+> ppr ty)
 874
 875 instance Outputable ForeignImport where
 876   ppr (DNImport                         spec) =
 877     ptext SLIT("dotnet") <+> ppr spec
 878   ppr (CImport  cconv safety header lib spec) =
 879     ppr cconv <+> ppr safety <+>
 880     char '"' <> pprCEntity header lib spec <> char '"'
 881     where
 882       pprCEntity header lib (CLabel lbl) =
 883         ptext SLIT("static") <+> ftext header <+> char '&' <>
 884         pprLib lib <> ppr lbl
 885       pprCEntity header lib (CFunction (StaticTarget lbl)) =
 886         ptext SLIT("static") <+> ftext header <+> char '&' <>
 887         pprLib lib <> ppr lbl
 888       pprCEntity header lib (CFunction (DynamicTarget)) =
 889         ptext SLIT("dynamic")
 890       pprCEntity _      _   (CWrapper) = ptext SLIT("wrapper")
 891       --
 892       pprLib lib | nullFS lib = empty
 893                  | otherwise  = char '[' <> ppr lib <> char ']'
 894
 895 instance Outputable ForeignExport where
 896   ppr (CExport  (CExportStatic lbl cconv)) =
 897     ppr cconv <+> char '"' <> ppr lbl <> char '"'
 898   ppr (DNExport                          ) =
 899     ptext SLIT("dotnet") <+> ptext SLIT("\"<unused>\"")
 900
 901 instance Outputable FoType where
 902   ppr DNType = ptext SLIT("type dotnet")
 903 \end{code}
 904
 905
 906 %************************************************************************
 907 %*                                                                      *
 908 \subsection{Transformation rules}
 909 %*                                                                      *
 910 %************************************************************************
 911
 912 \begin{code}
 913 type LRuleDecl name = Located (RuleDecl name)
 914
 915 data RuleDecl name
 916   = HsRule                      -- Source rule
 917         RuleName                -- Rule name
 918         Activation
 919         [RuleBndr name]         -- Forall'd vars; after typechecking this includes tyvars
 920         (Located (HsExpr name)) -- LHS
 921         NameSet                 -- Free-vars from the LHS
 922         (Located (HsExpr name)) -- RHS
 923         NameSet                 -- Free-vars from the RHS
 924
 925 data RuleBndr name
 926   = RuleBndr (Located name)
 927   | RuleBndrSig (Located name) (LHsType name)
 928
 929 collectRuleBndrSigTys :: [RuleBndr name] -> [LHsType name]
 930 collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ ty <- bndrs]
 931
 932 instance OutputableBndr name => Outputable (RuleDecl name) where
 933   ppr (HsRule name act ns lhs fv_lhs rhs fv_rhs)
 934         = sep [text "{-# RULES" <+> doubleQuotes (ftext name) <+> ppr act,
 935                nest 4 (pp_forall <+> pprExpr (unLoc lhs)),
 936                nest 4 (equals <+> pprExpr (unLoc rhs) <+> text "#-}") ]
 937         where
 938           pp_forall | null ns   = empty
 939                     | otherwise = text "forall" <+> fsep (map ppr ns) <> dot
 940
 941 instance OutputableBndr name => Outputable (RuleBndr name) where
 942    ppr (RuleBndr name) = ppr name
 943    ppr (RuleBndrSig name ty) = ppr name <> dcolon <> ppr ty
 944 \end{code}
 945
 946 %************************************************************************
 947 %*                                                                      *
 948 \subsection[DocDecl]{Document comments}
 949 %*                                                                      *
 950 %************************************************************************
 951
 952 \begin{code}
 953
 954 type LDocDecl name = Located (DocDecl name)
 955
 956 data DocDecl name
 957   = DocCommentNext (HsDoc name)
 958   | DocCommentPrev (HsDoc name)
 959   | DocCommentNamed String (HsDoc name)
 960   | DocGroup Int (HsDoc name)
 961
 962 -- Okay, I need to reconstruct the document comments, but for now:
 963 instance Outputable (DocDecl name) where
 964   ppr _ = text "<document comment>"
 965
 966 docDeclDoc (DocCommentNext d) = d
 967 docDeclDoc (DocCommentPrev d) = d
 968 docDeclDoc (DocCommentNamed _ d) = d
 969 docDeclDoc (DocGroup _ d) = d
 970
 971 \end{code}
 972
 973 %************************************************************************
 974 %*                                                                      *
 975 \subsection[DeprecDecl]{Deprecations}
 976 %*                                                                      *
 977 %************************************************************************
 978
 979 We use exported entities for things to deprecate.
 980
 981 \begin{code}
 982 type LDeprecDecl name = Located (DeprecDecl name)
 983
 984 data DeprecDecl name = Deprecation name DeprecTxt
 985
 986 instance OutputableBndr name => Outputable (DeprecDecl name) where
 987     ppr (Deprecation thing txt)
 988       = hsep [text "{-# DEPRECATED", ppr thing, doubleQuotes (ppr txt), text "#-}"]
 989 \end{code}