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