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