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