ghc/compiler/hsSyn/HsDecls.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section[HsDecls]{Abstract syntax: global declarations}
   5
   6 Definitions for: @TyDecl@ and @oCnDecl@, @ClassDecl@,
   7 @InstDecl@, @DefaultDecl@ and @ForeignDecl@.
   8
   9 \begin{code}
  10 module HsDecls (
  11         HsDecl(..), TyClDecl(..), InstDecl(..), RuleDecl(..), RuleBndr(..),
  12         DefaultDecl(..), HsGroup(..),
  13         ForeignDecl(..), ForeignImport(..), ForeignExport(..),
  14         CImportSpec(..), FoType(..),
  15         ConDecl(..), CoreDecl(..),
  16         BangType(..), getBangType, getBangStrictness, unbangedType,
  17         DeprecDecl(..), DeprecTxt,
  18         tyClDeclName, tyClDeclNames, tyClDeclTyVars,
  19         isClassDecl, isSynDecl, isDataDecl, isIfaceSigDecl,
  20         isTypeOrClassDecl, countTyClDecls,
  21         isSourceInstDecl, ifaceRuleDeclName,
  22         conDetailsTys,
  23         collectRuleBndrSigTys, isSrcRule
  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          ( HsBinds, MonoBinds, Sig(..) )
  33 import HsPat            ( HsConDetails(..), hsConArgs )
  34 import HsImpExp         ( pprHsVar )
  35 import HsTypes
  36 import PprCore          ( pprCoreRule )
  37 import HsCore           ( UfExpr, UfBinder, HsIdInfo, pprHsIdInfo,
  38                           eq_ufBinders, eq_ufExpr, pprUfExpr
  39                         )
  40 import CoreSyn          ( CoreRule(..), RuleName )
  41 import BasicTypes       ( NewOrData(..), StrictnessMark(..), Activation(..), FixitySig(..) )
  42 import ForeignCall      ( CCallTarget(..), DNCallSpec, CCallConv, Safety,
  43                           CExportSpec(..))
  44
  45 -- others:
  46 import Name             ( NamedThing )
  47 import FunDeps          ( pprFundeps )
  48 import TyCon            ( DataConDetails(..), visibleDataCons )
  49 import Class            ( FunDep, DefMeth(..) )
  50 import CStrings         ( CLabelString )
  51 import Outputable
  52 import Util             ( eqListBy, count )
  53 import SrcLoc           ( SrcLoc )
  54 import FastString
  55
  56 import Maybe            ( isNothing, fromJust )
  57 \end{code}
  58
  59
  60 %************************************************************************
  61 %*                                                                      *
  62 \subsection[HsDecl]{Declarations}
  63 %*                                                                      *
  64 %************************************************************************
  65
  66 \begin{code}
  67 data HsDecl id
  68   = TyClD       (TyClDecl id)
  69   | InstD       (InstDecl  id)
  70   | ValD        (MonoBinds id)
  71   | SigD        (Sig id)
  72   | DefD        (DefaultDecl id)
  73   | ForD        (ForeignDecl id)
  74   | DeprecD     (DeprecDecl id)
  75   | RuleD       (RuleDecl id)
  76   | CoreD       (CoreDecl id)
  77   | SpliceD     (HsExpr id)     -- Top level splice
  78
  79 -- NB: all top-level fixity decls are contained EITHER
  80 -- EITHER SigDs
  81 -- OR     in the ClassDecls in TyClDs
  82 --
  83 -- The former covers
  84 --      a) data constructors
  85 --      b) class methods (but they can be also done in the
  86 --              signatures of class decls)
  87 --      c) imported functions (that have an IfacSig)
  88 --      d) top level decls
  89 --
  90 -- The latter is for class methods only
  91
  92 -- A [HsDecl] is categorised into a HsGroup before being
  93 -- fed to the renamer.
  94 data HsGroup id
  95   = HsGroup {
  96         hs_valds  :: HsBinds id,
  97                 -- Before the renamer, this is a single big MonoBinds,
  98                 -- with all the bindings, and all the signatures.
  99                 -- The renamer does dependency analysis, using ThenBinds
 100                 -- to give the structure
 101
 102         hs_tyclds :: [TyClDecl id],
 103         hs_instds :: [InstDecl id],
 104
 105         hs_fixds  :: [FixitySig id],
 106                 -- Snaffled out of both top-level fixity signatures,
 107                 -- and those in class declarations
 108
 109         hs_defds  :: [DefaultDecl id],
 110         hs_fords  :: [ForeignDecl id],
 111         hs_depds  :: [DeprecDecl id],
 112         hs_ruleds :: [RuleDecl id],
 113         hs_coreds :: [CoreDecl id]
 114   }
 115 \end{code}
 116
 117 \begin{code}
 118 instance OutputableBndr name => Outputable (HsDecl name) where
 119     ppr (TyClD dcl)  = ppr dcl
 120     ppr (ValD binds) = ppr binds
 121     ppr (DefD def)   = ppr def
 122     ppr (InstD inst) = ppr inst
 123     ppr (ForD fd)    = ppr fd
 124     ppr (SigD sd)    = ppr sd
 125     ppr (RuleD rd)   = ppr rd
 126     ppr (DeprecD dd) = ppr dd
 127     ppr (CoreD dd)   = ppr dd
 128     ppr (SpliceD e)  = ptext SLIT("splice") <> parens (pprExpr e)
 129
 130 instance OutputableBndr name => Outputable (HsGroup name) where
 131     ppr (HsGroup { hs_valds  = val_decls,
 132                    hs_tyclds = tycl_decls,
 133                    hs_instds = inst_decls,
 134                    hs_fixds  = fix_decls,
 135                    hs_depds  = deprec_decls,
 136                    hs_fords  = foreign_decls,
 137                    hs_defds  = default_decls,
 138                    hs_ruleds = rule_decls,
 139                    hs_coreds = core_decls })
 140         = vcat [ppr_ds fix_decls, ppr_ds default_decls,
 141                 ppr_ds deprec_decls, ppr_ds rule_decls,
 142                 ppr val_decls,
 143                 ppr_ds tycl_decls, ppr_ds inst_decls,
 144                 ppr_ds foreign_decls, ppr_ds core_decls]
 145         where
 146           ppr_ds [] = empty
 147           ppr_ds ds = text "" $$ vcat (map ppr ds)
 148 \end{code}
 149
 150
 151 %************************************************************************
 152 %*                                                                      *
 153 \subsection[TyDecl]{@data@, @newtype@ or @type@ (synonym) type declaration}
 154 %*                                                                      *
 155 %************************************************************************
 156
 157                 --------------------------------
 158                         THE NAMING STORY
 159                 --------------------------------
 160
 161 Here is the story about the implicit names that go with type, class, and instance
 162 decls.  It's a bit tricky, so pay attention!
 163
 164 "Implicit" (or "system") binders
 165 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 166   Each data type decl defines
 167         a worker name for each constructor
 168         to-T and from-T convertors
 169   Each class decl defines
 170         a tycon for the class
 171         a data constructor for that tycon
 172         the worker for that constructor
 173         a selector for each superclass
 174
 175 All have occurrence names that are derived uniquely from their parent 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  - 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 data TyClDecl name
 295   = IfaceSig {  tcdName :: name,                -- It may seem odd to classify an interface-file signature
 296                 tcdType :: HsType name,         -- as a 'TyClDecl', but it's very convenient.
 297                 tcdIdInfo :: [HsIdInfo name],
 298                 tcdLoc :: SrcLoc
 299     }
 300
 301   | ForeignType { tcdName    :: name,           -- See remarks about IfaceSig above
 302                   tcdExtName :: Maybe FastString,
 303                   tcdFoType  :: FoType,
 304                   tcdLoc     :: SrcLoc }
 305
 306   | TyData {    tcdND     :: NewOrData,
 307                 tcdCtxt   :: HsContext name,     -- Context
 308                 tcdName   :: name,               -- Type constructor
 309                 tcdTyVars :: [HsTyVarBndr name], -- Type variables
 310                 tcdCons   :: DataConDetails (ConDecl name),      -- Data constructors
 311                 tcdDerivs :: Maybe (HsContext name),    -- Derivings; Nothing => not specified
 312                                                         -- Just [] => derive exactly what is asked
 313                 tcdGeneric :: Maybe Bool,       -- Nothing <=> source decl
 314                                                 -- Just x  <=> interface-file decl;
 315                                                 --      x=True <=> generic converter functions available
 316                                                 -- We need this for imported data decls, since the
 317                                                 -- imported modules may have been compiled with
 318                                                 -- different flags to the current compilation unit
 319                 tcdLoc     :: SrcLoc
 320     }
 321
 322   | TySynonym { tcdName :: name,                        -- type constructor
 323                 tcdTyVars :: [HsTyVarBndr name],        -- type variables
 324                 tcdSynRhs :: HsType name,               -- synonym expansion
 325                 tcdLoc    :: SrcLoc
 326     }
 327
 328   | ClassDecl { tcdCtxt    :: HsContext name,           -- Context...
 329                 tcdName    :: name,                     -- Name of the class
 330                 tcdTyVars  :: [HsTyVarBndr name],       -- The class type variables
 331                 tcdFDs     :: [FunDep name],            -- Functional dependencies
 332                 tcdSigs    :: [Sig name],               -- Methods' signatures
 333                 tcdMeths   :: Maybe (MonoBinds name),   -- Default methods
 334                                                         --      Nothing for imported class decls
 335                                                         --      Just bs for source   class decls
 336                 tcdLoc      :: SrcLoc
 337     }
 338 \end{code}
 339
 340 Simple classifiers
 341
 342 \begin{code}
 343 isIfaceSigDecl, isDataDecl, isSynDecl, isClassDecl :: TyClDecl name -> Bool
 344
 345 isIfaceSigDecl (IfaceSig {}) = True
 346 isIfaceSigDecl other         = False
 347
 348 isSynDecl (TySynonym {}) = True
 349 isSynDecl other          = False
 350
 351 isDataDecl (TyData {}) = True
 352 isDataDecl other       = False
 353
 354 isClassDecl (ClassDecl {}) = True
 355 isClassDecl other          = False
 356
 357 isTypeOrClassDecl (ClassDecl   {}) = True
 358 isTypeOrClassDecl (TyData      {}) = True
 359 isTypeOrClassDecl (TySynonym   {}) = True
 360 isTypeOrClassDecl (ForeignType {}) = True
 361 isTypeOrClassDecl other            = False
 362 \end{code}
 363
 364 Dealing with names
 365
 366 \begin{code}
 367 --------------------------------
 368 tyClDeclName :: TyClDecl name -> name
 369 tyClDeclName tycl_decl = tcdName tycl_decl
 370
 371 --------------------------------
 372 tyClDeclNames :: Eq name => TyClDecl name -> [(name, SrcLoc)]
 373 -- Returns all the *binding* names of the decl, along with their SrcLocs
 374 -- The first one is guaranteed to be the name of the decl
 375 -- For record fields, the first one counts as the SrcLoc
 376 -- We use the equality to filter out duplicate field names
 377
 378 tyClDeclNames (TySynonym   {tcdName = name, tcdLoc = loc})  = [(name,loc)]
 379 tyClDeclNames (IfaceSig    {tcdName = name, tcdLoc = loc})  = [(name,loc)]
 380 tyClDeclNames (ForeignType {tcdName = name, tcdLoc = loc})  = [(name,loc)]
 381
 382 tyClDeclNames (ClassDecl {tcdName = cls_name, tcdSigs = sigs, tcdLoc = loc})
 383   = (cls_name,loc) : [(n,loc) | ClassOpSig n _ _ loc <- sigs]
 384
 385 tyClDeclNames (TyData {tcdName = tc_name, tcdCons = cons, tcdLoc = loc})
 386   = (tc_name,loc) : conDeclsNames cons
 387
 388
 389 tyClDeclTyVars (TySynonym {tcdTyVars = tvs}) = tvs
 390 tyClDeclTyVars (TyData    {tcdTyVars = tvs}) = tvs
 391 tyClDeclTyVars (ClassDecl {tcdTyVars = tvs}) = tvs
 392 tyClDeclTyVars (ForeignType {})              = []
 393 tyClDeclTyVars (IfaceSig {})                 = []
 394 \end{code}
 395
 396 \begin{code}
 397 instance (NamedThing name, Ord name) => Eq (TyClDecl name) where
 398         -- Used only when building interface files
 399   (==) d1@(IfaceSig {}) d2@(IfaceSig {})
 400       = tcdName d1 == tcdName d2 &&
 401         tcdType d1 == tcdType d2 &&
 402         tcdIdInfo d1 == tcdIdInfo d2
 403
 404   (==) d1@(ForeignType {}) d2@(ForeignType {})
 405       = tcdName d1 == tcdName d2 &&
 406         tcdFoType d1 == tcdFoType d2
 407
 408   (==) d1@(TyData {}) d2@(TyData {})
 409       = tcdName d1 == tcdName d2 &&
 410         tcdND d1   == tcdND   d2 &&
 411         eqWithHsTyVars (tcdTyVars d1) (tcdTyVars d2) (\ env ->
 412           eq_hsContext env (tcdCtxt d1) (tcdCtxt d2)  &&
 413           eq_hsCD      env (tcdCons d1) (tcdCons d2)
 414         )
 415
 416   (==) d1@(TySynonym {}) d2@(TySynonym {})
 417       = tcdName d1 == tcdName d2 &&
 418         eqWithHsTyVars (tcdTyVars d1) (tcdTyVars d2) (\ env ->
 419           eq_hsType env (tcdSynRhs d1) (tcdSynRhs d2)
 420         )
 421
 422   (==) d1@(ClassDecl {}) d2@(ClassDecl {})
 423     = tcdName d1 == tcdName d2 &&
 424       eqWithHsTyVars (tcdTyVars d1) (tcdTyVars d2) (\ env ->
 425           eq_hsContext env (tcdCtxt d1) (tcdCtxt d2)  &&
 426           eqListBy (eq_hsFD env) (tcdFDs d1) (tcdFDs d2) &&
 427           eqListBy (eq_cls_sig env) (tcdSigs d1) (tcdSigs d2)
 428        )
 429
 430   (==) _ _ = False      -- default case
 431
 432 eq_hsCD env (DataCons c1) (DataCons c2) = eqListBy (eq_ConDecl env) c1 c2
 433 eq_hsCD env Unknown       Unknown       = True
 434 eq_hsCD env (HasCons n1)  (HasCons n2)  = n1 == n2
 435 eq_hsCD env d1            d2            = False
 436
 437 eq_hsFD env (ns1,ms1) (ns2,ms2)
 438   = eqListBy (eq_hsVar env) ns1 ns2 && eqListBy (eq_hsVar env) ms1 ms2
 439
 440 eq_cls_sig env (ClassOpSig n1 dm1 ty1 _) (ClassOpSig n2 dm2 ty2 _)
 441   = n1==n2 && dm1 `eq_dm` dm2 && eq_hsType env ty1 ty2
 442   where
 443         -- Ignore the name of the default method for (DefMeth id)
 444         -- This is used for comparing declarations before putting
 445         -- them into interface files, and the name of the default
 446         -- method isn't relevant
 447     NoDefMeth  `eq_dm` NoDefMeth  = True
 448     GenDefMeth `eq_dm` GenDefMeth = True
 449     DefMeth _  `eq_dm` DefMeth _  = True
 450     dm1        `eq_dm` dm2        = False
 451 \end{code}
 452
 453 \begin{code}
 454 countTyClDecls :: [TyClDecl name] -> (Int, Int, Int, Int, Int)
 455         -- class, data, newtype, synonym decls
 456 countTyClDecls decls
 457  = (count isClassDecl     decls,
 458     count isSynDecl       decls,
 459     count isIfaceSigDecl  decls,
 460     count isDataTy        decls,
 461     count isNewTy         decls)
 462  where
 463    isDataTy TyData{tcdND=DataType} = True
 464    isDataTy _                      = False
 465
 466    isNewTy TyData{tcdND=NewType} = True
 467    isNewTy _                     = False
 468 \end{code}
 469
 470 \begin{code}
 471 instance OutputableBndr name
 472               => Outputable (TyClDecl name) where
 473
 474     ppr (IfaceSig {tcdName = var, tcdType = ty, tcdIdInfo = info})
 475         = getPprStyle $ \ sty ->
 476            hsep [ pprHsVar var, dcolon, ppr ty, pprHsIdInfo info ]
 477
 478     ppr (ForeignType {tcdName = tycon})
 479         = hsep [ptext SLIT("foreign import type dotnet"), ppr tycon]
 480
 481     ppr (TySynonym {tcdName = tycon, tcdTyVars = tyvars, tcdSynRhs = mono_ty})
 482       = hang (ptext SLIT("type") <+> pp_decl_head [] tycon tyvars <+> equals)
 483              4 (ppr mono_ty)
 484
 485     ppr (TyData {tcdND = new_or_data, tcdCtxt = context, tcdName = tycon,
 486                  tcdTyVars = tyvars, tcdCons = condecls,
 487                  tcdDerivs = derivings})
 488       = pp_tydecl (ptext keyword <+> pp_decl_head context tycon tyvars)
 489                   (pp_condecls condecls)
 490                   derivings
 491       where
 492         keyword = case new_or_data of
 493                         NewType  -> SLIT("newtype")
 494                         DataType -> SLIT("data")
 495
 496     ppr (ClassDecl {tcdCtxt = context, tcdName = clas, tcdTyVars = tyvars, tcdFDs = fds,
 497                     tcdSigs = sigs, tcdMeths = methods})
 498       | null sigs       -- No "where" part
 499       = top_matter
 500
 501       | otherwise       -- Laid out
 502       = sep [hsep [top_matter, ptext SLIT("where {")],
 503              nest 4 (sep [sep (map ppr_sig sigs), pp_methods, char '}'])]
 504       where
 505         top_matter  = ptext SLIT("class") <+> pp_decl_head context clas tyvars <+> pprFundeps fds
 506         ppr_sig sig = ppr sig <> semi
 507
 508         pp_methods = if isNothing methods
 509                         then empty
 510                         else ppr (fromJust methods)
 511
 512 pp_decl_head :: OutputableBndr name => HsContext name -> name -> [HsTyVarBndr name] -> SDoc
 513 pp_decl_head context thing tyvars = hsep [pprHsContext context, ppr thing, interppSP tyvars]
 514
 515 pp_condecls Unknown       = ptext SLIT("{- abstract -}")
 516 pp_condecls (HasCons n)   = ptext SLIT("{- abstract with") <+> int n <+> ptext SLIT("constructors -}")
 517 pp_condecls (DataCons cs) = equals <+> sep (punctuate (ptext SLIT(" |")) (map ppr cs))
 518
 519 pp_tydecl pp_head pp_decl_rhs derivings
 520   = hang pp_head 4 (sep [
 521         pp_decl_rhs,
 522         case derivings of
 523           Nothing          -> empty
 524           Just ds          -> hsep [ptext SLIT("deriving"), ppr_hs_context ds]
 525     ])
 526 \end{code}
 527
 528
 529 %************************************************************************
 530 %*                                                                      *
 531 \subsection[ConDecl]{A data-constructor declaration}
 532 %*                                                                      *
 533 %************************************************************************
 534
 535 \begin{code}
 536 data ConDecl name
 537   = ConDecl     name                    -- Constructor name; this is used for the
 538                                         -- DataCon itself, and for the user-callable wrapper Id
 539
 540                 [HsTyVarBndr name]      -- Existentially quantified type variables
 541                 (HsContext name)        -- ...and context
 542                                         -- If both are empty then there are no existentials
 543
 544                 (HsConDetails name (BangType name))
 545                 SrcLoc
 546 \end{code}
 547
 548 \begin{code}
 549 conDeclsNames :: Eq name => DataConDetails (ConDecl name) -> [(name,SrcLoc)]
 550   -- See tyClDeclNames for what this does
 551   -- The function is boringly complicated because of the records
 552   -- And since we only have equality, we have to be a little careful
 553 conDeclsNames cons
 554   = snd (foldl do_one ([], []) (visibleDataCons cons))
 555   where
 556     do_one (flds_seen, acc) (ConDecl name _ _ (RecCon flds) loc)
 557         = (new_flds ++ flds_seen, (name,loc) : [(f,loc) | f <- new_flds] ++ acc)
 558         where
 559           new_flds = [ f | (f,_) <- flds, not (f `elem` flds_seen) ]
 560
 561     do_one (flds_seen, acc) (ConDecl name _ _ _ loc)
 562         = (flds_seen, (name,loc):acc)
 563 \end{code}
 564
 565 \begin{code}
 566 conDetailsTys details = map getBangType (hsConArgs details)
 567
 568 eq_ConDecl env (ConDecl n1 tvs1 cxt1 cds1 _)
 569                (ConDecl n2 tvs2 cxt2 cds2 _)
 570   = n1 == n2 &&
 571     (eq_hsTyVars env tvs1 tvs2  $ \ env ->
 572      eq_hsContext env cxt1 cxt2 &&
 573      eq_ConDetails env cds1 cds2)
 574
 575 eq_ConDetails env (PrefixCon bts1) (PrefixCon bts2)
 576   = eqListBy (eq_btype env) bts1 bts2
 577 eq_ConDetails env (InfixCon bta1 btb1) (InfixCon bta2 btb2)
 578   = eq_btype env bta1 bta2 && eq_btype env btb1 btb2
 579 eq_ConDetails env (RecCon fs1) (RecCon fs2)
 580   = eqListBy (eq_fld env) fs1 fs2
 581 eq_ConDetails env _ _ = False
 582
 583 eq_fld env (ns1,bt1) (ns2, bt2) = ns1==ns2 && eq_btype env bt1 bt2
 584 \end{code}
 585
 586 \begin{code}
 587 data BangType name = BangType StrictnessMark (HsType name)
 588
 589 getBangType       (BangType _ ty) = ty
 590 getBangStrictness (BangType s _)  = s
 591
 592 unbangedType ty = BangType NotMarkedStrict ty
 593
 594 eq_btype env (BangType s1 t1) (BangType s2 t2) = s1==s2 && eq_hsType env t1 t2
 595 \end{code}
 596
 597 \begin{code}
 598 instance (OutputableBndr name) => Outputable (ConDecl name) where
 599     ppr (ConDecl con tvs cxt con_details loc)
 600       = sep [pprHsForAll tvs cxt, ppr_con_details con con_details]
 601
 602 ppr_con_details con (InfixCon ty1 ty2)
 603   = hsep [ppr_bang ty1, ppr con, ppr_bang ty2]
 604
 605 -- ConDecls generated by MkIface.ifaceTyThing always have a PrefixCon, even
 606 -- if the constructor is an infix one.  This is because in an interface file
 607 -- we don't distinguish between the two.  Hence when printing these for the
 608 -- user, we need to parenthesise infix constructor names.
 609 ppr_con_details con (PrefixCon tys)
 610   = hsep (pprHsVar con : map ppr_bang tys)
 611
 612 ppr_con_details con (RecCon fields)
 613   = ppr con <+> braces (sep (punctuate comma (map ppr_field fields)))
 614   where
 615     ppr_field (n, ty) = ppr n <+> dcolon <+> ppr_bang ty
 616
 617 instance OutputableBndr name => Outputable (BangType name) where
 618     ppr = ppr_bang
 619
 620 ppr_bang (BangType s ty) = ppr s <> pprParendHsType ty
 621 \end{code}
 622
 623
 624 %************************************************************************
 625 %*                                                                      *
 626 \subsection[InstDecl]{An instance declaration
 627 %*                                                                      *
 628 %************************************************************************
 629
 630 \begin{code}
 631 data InstDecl name
 632   = InstDecl    (HsType name)   -- Context => Class Instance-type
 633                                 -- Using a polytype means that the renamer conveniently
 634                                 -- figures out the quantified type variables for us.
 635
 636                 (MonoBinds name)
 637
 638                 [Sig name]              -- User-supplied pragmatic info
 639
 640                 (Maybe name)            -- Name for the dictionary function
 641                                         -- Nothing for source-file instance decls
 642
 643                 SrcLoc
 644
 645 isSourceInstDecl :: InstDecl name -> Bool
 646 isSourceInstDecl (InstDecl _ _ _ maybe_dfun _) = isNothing maybe_dfun
 647 \end{code}
 648
 649 \begin{code}
 650 instance (OutputableBndr name) => Outputable (InstDecl name) where
 651
 652     ppr (InstDecl inst_ty binds uprags maybe_dfun_name src_loc)
 653       = vcat [hsep [ptext SLIT("instance"), ppr inst_ty, ptext SLIT("where")],
 654               nest 4 (ppr uprags),
 655               nest 4 (ppr binds) ]
 656       where
 657         pp_dfun = case maybe_dfun_name of
 658                     Just df -> ppr df
 659                     Nothing -> empty
 660 \end{code}
 661
 662 \begin{code}
 663 instance Ord name => Eq (InstDecl name) where
 664         -- Used for interface comparison only, so don't compare bindings
 665   (==) (InstDecl inst_ty1 _ _ dfun1 _) (InstDecl inst_ty2 _ _ dfun2 _)
 666        = inst_ty1 == inst_ty2 && dfun1 == dfun2
 667 \end{code}
 668
 669
 670 %************************************************************************
 671 %*                                                                      *
 672 \subsection[DefaultDecl]{A @default@ declaration}
 673 %*                                                                      *
 674 %************************************************************************
 675
 676 There can only be one default declaration per module, but it is hard
 677 for the parser to check that; we pass them all through in the abstract
 678 syntax, and that restriction must be checked in the front end.
 679
 680 \begin{code}
 681 data DefaultDecl name
 682   = DefaultDecl [HsType name]
 683                 SrcLoc
 684
 685 instance (OutputableBndr name)
 686               => Outputable (DefaultDecl name) where
 687
 688     ppr (DefaultDecl tys src_loc)
 689       = ptext SLIT("default") <+> parens (interpp'SP tys)
 690 \end{code}
 691
 692 %************************************************************************
 693 %*                                                                      *
 694 \subsection{Foreign function interface declaration}
 695 %*                                                                      *
 696 %************************************************************************
 697
 698 \begin{code}
 699
 700 -- foreign declarations are distinguished as to whether they define or use a
 701 -- Haskell name
 702 --
 703 -- * the Boolean value indicates whether the pre-standard deprecated syntax
 704 --   has been used
 705 --
 706 data ForeignDecl name
 707   = ForeignImport name (HsType name) ForeignImport Bool SrcLoc  -- defines name
 708   | ForeignExport name (HsType name) ForeignExport Bool SrcLoc  -- uses name
 709
 710 -- yield the Haskell name defined or used in a foreign declaration
 711 --
 712 foreignDeclName                           :: ForeignDecl name -> name
 713 foreignDeclName (ForeignImport n _ _ _ _)  = n
 714 foreignDeclName (ForeignExport n _ _ _ _)  = n
 715
 716 -- specification of an imported external entity in dependence on the calling
 717 -- convention
 718 --
 719 data ForeignImport = -- import of a C entity
 720                      --
 721                      -- * the two strings specifying a header file or library
 722                      --   may be empty, which indicates the absence of a
 723                      --   header or object specification (both are not used
 724                      --   in the case of `CWrapper' and when `CFunction'
 725                      --   has a dynamic target)
 726                      --
 727                      -- * the calling convention is irrelevant for code
 728                      --   generation in the case of `CLabel', but is needed
 729                      --   for pretty printing
 730                      --
 731                      -- * `Safety' is irrelevant for `CLabel' and `CWrapper'
 732                      --
 733                      CImport  CCallConv       -- ccall or stdcall
 734                               Safety          -- safe or unsafe
 735                               FastString      -- name of C header
 736                               FastString      -- name of library object
 737                               CImportSpec     -- details of the C entity
 738
 739                      -- import of a .NET function
 740                      --
 741                    | DNImport DNCallSpec
 742
 743 -- details of an external C entity
 744 --
 745 data CImportSpec = CLabel    CLabelString     -- import address of a C label
 746                  | CFunction CCallTarget      -- static or dynamic function
 747                  | CWrapper                   -- wrapper to expose closures
 748                                               -- (former f.e.d.)
 749
 750 -- specification of an externally exported entity in dependence on the calling
 751 -- convention
 752 --
 753 data ForeignExport = CExport  CExportSpec    -- contains the calling convention
 754                    | DNExport                -- presently unused
 755
 756 -- abstract type imported from .NET
 757 --
 758 data FoType = DNType            -- In due course we'll add subtype stuff
 759             deriving (Eq)       -- Used for equality instance for TyClDecl
 760
 761
 762 -- pretty printing of foreign declarations
 763 --
 764
 765 instance OutputableBndr name => Outputable (ForeignDecl name) where
 766   ppr (ForeignImport n ty fimport _ _) =
 767     ptext SLIT("foreign import") <+> ppr fimport <+>
 768     ppr n <+> dcolon <+> ppr ty
 769   ppr (ForeignExport n ty fexport _ _) =
 770     ptext SLIT("foreign export") <+> ppr fexport <+>
 771     ppr n <+> dcolon <+> ppr ty
 772
 773 instance Outputable ForeignImport where
 774   ppr (DNImport                         spec) =
 775     ptext SLIT("dotnet") <+> ppr spec
 776   ppr (CImport  cconv safety header lib spec) =
 777     ppr cconv <+> ppr safety <+>
 778     char '"' <> pprCEntity header lib spec <> char '"'
 779     where
 780       pprCEntity header lib (CLabel lbl) =
 781         ptext SLIT("static") <+> ftext header <+> char '&' <>
 782         pprLib lib <> ppr lbl
 783       pprCEntity header lib (CFunction (StaticTarget lbl)) =
 784         ptext SLIT("static") <+> ftext header <+> char '&' <>
 785         pprLib lib <> ppr lbl
 786       pprCEntity header lib (CFunction (DynamicTarget)) =
 787         ptext SLIT("dynamic")
 788       pprCEntity header lib (CFunction (CasmTarget _)) =
 789         panic "HsDecls.pprCEntity: malformed C function target"
 790       pprCEntity _      _   (CWrapper) = ptext SLIT("wrapper")
 791       --
 792       pprLib lib | nullFastString lib = empty
 793                  | otherwise          = char '[' <> ppr lib <> char ']'
 794
 795 instance Outputable ForeignExport where
 796   ppr (CExport  (CExportStatic lbl cconv)) =
 797     ppr cconv <+> char '"' <> ppr lbl <> char '"'
 798   ppr (DNExport                          ) =
 799     ptext SLIT("dotnet") <+> ptext SLIT("\"<unused>\"")
 800
 801 instance Outputable FoType where
 802   ppr DNType = ptext SLIT("type dotnet")
 803 \end{code}
 804
 805
 806 %************************************************************************
 807 %*                                                                      *
 808 \subsection{Transformation rules}
 809 %*                                                                      *
 810 %************************************************************************
 811
 812 \begin{code}
 813 data RuleDecl name
 814   = HsRule                      -- Source rule
 815         RuleName                -- Rule name
 816         Activation
 817         [RuleBndr name]         -- Forall'd vars; after typechecking this includes tyvars
 818         (HsExpr name)   -- LHS
 819         (HsExpr name)   -- RHS
 820         SrcLoc
 821
 822   | IfaceRule                   -- One that's come in from an interface file; pre-typecheck
 823         RuleName
 824         Activation
 825         [UfBinder name]         -- Tyvars and term vars
 826         name                    -- Head of lhs
 827         [UfExpr name]           -- Args of LHS
 828         (UfExpr name)           -- Pre typecheck
 829         SrcLoc
 830
 831   | IfaceRuleOut                -- Post typecheck
 832         name                    -- Head of LHS
 833         CoreRule
 834
 835 isSrcRule (HsRule _ _ _ _ _ _) = True
 836 isSrcRule other                = False
 837
 838 ifaceRuleDeclName :: RuleDecl name -> name
 839 ifaceRuleDeclName (IfaceRule _ _ _ n _ _ _) = n
 840 ifaceRuleDeclName (IfaceRuleOut n r)        = n
 841 ifaceRuleDeclName (HsRule fs _ _ _ _ _)     = pprPanic "ifaceRuleDeclName" (ppr fs)
 842
 843 data RuleBndr name
 844   = RuleBndr name
 845   | RuleBndrSig name (HsType name)
 846
 847 collectRuleBndrSigTys :: [RuleBndr name] -> [HsType name]
 848 collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ ty <- bndrs]
 849
 850 instance (NamedThing name, Ord name) => Eq (RuleDecl name) where
 851   -- Works for IfaceRules only; used when comparing interface file versions
 852   (IfaceRule n1 a1 bs1 f1 es1 rhs1 _) == (IfaceRule n2 a2 bs2 f2 es2 rhs2 _)
 853      = n1==n2 && f1 == f2 && a1==a2 &&
 854        eq_ufBinders emptyEqHsEnv bs1 bs2 (\env ->
 855        eqListBy (eq_ufExpr env) (rhs1:es1) (rhs2:es2))
 856
 857 instance OutputableBndr name => Outputable (RuleDecl name) where
 858   ppr (HsRule name act ns lhs rhs loc)
 859         = sep [text "{-# RULES" <+> doubleQuotes (ftext name) <+> ppr act,
 860                pp_forall, pprExpr lhs, equals <+> pprExpr rhs,
 861                text "#-}" ]
 862         where
 863           pp_forall | null ns   = empty
 864                     | otherwise = text "forall" <+> fsep (map ppr ns) <> dot
 865
 866   ppr (IfaceRule name act tpl_vars fn tpl_args rhs loc)
 867     = hsep [ doubleQuotes (ftext name), ppr act,
 868            ptext SLIT("__forall") <+> braces (interppSP tpl_vars),
 869            ppr fn <+> sep (map (pprUfExpr parens) tpl_args),
 870            ptext SLIT("=") <+> ppr rhs
 871       ] <+> semi
 872
 873   ppr (IfaceRuleOut fn rule) = pprCoreRule (ppr fn) rule
 874
 875 instance OutputableBndr name => Outputable (RuleBndr name) where
 876    ppr (RuleBndr name) = ppr name
 877    ppr (RuleBndrSig name ty) = ppr name <> dcolon <> ppr ty
 878 \end{code}
 879
 880
 881 %************************************************************************
 882 %*                                                                      *
 883 \subsection[DeprecDecl]{Deprecations}
 884 %*                                                                      *
 885 %************************************************************************
 886
 887 We use exported entities for things to deprecate.
 888
 889 \begin{code}
 890 data DeprecDecl name = Deprecation name DeprecTxt SrcLoc
 891
 892 type DeprecTxt = FastString     -- reason/explanation for deprecation
 893
 894 instance OutputableBndr name => Outputable (DeprecDecl name) where
 895     ppr (Deprecation thing txt _)
 896       = hsep [text "{-# DEPRECATED", ppr thing, doubleQuotes (ppr txt), text "#-}"]
 897 \end{code}
 898
 899
 900 %************************************************************************
 901 %*                                                                      *
 902                 External-core declarations
 903 %*                                                                      *
 904 %************************************************************************
 905
 906 \begin{code}
 907 data CoreDecl name      -- a Core value binding (from 'external Core' input)
 908   = CoreDecl    name
 909                 (HsType name)
 910                 (UfExpr name)
 911                 SrcLoc
 912
 913 instance OutputableBndr name => Outputable (CoreDecl name) where
 914     ppr (CoreDecl var ty rhs loc)
 915         = getPprStyle $ \ sty ->
 916           hsep [ pprHsVar var, dcolon, ppr ty, ppr rhs ]
 917 \end{code}