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 NameSet          ( NameSet )
  40 import HscTypes         ( DeprecTxt )
  41 import CoreSyn          ( RuleName )
  42 import Kind             ( Kind, pprKind )
  43 import BasicTypes       ( Activation(..) )
  44 import ForeignCall      ( CCallTarget(..), DNCallSpec, CCallConv, Safety,
  45                           CExportSpec(..), CLabelString )
  46
  47 -- others:
  48 import FunDeps          ( pprFundeps )
  49 import Class            ( FunDep )
  50 import Outputable
  51 import Util             ( count )
  52 import SrcLoc           ( Located(..), unLoc, noLoc )
  53 import FastString
  54 \end{code}
  55
  56
  57 %************************************************************************
  58 %*                                                                      *
  59 \subsection[HsDecl]{Declarations}
  60 %*                                                                      *
  61 %************************************************************************
  62
  63 \begin{code}
  64 type LHsDecl id = Located (HsDecl id)
  65
  66 data HsDecl id
  67   = TyClD       (TyClDecl id)
  68   | InstD       (InstDecl  id)
  69   | ValD        (HsBind id)
  70   | SigD        (Sig id)
  71   | DefD        (DefaultDecl id)
  72   | ForD        (ForeignDecl id)
  73   | DeprecD     (DeprecDecl id)
  74   | RuleD       (RuleDecl id)
  75   | SpliceD     (SpliceDecl id)
  76
  77 -- NB: all top-level fixity decls are contained EITHER
  78 -- EITHER SigDs
  79 -- OR     in the ClassDecls in TyClDs
  80 --
  81 -- The former covers
  82 --      a) data constructors
  83 --      b) class methods (but they can be also done in the
  84 --              signatures of class decls)
  85 --      c) imported functions (that have an IfacSig)
  86 --      d) top level decls
  87 --
  88 -- The latter is for class methods only
  89
  90 -- A [HsDecl] is categorised into a HsGroup before being
  91 -- fed to the renamer.
  92 data HsGroup id
  93   = HsGroup {
  94         hs_valds  :: HsValBinds id,
  95         hs_tyclds :: [LTyClDecl id],
  96         hs_instds :: [LInstDecl id],
  97
  98         hs_fixds  :: [LFixitySig id],
  99                 -- Snaffled out of both top-level fixity signatures,
 100                 -- and those in class declarations
 101
 102         hs_defds  :: [LDefaultDecl id],
 103         hs_fords  :: [LForeignDecl id],
 104         hs_depds  :: [LDeprecDecl id],
 105         hs_ruleds :: [LRuleDecl id]
 106   }
 107
 108 emptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup a
 109 emptyRdrGroup = emptyGroup { hs_valds = emptyValBindsIn }
 110 emptyRnGroup  = emptyGroup { hs_valds = emptyValBindsOut }
 111
 112 emptyGroup = HsGroup { hs_tyclds = [], hs_instds = [],
 113                        hs_fixds = [], hs_defds = [], hs_fords = [],
 114                        hs_depds = [], hs_ruleds = [],
 115                        hs_valds = error "emptyGroup hs_valds: Can't happen" }
 116
 117 appendGroups :: HsGroup a -> HsGroup a -> HsGroup a
 118 appendGroups
 119     HsGroup {
 120         hs_valds  = val_groups1,
 121         hs_tyclds = tyclds1,
 122         hs_instds = instds1,
 123         hs_fixds  = fixds1,
 124         hs_defds  = defds1,
 125         hs_fords  = fords1,
 126         hs_depds  = depds1,
 127         hs_ruleds = rulds1 }
 128     HsGroup {
 129         hs_valds  = val_groups2,
 130         hs_tyclds = tyclds2,
 131         hs_instds = instds2,
 132         hs_fixds  = fixds2,
 133         hs_defds  = defds2,
 134         hs_fords  = fords2,
 135         hs_depds  = depds2,
 136         hs_ruleds = rulds2 }
 137   =
 138     HsGroup {
 139         hs_valds  = val_groups1 `plusHsValBinds` val_groups2,
 140         hs_tyclds = tyclds1 ++ tyclds2,
 141         hs_instds = instds1 ++ instds2,
 142         hs_fixds  = fixds1 ++ fixds2,
 143         hs_defds  = defds1 ++ defds2,
 144         hs_fords  = fords1 ++ fords2,
 145         hs_depds  = depds1 ++ depds2,
 146         hs_ruleds = rulds1 ++ rulds2 }
 147 \end{code}
 148
 149 \begin{code}
 150 instance OutputableBndr name => Outputable (HsDecl name) where
 151     ppr (TyClD dcl)  = ppr dcl
 152     ppr (ValD binds) = ppr binds
 153     ppr (DefD def)   = ppr def
 154     ppr (InstD inst) = ppr inst
 155     ppr (ForD fd)    = ppr fd
 156     ppr (SigD sd)    = ppr sd
 157     ppr (RuleD rd)   = ppr rd
 158     ppr (DeprecD dd) = ppr dd
 159     ppr (SpliceD dd) = ppr dd
 160
 161 instance OutputableBndr name => Outputable (HsGroup name) where
 162     ppr (HsGroup { hs_valds  = val_decls,
 163                    hs_tyclds = tycl_decls,
 164                    hs_instds = inst_decls,
 165                    hs_fixds  = fix_decls,
 166                    hs_depds  = deprec_decls,
 167                    hs_fords  = foreign_decls,
 168                    hs_defds  = default_decls,
 169                    hs_ruleds = rule_decls })
 170         = vcat [ppr_ds fix_decls, ppr_ds default_decls,
 171                 ppr_ds deprec_decls, ppr_ds rule_decls,
 172                 ppr val_decls,
 173                 ppr_ds tycl_decls, ppr_ds inst_decls,
 174                 ppr_ds foreign_decls]
 175         where
 176           ppr_ds [] = empty
 177           ppr_ds ds = text "" $$ vcat (map ppr ds)
 178
 179 data SpliceDecl id = SpliceDecl (Located (HsExpr id))   -- Top level splice
 180
 181 instance OutputableBndr name => Outputable (SpliceDecl name) where
 182    ppr (SpliceDecl e) = ptext SLIT("$") <> parens (pprExpr (unLoc e))
 183 \end{code}
 184
 185
 186 %************************************************************************
 187 %*                                                                      *
 188 \subsection[TyDecl]{@data@, @newtype@ or @type@ (synonym) type declaration}
 189 %*                                                                      *
 190 %************************************************************************
 191
 192                 --------------------------------
 193                         THE NAMING STORY
 194                 --------------------------------
 195
 196 Here is the story about the implicit names that go with type, class,
 197 and instance decls.  It's a bit tricky, so pay attention!
 198
 199 "Implicit" (or "system") binders
 200 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 201   Each data type decl defines
 202         a worker name for each constructor
 203         to-T and from-T convertors
 204   Each class decl defines
 205         a tycon for the class
 206         a data constructor for that tycon
 207         the worker for that constructor
 208         a selector for each superclass
 209
 210 All have occurrence names that are derived uniquely from their parent
 211 declaration.
 212
 213 None of these get separate definitions in an interface file; they are
 214 fully defined by the data or class decl.  But they may *occur* in
 215 interface files, of course.  Any such occurrence must haul in the
 216 relevant type or class decl.
 217
 218 Plan of attack:
 219  - Ensure they "point to" the parent data/class decl
 220    when loading that decl from an interface file
 221    (See RnHiFiles.getSysBinders)
 222
 223  - When typechecking the decl, we build the implicit TyCons and Ids.
 224    When doing so we look them up in the name cache (RnEnv.lookupSysName),
 225    to ensure correct module and provenance is set
 226
 227 These are the two places that we have to conjure up the magic derived
 228 names.  (The actual magic is in OccName.mkWorkerOcc, etc.)
 229
 230 Default methods
 231 ~~~~~~~~~~~~~~~
 232  - Occurrence name is derived uniquely from the method name
 233    E.g. $dmmax
 234
 235  - If there is a default method name at all, it's recorded in
 236    the ClassOpSig (in HsBinds), in the DefMeth field.
 237    (DefMeth is defined in Class.lhs)
 238
 239 Source-code class decls and interface-code class decls are treated subtly
 240 differently, which has given me a great deal of confusion over the years.
 241 Here's the deal.  (We distinguish the two cases because source-code decls
 242 have (Just binds) in the tcdMeths field, whereas interface decls have Nothing.
 243
 244 In *source-code* class declarations:
 245
 246  - When parsing, every ClassOpSig gets a DefMeth with a suitable RdrName
 247    This is done by RdrHsSyn.mkClassOpSigDM
 248
 249  - The renamer renames it to a Name
 250
 251  - During typechecking, we generate a binding for each $dm for
 252    which there's a programmer-supplied default method:
 253         class Foo a where
 254           op1 :: <type>
 255           op2 :: <type>
 256           op1 = ...
 257    We generate a binding for $dmop1 but not for $dmop2.
 258    The Class for Foo has a NoDefMeth for op2 and a DefMeth for op1.
 259    The Name for $dmop2 is simply discarded.
 260
 261 In *interface-file* class declarations:
 262   - When parsing, we see if there's an explicit programmer-supplied default method
 263     because there's an '=' sign to indicate it:
 264         class Foo a where
 265           op1 = :: <type>       -- NB the '='
 266           op2   :: <type>
 267     We use this info to generate a DefMeth with a suitable RdrName for op1,
 268     and a NoDefMeth for op2
 269   - The interface file has a separate definition for $dmop1, with unfolding etc.
 270   - The renamer renames it to a Name.
 271   - The renamer treats $dmop1 as a free variable of the declaration, so that
 272     the binding for $dmop1 will be sucked in.  (See RnHsSyn.tyClDeclFVs)
 273     This doesn't happen for source code class decls, because they *bind* the default method.
 274
 275 Dictionary functions
 276 ~~~~~~~~~~~~~~~~~~~~
 277 Each instance declaration gives rise to one dictionary function binding.
 278
 279 The type checker makes up new source-code instance declarations
 280 (e.g. from 'deriving' or generic default methods --- see
 281 TcInstDcls.tcInstDecls1).  So we can't generate the names for
 282 dictionary functions in advance (we don't know how many we need).
 283
 284 On the other hand for interface-file instance declarations, the decl
 285 specifies the name of the dictionary function, and it has a binding elsewhere
 286 in the interface file:
 287         instance {Eq Int} = dEqInt
 288         dEqInt :: {Eq Int} <pragma info>
 289
 290 So again we treat source code and interface file code slightly differently.
 291
 292 Source code:
 293   - Source code instance decls have a Nothing in the (Maybe name) field
 294     (see data InstDecl below)
 295
 296   - The typechecker makes up a Local name for the dict fun for any source-code
 297     instance decl, whether it comes from a source-code instance decl, or whether
 298     the instance decl is derived from some other construct (e.g. 'deriving').
 299
 300   - The occurrence name it chooses is derived from the instance decl (just for
 301     documentation really) --- e.g. dNumInt.  Two dict funs may share a common
 302     occurrence name, but will have different uniques.  E.g.
 303         instance Foo [Int]  where ...
 304         instance Foo [Bool] where ...
 305     These might both be dFooList
 306
 307   - The CoreTidy phase externalises the name, and ensures the occurrence name is
 308     unique (this isn't special to dict funs).  So we'd get dFooList and dFooList1.
 309
 310   - We can take this relaxed approach (changing the occurrence name later)
 311     because dict fun Ids are not captured in a TyCon or Class (unlike default
 312     methods, say).  Instead, they are kept separately in the InstEnv.  This
 313     makes it easy to adjust them after compiling a module.  (Once we've finished
 314     compiling that module, they don't change any more.)
 315
 316
 317 Interface file code:
 318   - The instance decl gives the dict fun name, so the InstDecl has a (Just name)
 319     in the (Maybe name) field.
 320
 321   - RnHsSyn.instDeclFVs treats the dict fun name as free in the decl, so that we
 322     suck in the dfun binding
 323
 324
 325 \begin{code}
 326 -- TyClDecls are precisely the kind of declarations that can
 327 -- appear in interface files; or (internally) in GHC's interface
 328 -- for a module.  That's why (despite the misnomer) IfaceSig and ForeignType
 329 -- are both in TyClDecl
 330
 331 type LTyClDecl name = Located (TyClDecl name)
 332
 333 data TyClDecl name
 334   = ForeignType {
 335                 tcdLName    :: Located name,
 336                 tcdExtName  :: Maybe FastString,
 337                 tcdFoType   :: FoType
 338   }
 339
 340   | TyData {    tcdND     :: NewOrData,
 341                 tcdCtxt   :: LHsContext name,           -- Context
 342                 tcdLName  :: Located name,              -- Type constructor
 343                 tcdTyVars :: [LHsTyVarBndr name],       -- Type variables
 344                 tcdKindSig :: Maybe Kind,               -- Optional kind sig;
 345                                                         -- (only for the 'where' form)
 346
 347                 tcdCons   :: [LConDecl name],           -- Data constructors
 348                         -- For data T a = T1 | T2 a          the LConDecls all have ResTyH98
 349                         -- For data T a where { T1 :: T a }  the LConDecls all have ResTyGADT
 350
 351                 tcdDerivs :: Maybe [LHsType name]
 352                         -- Derivings; Nothing => not specified
 353                         --            Just [] => derive exactly what is asked
 354                         -- These "types" must be of form
 355                         --      forall ab. C ty1 ty2
 356                         -- Typically the foralls and ty args are empty, but they
 357                         -- are non-empty for the newtype-deriving case
 358     }
 359
 360   | TySynonym { tcdLName  :: Located name,              -- type constructor
 361                 tcdTyVars :: [LHsTyVarBndr name],       -- type variables
 362                 tcdSynRhs :: LHsType name               -- synonym expansion
 363     }
 364
 365   | ClassDecl { tcdCtxt    :: LHsContext name,          -- Context...
 366                 tcdLName   :: Located name,             -- Name of the class
 367                 tcdTyVars  :: [LHsTyVarBndr name],      -- Class type variables
 368                 tcdFDs     :: [Located (FunDep name)],  -- Functional deps
 369                 tcdSigs    :: [LSig name],              -- Methods' signatures
 370                 tcdMeths   :: LHsBinds name             -- Default methods
 371     }
 372
 373 data NewOrData
 374   = NewType     -- "newtype Blah ..."
 375   | DataType    -- "data Blah ..."
 376   deriving( Eq )        -- Needed because Demand derives Eq
 377 \end{code}
 378
 379 Simple classifiers
 380
 381 \begin{code}
 382 isDataDecl, isSynDecl, isClassDecl :: TyClDecl name -> Bool
 383
 384 isSynDecl (TySynonym {}) = True
 385 isSynDecl other          = False
 386
 387 isDataDecl (TyData {}) = True
 388 isDataDecl other       = False
 389
 390 isClassDecl (ClassDecl {}) = True
 391 isClassDecl other          = False
 392 \end{code}
 393
 394 Dealing with names
 395
 396 \begin{code}
 397 tcdName :: TyClDecl name -> name
 398 tcdName decl = unLoc (tcdLName decl)
 399
 400 tyClDeclNames :: Eq name => TyClDecl name -> [Located name]
 401 -- Returns all the *binding* names of the decl, along with their SrcLocs
 402 -- The first one is guaranteed to be the name of the decl
 403 -- For record fields, the first one counts as the SrcLoc
 404 -- We use the equality to filter out duplicate field names
 405
 406 tyClDeclNames (TySynonym   {tcdLName = name})  = [name]
 407 tyClDeclNames (ForeignType {tcdLName = name})  = [name]
 408
 409 tyClDeclNames (ClassDecl {tcdLName = cls_name, tcdSigs = sigs})
 410   = cls_name : [n | L _ (TypeSig n _) <- sigs]
 411
 412 tyClDeclNames (TyData {tcdLName = tc_name, tcdCons = cons})
 413   = tc_name : conDeclsNames (map unLoc cons)
 414
 415 tyClDeclTyVars (TySynonym {tcdTyVars = tvs}) = tvs
 416 tyClDeclTyVars (TyData    {tcdTyVars = tvs}) = tvs
 417 tyClDeclTyVars (ClassDecl {tcdTyVars = tvs}) = tvs
 418 tyClDeclTyVars (ForeignType {})              = []
 419 \end{code}
 420
 421 \begin{code}
 422 countTyClDecls :: [TyClDecl name] -> (Int, Int, Int, Int)
 423         -- class, data, newtype, synonym decls
 424 countTyClDecls decls
 425  = (count isClassDecl     decls,
 426     count isSynDecl       decls,
 427     count isDataTy        decls,
 428     count isNewTy         decls)
 429  where
 430    isDataTy TyData{tcdND=DataType} = True
 431    isDataTy _                      = False
 432
 433    isNewTy TyData{tcdND=NewType} = True
 434    isNewTy _                     = False
 435 \end{code}
 436
 437 \begin{code}
 438 instance OutputableBndr name
 439               => Outputable (TyClDecl name) where
 440
 441     ppr (ForeignType {tcdLName = ltycon})
 442         = hsep [ptext SLIT("foreign import type dotnet"), ppr ltycon]
 443
 444     ppr (TySynonym {tcdLName = ltycon, tcdTyVars = tyvars, tcdSynRhs = mono_ty})
 445       = hang (ptext SLIT("type") <+> pp_decl_head [] ltycon tyvars <+> equals)
 446              4 (ppr mono_ty)
 447
 448     ppr (TyData {tcdND = new_or_data, tcdCtxt = context, tcdLName = ltycon,
 449                  tcdTyVars = tyvars, tcdKindSig = mb_sig, tcdCons = condecls,
 450                  tcdDerivs = derivings})
 451       = pp_tydecl (ppr new_or_data <+> pp_decl_head (unLoc context) ltycon tyvars <+> ppr_sig mb_sig)
 452                   (pp_condecls condecls)
 453                   derivings
 454       where
 455         ppr_sig Nothing = empty
 456         ppr_sig (Just kind) = dcolon <+> pprKind kind
 457
 458     ppr (ClassDecl {tcdCtxt = context, tcdLName = lclas, tcdTyVars = tyvars, tcdFDs = fds,
 459                     tcdSigs = sigs, tcdMeths = methods})
 460       | null sigs       -- No "where" part
 461       = top_matter
 462
 463       | otherwise       -- Laid out
 464       = sep [hsep [top_matter, ptext SLIT("where {")],
 465              nest 4 (sep [sep (map ppr_sig sigs), ppr methods, char '}'])]
 466       where
 467         top_matter  = ptext SLIT("class") <+> pp_decl_head (unLoc context) lclas tyvars <+> pprFundeps (map unLoc fds)
 468         ppr_sig sig = ppr sig <> semi
 469
 470 pp_decl_head :: OutputableBndr name
 471    => HsContext name
 472    -> Located name
 473    -> [LHsTyVarBndr name]
 474    -> SDoc
 475 pp_decl_head context thing tyvars
 476   = hsep [pprHsContext context, ppr thing, interppSP tyvars]
 477 pp_condecls cs@(L _ ConDecl{ con_res = ResTyGADT _ } : _) -- In GADT syntax
 478   = hang (ptext SLIT("where")) 2 (vcat (map ppr cs))
 479 pp_condecls cs                    -- In H98 syntax
 480   = equals <+> sep (punctuate (ptext SLIT(" |")) (map ppr cs))
 481
 482 pp_tydecl pp_head pp_decl_rhs derivings
 483   = hang pp_head 4 (sep [
 484         pp_decl_rhs,
 485         case derivings of
 486           Nothing          -> empty
 487           Just ds          -> hsep [ptext SLIT("deriving"), parens (interpp'SP ds)]
 488     ])
 489
 490 instance Outputable NewOrData where
 491   ppr NewType  = ptext SLIT("newtype")
 492   ppr DataType = ptext SLIT("data")
 493 \end{code}
 494
 495
 496 %************************************************************************
 497 %*                                                                      *
 498 \subsection[ConDecl]{A data-constructor declaration}
 499 %*                                                                      *
 500 %************************************************************************
 501
 502 \begin{code}
 503 type LConDecl name = Located (ConDecl name)
 504
 505 -- data T b = forall a. Eq a => MkT a b
 506 --   MkT :: forall b a. Eq a => MkT a b
 507
 508 -- data T b where
 509 --      MkT1 :: Int -> T Int
 510
 511 -- data T = Int `MkT` Int
 512 --        | MkT2
 513
 514 -- data T a where
 515 --      Int `MkT` Int :: T Int
 516
 517 data ConDecl name
 518   = ConDecl
 519     { con_name      :: Located name         -- Constructor name; this is used for the
 520                                             -- DataCon itself, and for the user-callable wrapper Id
 521
 522     , con_explicit  :: HsExplicitForAll     -- Is there an user-written forall? (cf. HStypes.HsForAllTy)
 523
 524     , con_qvars     :: [LHsTyVarBndr name]  -- ResTyH98: the constructor's existential type variables
 525                                             -- ResTyGADT:    all the constructor's quantified type variables
 526
 527     , con_cxt       :: LHsContext name      -- The context.  This *does not* include the
 528                                             -- "stupid theta" which lives only in the TyData decl
 529
 530     , con_details   :: HsConDetails name (LBangType name)       -- The main payload
 531
 532     , con_res       :: ResType name         -- Result type of the constructor
 533     }
 534
 535 data ResType name
 536    = ResTyH98           -- Constructor was declared using Haskell 98 syntax
 537    | ResTyGADT (LHsType name)   -- Constructor was declared using GADT-style syntax,
 538                                 --      and here is its result type
 539 \end{code}
 540
 541 \begin{code}
 542 conDeclsNames :: Eq name => [ConDecl name] -> [Located name]
 543   -- See tyClDeclNames for what this does
 544   -- The function is boringly complicated because of the records
 545   -- And since we only have equality, we have to be a little careful
 546 conDeclsNames cons
 547   = snd (foldl do_one ([], []) cons)
 548   where
 549     do_one (flds_seen, acc) (ConDecl { con_name = lname, con_details = RecCon flds })
 550         = (map unLoc new_flds ++ flds_seen, lname : [f | f <- new_flds] ++ acc)
 551         where
 552           new_flds = [ f | (f,_) <- flds, not (unLoc f `elem` flds_seen) ]
 553
 554     do_one (flds_seen, acc) c
 555         = (flds_seen, (con_name c):acc)
 556
 557 conDetailsTys details = map getBangType (hsConArgs details)
 558 \end{code}
 559
 560
 561 \begin{code}
 562 instance (OutputableBndr name) => Outputable (ConDecl name) where
 563     ppr = pprConDecl
 564
 565 pprConDecl (ConDecl con expl tvs cxt details ResTyH98)
 566   = sep [pprHsForAll expl tvs cxt, ppr_details con details]
 567   where
 568     ppr_details con (InfixCon t1 t2) = hsep [ppr t1, pprHsVar con, ppr t2]
 569     ppr_details con (PrefixCon tys)  = hsep (pprHsVar con : map ppr tys)
 570     ppr_details con (RecCon fields)  = ppr con <+> ppr_fields fields
 571
 572 pprConDecl (ConDecl con expl tvs cxt details (ResTyGADT res_ty))
 573   = sep [pprHsForAll expl tvs cxt, ppr con <+> ppr_details details]
 574   where
 575     ppr_details (PrefixCon arg_tys) = dcolon <+> ppr (foldr mk_fun_ty res_ty arg_tys)
 576     ppr_details (RecCon fields)     = ppr fields <+> dcolon <+> ppr res_ty
 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         NameSet                 -- Free-vars from the LHS
 755         (Located (HsExpr name)) -- RHS
 756         NameSet                 -- Free-vars from the RHS
 757
 758 data RuleBndr name
 759   = RuleBndr (Located name)
 760   | RuleBndrSig (Located name) (LHsType name)
 761
 762 collectRuleBndrSigTys :: [RuleBndr name] -> [LHsType name]
 763 collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ ty <- bndrs]
 764
 765 instance OutputableBndr name => Outputable (RuleDecl name) where
 766   ppr (HsRule name act ns lhs fv_lhs rhs fv_rhs)
 767         = sep [text "{-# RULES" <+> doubleQuotes (ftext name) <+> ppr act,
 768                nest 4 (pp_forall <+> pprExpr (unLoc lhs)),
 769                nest 4 (equals <+> pprExpr (unLoc rhs) <+> text "#-}") ]
 770         where
 771           pp_forall | null ns   = empty
 772                     | otherwise = text "forall" <+> fsep (map ppr ns) <> dot
 773
 774 instance OutputableBndr name => Outputable (RuleBndr name) where
 775    ppr (RuleBndr name) = ppr name
 776    ppr (RuleBndrSig name ty) = ppr name <> dcolon <> ppr ty
 777 \end{code}
 778
 779
 780 %************************************************************************
 781 %*                                                                      *
 782 \subsection[DeprecDecl]{Deprecations}
 783 %*                                                                      *
 784 %************************************************************************
 785
 786 We use exported entities for things to deprecate.
 787
 788 \begin{code}
 789 type LDeprecDecl name = Located (DeprecDecl name)
 790
 791 data DeprecDecl name = Deprecation name DeprecTxt
 792
 793 instance OutputableBndr name => Outputable (DeprecDecl name) where
 794     ppr (Deprecation thing txt)
 795       = hsep [text "{-# DEPRECATED", ppr thing, doubleQuotes (ppr txt), text "#-}"]
 796 \end{code}