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(..), LConDecl,
  18         DeprecDecl(..),  LDeprecDecl,
  19         HsGroup(..),  emptyGroup, 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          ( HsBindGroup(..), HsBind, LHsBinds,
  34                           Sig(..), LSig, LFixitySig, pprLHsBinds )
  35 import HsPat            ( HsConDetails(..), hsConArgs )
  36 import HsImpExp         ( pprHsVar )
  37 import HsTypes
  38 import HscTypes         ( DeprecTxt )
  39 import CoreSyn          ( RuleName )
  40 import Kind             ( Kind, pprKind )
  41 import BasicTypes       ( Activation(..), RecFlag(..) )
  42 import ForeignCall      ( CCallTarget(..), DNCallSpec, CCallConv, Safety,
  43                           CExportSpec(..), CLabelString )
  44
  45 -- others:
  46 import FunDeps          ( pprFundeps )
  47 import Class            ( FunDep )
  48 import Outputable
  49 import Util             ( count )
  50 import Bag              ( emptyBag )
  51 import SrcLoc           ( Located(..), unLoc )
  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  :: [HsBindGroup id],
  94                 -- Before the renamer, this is a single big HsBindGroup,
  95                 -- with all the bindings, and all the signatures.
  96                 -- The renamer does dependency analysis, splitting it up
  97                 -- into several HsBindGroups.
  98
  99         hs_tyclds :: [LTyClDecl id],
 100         hs_instds :: [LInstDecl id],
 101
 102         hs_fixds  :: [LFixitySig id],
 103                 -- Snaffled out of both top-level fixity signatures,
 104                 -- and those in class declarations
 105
 106         hs_defds  :: [LDefaultDecl id],
 107         hs_fords  :: [LForeignDecl id],
 108         hs_depds  :: [LDeprecDecl id],
 109         hs_ruleds :: [LRuleDecl id]
 110   }
 111
 112 emptyGroup = HsGroup { hs_valds = [],
 113                        hs_tyclds = [], hs_instds = [],
 114                        hs_fixds = [], hs_defds = [], hs_fords = [],
 115                        hs_depds = [] ,hs_ruleds = [] }
 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 ++ 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 are all ConDecls
 349                         -- For data T a where { T1 :: T a }  the LConDecls are all GadtDecls
 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 _ (Sig 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
 478 pp_condecls cs@(L _ (GadtDecl _ _) : _) -- In GADT syntax
 479   = hang (ptext SLIT("where")) 2 (vcat (map ppr cs))
 480 pp_condecls cs                    -- In H98 syntax
 481   = equals <+> sep (punctuate (ptext SLIT(" |")) (map ppr cs))
 482
 483 pp_tydecl pp_head pp_decl_rhs derivings
 484   = hang pp_head 4 (sep [
 485         pp_decl_rhs,
 486         case derivings of
 487           Nothing          -> empty
 488           Just ds          -> hsep [ptext SLIT("deriving"), parens (interpp'SP ds)]
 489     ])
 490
 491 instance Outputable NewOrData where
 492   ppr NewType  = ptext SLIT("newtype")
 493   ppr DataType = ptext SLIT("data")
 494 \end{code}
 495
 496
 497 %************************************************************************
 498 %*                                                                      *
 499 \subsection[ConDecl]{A data-constructor declaration}
 500 %*                                                                      *
 501 %************************************************************************
 502
 503 \begin{code}
 504 type LConDecl name = Located (ConDecl name)
 505
 506 data ConDecl name
 507   = ConDecl     (Located name)          -- Constructor name; this is used for the
 508                                         -- DataCon itself, and for the user-callable wrapper Id
 509
 510                 [LHsTyVarBndr name]     -- Existentially quantified type variables
 511                 (LHsContext name)       -- ...and context
 512                                         -- If both are empty then there are no existentials
 513                 (HsConDetails name (LBangType name))
 514
 515   | GadtDecl    (Located name)          -- Constructor name; this is used for the
 516                                         -- DataCon itself, and for the user-callable wrapper Id
 517                 (LHsType name)          -- Constructor type; it may have HsBangs on the
 518                                         -- argument types
 519 \end{code}
 520
 521 \begin{code}
 522 conDeclsNames :: Eq name => [ConDecl name] -> [Located name]
 523   -- See tyClDeclNames for what this does
 524   -- The function is boringly complicated because of the records
 525   -- And since we only have equality, we have to be a little careful
 526 conDeclsNames cons
 527   = snd (foldl do_one ([], []) cons)
 528   where
 529     do_one (flds_seen, acc) (ConDecl lname _ _ (RecCon flds))
 530         = (map unLoc new_flds ++ flds_seen, lname : [f | f <- new_flds] ++ acc)
 531         where
 532           new_flds = [ f | (f,_) <- flds, not (unLoc f `elem` flds_seen) ]
 533
 534     do_one (flds_seen, acc) (ConDecl lname _ _ _)
 535         = (flds_seen, lname:acc)
 536
 537 -- gaw 2004
 538     do_one (flds_seen, acc) (GadtDecl lname _)
 539         = (flds_seen, lname:acc)
 540
 541 conDetailsTys details = map getBangType (hsConArgs details)
 542 \end{code}
 543
 544
 545 \begin{code}
 546 instance (OutputableBndr name) => Outputable (ConDecl name) where
 547     ppr (ConDecl con tvs cxt con_details)
 548       = sep [pprHsForAll Explicit tvs cxt, ppr_con_details con con_details]
 549     ppr (GadtDecl con ty)
 550       = ppr con <+> dcolon <+> ppr ty
 551
 552 ppr_con_details con (InfixCon ty1 ty2)
 553   = hsep [ppr ty1, pprHsVar con, ppr ty2]
 554
 555 -- ConDecls generated by MkIface.ifaceTyThing always have a PrefixCon, even
 556 -- if the constructor is an infix one.  This is because in an interface file
 557 -- we don't distinguish between the two.  Hence when printing these for the
 558 -- user, we need to parenthesise infix constructor names.
 559 ppr_con_details con (PrefixCon tys)
 560   = hsep (pprHsVar con : map ppr tys)
 561
 562 ppr_con_details con (RecCon fields)
 563   = ppr con <+> braces (sep (punctuate comma (map ppr_field fields)))
 564   where
 565     ppr_field (n, ty) = ppr n <+> dcolon <+> ppr ty
 566
 567 \end{code}
 568
 569 %************************************************************************
 570 %*                                                                      *
 571 \subsection[InstDecl]{An instance declaration
 572 %*                                                                      *
 573 %************************************************************************
 574
 575 \begin{code}
 576 type LInstDecl name = Located (InstDecl name)
 577
 578 data InstDecl name
 579   = InstDecl    (LHsType name)  -- Context => Class Instance-type
 580                                 -- Using a polytype means that the renamer conveniently
 581                                 -- figures out the quantified type variables for us.
 582                 (LHsBinds name)
 583                 [LSig name]             -- User-supplied pragmatic info
 584
 585 instance (OutputableBndr name) => Outputable (InstDecl name) where
 586
 587     ppr (InstDecl inst_ty binds uprags)
 588       = vcat [hsep [ptext SLIT("instance"), ppr inst_ty, ptext SLIT("where")],
 589               nest 4 (ppr uprags),
 590               nest 4 (pprLHsBinds binds) ]
 591 \end{code}
 592
 593 %************************************************************************
 594 %*                                                                      *
 595 \subsection[DefaultDecl]{A @default@ declaration}
 596 %*                                                                      *
 597 %************************************************************************
 598
 599 There can only be one default declaration per module, but it is hard
 600 for the parser to check that; we pass them all through in the abstract
 601 syntax, and that restriction must be checked in the front end.
 602
 603 \begin{code}
 604 type LDefaultDecl name = Located (DefaultDecl name)
 605
 606 data DefaultDecl name
 607   = DefaultDecl [LHsType name]
 608
 609 instance (OutputableBndr name)
 610               => Outputable (DefaultDecl name) where
 611
 612     ppr (DefaultDecl tys)
 613       = ptext SLIT("default") <+> parens (interpp'SP tys)
 614 \end{code}
 615
 616 %************************************************************************
 617 %*                                                                      *
 618 \subsection{Foreign function interface declaration}
 619 %*                                                                      *
 620 %************************************************************************
 621
 622 \begin{code}
 623
 624 -- foreign declarations are distinguished as to whether they define or use a
 625 -- Haskell name
 626 --
 627 --  * the Boolean value indicates whether the pre-standard deprecated syntax
 628 --   has been used
 629 --
 630 type LForeignDecl name = Located (ForeignDecl name)
 631
 632 data ForeignDecl name
 633   = ForeignImport (Located name) (LHsType name) ForeignImport Bool  -- defines name
 634   | ForeignExport (Located name) (LHsType name) ForeignExport Bool  -- uses name
 635
 636 -- specification of an imported external entity in dependence on the calling
 637 -- convention
 638 --
 639 data ForeignImport = -- import of a C entity
 640                      --
 641                      --  * the two strings specifying a header file or library
 642                      --   may be empty, which indicates the absence of a
 643                      --   header or object specification (both are not used
 644                      --   in the case of `CWrapper' and when `CFunction'
 645                      --   has a dynamic target)
 646                      --
 647                      --  * the calling convention is irrelevant for code
 648                      --   generation in the case of `CLabel', but is needed
 649                      --   for pretty printing
 650                      --
 651                      --  * `Safety' is irrelevant for `CLabel' and `CWrapper'
 652                      --
 653                      CImport  CCallConv       -- ccall or stdcall
 654                               Safety          -- safe or unsafe
 655                               FastString      -- name of C header
 656                               FastString      -- name of library object
 657                               CImportSpec     -- details of the C entity
 658
 659                      -- import of a .NET function
 660                      --
 661                    | DNImport DNCallSpec
 662
 663 -- details of an external C entity
 664 --
 665 data CImportSpec = CLabel    CLabelString     -- import address of a C label
 666                  | CFunction CCallTarget      -- static or dynamic function
 667                  | CWrapper                   -- wrapper to expose closures
 668                                               -- (former f.e.d.)
 669
 670 -- specification of an externally exported entity in dependence on the calling
 671 -- convention
 672 --
 673 data ForeignExport = CExport  CExportSpec    -- contains the calling convention
 674                    | DNExport                -- presently unused
 675
 676 -- abstract type imported from .NET
 677 --
 678 data FoType = DNType            -- In due course we'll add subtype stuff
 679             deriving (Eq)       -- Used for equality instance for TyClDecl
 680
 681
 682 -- pretty printing of foreign declarations
 683 --
 684
 685 instance OutputableBndr name => Outputable (ForeignDecl name) where
 686   ppr (ForeignImport n ty fimport _) =
 687     ptext SLIT("foreign import") <+> ppr fimport <+>
 688     ppr n <+> dcolon <+> ppr ty
 689   ppr (ForeignExport n ty fexport _) =
 690     ptext SLIT("foreign export") <+> ppr fexport <+>
 691     ppr n <+> dcolon <+> ppr ty
 692
 693 instance Outputable ForeignImport where
 694   ppr (DNImport                         spec) =
 695     ptext SLIT("dotnet") <+> ppr spec
 696   ppr (CImport  cconv safety header lib spec) =
 697     ppr cconv <+> ppr safety <+>
 698     char '"' <> pprCEntity header lib spec <> char '"'
 699     where
 700       pprCEntity header lib (CLabel lbl) =
 701         ptext SLIT("static") <+> ftext header <+> char '&' <>
 702         pprLib lib <> ppr lbl
 703       pprCEntity header lib (CFunction (StaticTarget lbl)) =
 704         ptext SLIT("static") <+> ftext header <+> char '&' <>
 705         pprLib lib <> ppr lbl
 706       pprCEntity header lib (CFunction (DynamicTarget)) =
 707         ptext SLIT("dynamic")
 708       pprCEntity _      _   (CWrapper) = ptext SLIT("wrapper")
 709       --
 710       pprLib lib | nullFastString lib = empty
 711                  | otherwise          = char '[' <> ppr lib <> char ']'
 712
 713 instance Outputable ForeignExport where
 714   ppr (CExport  (CExportStatic lbl cconv)) =
 715     ppr cconv <+> char '"' <> ppr lbl <> char '"'
 716   ppr (DNExport                          ) =
 717     ptext SLIT("dotnet") <+> ptext SLIT("\"<unused>\"")
 718
 719 instance Outputable FoType where
 720   ppr DNType = ptext SLIT("type dotnet")
 721 \end{code}
 722
 723
 724 %************************************************************************
 725 %*                                                                      *
 726 \subsection{Transformation rules}
 727 %*                                                                      *
 728 %************************************************************************
 729
 730 \begin{code}
 731 type LRuleDecl name = Located (RuleDecl name)
 732
 733 data RuleDecl name
 734   = HsRule                      -- Source rule
 735         RuleName                -- Rule name
 736         Activation
 737         [RuleBndr name]         -- Forall'd vars; after typechecking this includes tyvars
 738         (Located (HsExpr name)) -- LHS
 739         (Located (HsExpr name)) -- RHS
 740
 741 data RuleBndr name
 742   = RuleBndr (Located name)
 743   | RuleBndrSig (Located name) (LHsType name)
 744
 745 collectRuleBndrSigTys :: [RuleBndr name] -> [LHsType name]
 746 collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ ty <- bndrs]
 747
 748 instance OutputableBndr name => Outputable (RuleDecl name) where
 749   ppr (HsRule name act ns lhs rhs)
 750         = sep [text "{-# RULES" <+> doubleQuotes (ftext name) <+> ppr act,
 751                nest 4 (pp_forall <+> pprExpr (unLoc lhs)),
 752                nest 4 (equals <+> pprExpr (unLoc rhs) <+> text "#-}") ]
 753         where
 754           pp_forall | null ns   = empty
 755                     | otherwise = text "forall" <+> fsep (map ppr ns) <> dot
 756
 757 instance OutputableBndr name => Outputable (RuleBndr name) where
 758    ppr (RuleBndr name) = ppr name
 759    ppr (RuleBndrSig name ty) = ppr name <> dcolon <> ppr ty
 760 \end{code}
 761
 762
 763 %************************************************************************
 764 %*                                                                      *
 765 \subsection[DeprecDecl]{Deprecations}
 766 %*                                                                      *
 767 %************************************************************************
 768
 769 We use exported entities for things to deprecate.
 770
 771 \begin{code}
 772 type LDeprecDecl name = Located (DeprecDecl name)
 773
 774 data DeprecDecl name = Deprecation name DeprecTxt
 775
 776 instance OutputableBndr name => Outputable (DeprecDecl name) where
 777     ppr (Deprecation thing txt)
 778       = hsep [text "{-# DEPRECATED", ppr thing, doubleQuotes (ppr txt), text "#-}"]
 779 \end{code}