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