ghc/compiler/hsSyn/HsDecls.lhs

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