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