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