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