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