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