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(..),
  13         ForeignDecl(..), ForeignImport(..), ForeignExport(..),
  14         CImportSpec(..), FoType(..),
  15         ConDecl(..), CoreDecl(..),
  16         BangType(..), getBangType, getBangStrictness, unbangedType,
  17         DeprecDecl(..), DeprecTxt,
  18         hsDeclName, instDeclName,
  19         tyClDeclName, tyClDeclNames, tyClDeclTyVars,
  20         isClassDecl, isSynDecl, isDataDecl, isIfaceSigDecl,
  21         isTypeOrClassDecl, countTyClDecls,
  22         isSourceInstDecl, ifaceRuleDeclName,
  23         conDetailsTys,
  24         collectRuleBndrSigTys, isSrcRule
  25     ) where
  26
  27 #include "HsVersions.h"
  28
  29 -- friends:
  30 import {-# SOURCE #-}   HsExpr( HsExpr, pprExpr )
  31         -- Because Expr imports Decls via HsBracket
  32
  33 import HsBinds          ( HsBinds, MonoBinds, Sig(..) )
  34 import HsPat            ( HsConDetails(..), hsConArgs )
  35 import HsImpExp         ( pprHsVar )
  36 import HsTypes
  37 import PprCore          ( pprCoreRule )
  38 import HsCore           ( UfExpr, UfBinder, HsIdInfo, pprHsIdInfo,
  39                           eq_ufBinders, eq_ufExpr, pprUfExpr
  40                         )
  41 import CoreSyn          ( CoreRule(..), RuleName )
  42 import BasicTypes       ( NewOrData(..), StrictnessMark(..), Activation(..), FixitySig(..) )
  43 import ForeignCall      ( CCallTarget(..), DNCallSpec, CCallConv, Safety,
  44                           CExportSpec(..))
  45
  46 -- others:
  47 import Name             ( NamedThing )
  48 import FunDeps          ( pprFundeps )
  49 import TyCon            ( DataConDetails(..), visibleDataCons )
  50 import Class            ( FunDep, DefMeth(..) )
  51 import CStrings         ( CLabelString )
  52 import Outputable
  53 import Util             ( eqListBy, count )
  54 import SrcLoc           ( SrcLoc )
  55 import FastString
  56
  57 import Maybe            ( isNothing, fromJust )
  58 \end{code}
  59
  60
  61 %************************************************************************
  62 %*                                                                      *
  63 \subsection[HsDecl]{Declarations}
  64 %*                                                                      *
  65 %************************************************************************
  66
  67 \begin{code}
  68 data HsDecl id
  69   = TyClD       (TyClDecl id)
  70   | InstD       (InstDecl  id)
  71   | DefD        (DefaultDecl id)
  72   | ValD        (HsBinds id)
  73   | ForD        (ForeignDecl id)
  74   | FixD        (FixitySig id)
  75   | DeprecD     (DeprecDecl id)
  76   | RuleD       (RuleDecl id)
  77   | CoreD       (CoreDecl id)
  78   | SpliceD     (HsExpr id)     -- Top level splice
  79
  80 -- NB: all top-level fixity decls are contained EITHER
  81 -- EITHER FixDs
  82 -- OR     in the ClassDecls in TyClDs
  83 --
  84 -- The former covers
  85 --      a) data constructors
  86 --      b) class methods (but they can be also done in the
  87 --              signatures of class decls)
  88 --      c) imported functions (that have an IfacSig)
  89 --      d) top level decls
  90 --
  91 -- The latter is for class methods only
  92 \end{code}
  93
  94 \begin{code}
  95 #ifdef DEBUG
  96 hsDeclName :: (NamedThing name, OutputableBndr name)
  97            => HsDecl name -> name
  98 #endif
  99 hsDeclName (TyClD decl)                  = tyClDeclName     decl
 100 hsDeclName (InstD decl)                  = instDeclName     decl
 101 hsDeclName (ForD  decl)                  = foreignDeclName decl
 102 hsDeclName (FixD  (FixitySig name _ _))  = name
 103 hsDeclName (CoreD (CoreDecl name _ _ _)) = name
 104 -- Others don't make sense
 105 #ifdef DEBUG
 106 hsDeclName x                            = pprPanic "HsDecls.hsDeclName" (ppr x)
 107 #endif
 108
 109
 110 instDeclName :: InstDecl name -> name
 111 instDeclName (InstDecl _ _ _ (Just name) _) = name
 112
 113 \end{code}
 114
 115 \begin{code}
 116 instance OutputableBndr name => Outputable (HsDecl name) where
 117
 118     ppr (TyClD dcl)  = ppr dcl
 119     ppr (ValD binds) = ppr binds
 120     ppr (DefD def)   = ppr def
 121     ppr (InstD inst) = ppr inst
 122     ppr (ForD fd)    = ppr fd
 123     ppr (FixD fd)    = ppr fd
 124     ppr (RuleD rd)   = ppr rd
 125     ppr (DeprecD dd) = ppr dd
 126     ppr (CoreD dd)   = ppr dd
 127     ppr (SpliceD e)  = ptext SLIT("splice") <> parens (pprExpr e)
 128 \end{code}
 129
 130
 131 %************************************************************************
 132 %*                                                                      *
 133 \subsection[TyDecl]{@data@, @newtype@ or @type@ (synonym) type declaration}
 134 %*                                                                      *
 135 %************************************************************************
 136
 137                 --------------------------------
 138                         THE NAMING STORY
 139                 --------------------------------
 140
 141 Here is the story about the implicit names that go with type, class, and instance
 142 decls.  It's a bit tricky, so pay attention!
 143
 144 "Implicit" (or "system") binders
 145 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 146   Each data type decl defines
 147         a worker name for each constructor
 148         to-T and from-T convertors
 149   Each class decl defines
 150         a tycon for the class
 151         a data constructor for that tycon
 152         the worker for that constructor
 153         a selector for each superclass
 154
 155 All have occurrence names that are derived uniquely from their parent declaration.
 156
 157 None of these get separate definitions in an interface file; they are
 158 fully defined by the data or class decl.  But they may *occur* in
 159 interface files, of course.  Any such occurrence must haul in the
 160 relevant type or class decl.
 161
 162 Plan of attack:
 163  - Ensure they "point to" the parent data/class decl
 164    when loading that decl from an interface file
 165    (See RnHiFiles.getSysBinders)
 166
 167  - When typechecking the decl, we build the implicit TyCons and Ids.
 168    When doing so we look them up in the name cache (RnEnv.lookupSysName),
 169    to ensure correct module and provenance is set
 170
 171 These are the two places that we have to conjure up the magic derived
 172 names.  (The actual magic is in OccName.mkWorkerOcc, etc.)
 173
 174 Default methods
 175 ~~~~~~~~~~~~~~~
 176  - Occurrence name is derived uniquely from the method name
 177    E.g. $dmmax
 178
 179  - If there is a default method name at all, it's recorded in
 180    the ClassOpSig (in HsBinds), in the DefMeth field.
 181    (DefMeth is defined in Class.lhs)
 182
 183 Source-code class decls and interface-code class decls are treated subtly
 184 differently, which has given me a great deal of confusion over the years.
 185 Here's the deal.  (We distinguish the two cases because source-code decls
 186 have (Just binds) in the tcdMeths field, whereas interface decls have Nothing.
 187
 188 In *source-code* class declarations:
 189  - When parsing, every ClassOpSig gets a DefMeth with a suitable RdrName
 190    This is done by RdrHsSyn.mkClassOpSigDM
 191
 192  - The renamer renames it to a Name
 193
 194  - During typechecking, we generate a binding for each $dm for
 195    which there's a programmer-supplied default method:
 196         class Foo a where
 197           op1 :: <type>
 198           op2 :: <type>
 199           op1 = ...
 200    We generate a binding for $dmop1 but not for $dmop2.
 201    The Class for Foo has a NoDefMeth for op2 and a DefMeth for op1.
 202    The Name for $dmop2 is simply discarded.
 203
 204 In *interface-file* class declarations:
 205   - When parsing, we see if there's an explicit programmer-supplied default method
 206     because there's an '=' sign to indicate it:
 207         class Foo a where
 208           op1 = :: <type>       -- NB the '='
 209           op2   :: <type>
 210     We use this info to generate a DefMeth with a suitable RdrName for op1,
 211     and a NoDefMeth for op2
 212   - The interface file has a separate definition for $dmop1, with unfolding etc.
 213   - The renamer renames it to a Name.
 214   - The renamer treats $dmop1 as a free variable of the declaration, so that
 215     the binding for $dmop1 will be sucked in.  (See RnHsSyn.tyClDeclFVs)
 216     This doesn't happen for source code class decls, because they *bind* the default method.
 217
 218 Dictionary functions
 219 ~~~~~~~~~~~~~~~~~~~~
 220 Each instance declaration gives rise to one dictionary function binding.
 221
 222 The type checker makes up new source-code instance declarations
 223 (e.g. from 'deriving' or generic default methods --- see
 224 TcInstDcls.tcInstDecls1).  So we can't generate the names for
 225 dictionary functions in advance (we don't know how many we need).
 226
 227 On the other hand for interface-file instance declarations, the decl
 228 specifies the name of the dictionary function, and it has a binding elsewhere
 229 in the interface file:
 230         instance {Eq Int} = dEqInt
 231         dEqInt :: {Eq Int} <pragma info>
 232
 233 So again we treat source code and interface file code slightly differently.
 234
 235 Source code:
 236   - Source code instance decls have a Nothing in the (Maybe name) field
 237     (see data InstDecl below)
 238
 239   - The typechecker makes up a Local name for the dict fun for any source-code
 240     instance decl, whether it comes from a source-code instance decl, or whether
 241     the instance decl is derived from some other construct (e.g. 'deriving').
 242
 243   - The occurrence name it chooses is derived from the instance decl (just for
 244     documentation really) --- e.g. dNumInt.  Two dict funs may share a common
 245     occurrence name, but will have different uniques.  E.g.
 246         instance Foo [Int]  where ...
 247         instance Foo [Bool] where ...
 248     These might both be dFooList
 249
 250   - The CoreTidy phase externalises the name, and ensures the occurrence name is
 251     unique (this isn't special to dict funs).  So we'd get dFooList and dFooList1.
 252
 253   - We can take this relaxed approach (changing the occurrence name later)
 254     because dict fun Ids are not captured in a TyCon or Class (unlike default
 255     methods, say).  Instead, they are kept separately in the InstEnv.  This
 256     makes it easy to adjust them after compiling a module.  (Once we've finished
 257     compiling that module, they don't change any more.)
 258
 259
 260 Interface file code:
 261   - The instance decl gives the dict fun name, so the InstDecl has a (Just name)
 262     in the (Maybe name) field.
 263
 264   - RnHsSyn.instDeclFVs treats the dict fun name as free in the decl, so that we
 265     suck in the dfun binding
 266
 267
 268 \begin{code}
 269 -- TyClDecls are precisely the kind of declarations that can
 270 -- appear in interface files; or (internally) in GHC's interface
 271 -- for a module.  That's why (despite the misnomer) IfaceSig and ForeignType
 272 -- are both in TyClDecl
 273
 274 data TyClDecl name
 275   = IfaceSig {  tcdName :: name,                -- It may seem odd to classify an interface-file signature
 276                 tcdType :: HsType name,         -- as a 'TyClDecl', but it's very convenient.
 277                 tcdIdInfo :: [HsIdInfo name],
 278                 tcdLoc :: SrcLoc
 279     }
 280
 281   | ForeignType { tcdName    :: name,           -- See remarks about IfaceSig above
 282                   tcdExtName :: Maybe FastString,
 283                   tcdFoType  :: FoType,
 284                   tcdLoc     :: SrcLoc }
 285
 286   | TyData {    tcdND     :: NewOrData,
 287                 tcdCtxt   :: HsContext name,     -- Context
 288                 tcdName   :: name,               -- Type constructor
 289                 tcdTyVars :: [HsTyVarBndr name], -- Type variables
 290                 tcdCons   :: DataConDetails (ConDecl name),      -- Data constructors
 291                 tcdDerivs :: Maybe (HsContext name),    -- Derivings; Nothing => not specified
 292                                                         -- Just [] => derive exactly what is asked
 293                 tcdGeneric :: Maybe Bool,       -- Nothing <=> source decl
 294                                                 -- Just x  <=> interface-file decl;
 295                                                 --      x=True <=> generic converter functions available
 296                                                 -- We need this for imported data decls, since the
 297                                                 -- imported modules may have been compiled with
 298                                                 -- different flags to the current compilation unit
 299                 tcdLoc     :: SrcLoc
 300     }
 301
 302   | TySynonym { tcdName :: name,                        -- type constructor
 303                 tcdTyVars :: [HsTyVarBndr name],        -- type variables
 304                 tcdSynRhs :: HsType name,               -- synonym expansion
 305                 tcdLoc    :: SrcLoc
 306     }
 307
 308   | ClassDecl { tcdCtxt    :: HsContext name,           -- Context...
 309                 tcdName    :: name,                     -- Name of the class
 310                 tcdTyVars  :: [HsTyVarBndr name],       -- The class type variables
 311                 tcdFDs     :: [FunDep name],            -- Functional dependencies
 312                 tcdSigs    :: [Sig name],               -- Methods' signatures
 313                 tcdMeths   :: Maybe (MonoBinds name),   -- Default methods
 314                                                         --      Nothing for imported class decls
 315                                                         --      Just bs for source   class decls
 316                 tcdLoc      :: SrcLoc
 317     }
 318 \end{code}
 319
 320 Simple classifiers
 321
 322 \begin{code}
 323 isIfaceSigDecl, isDataDecl, isSynDecl, isClassDecl :: TyClDecl name -> Bool
 324
 325 isIfaceSigDecl (IfaceSig {}) = True
 326 isIfaceSigDecl other         = False
 327
 328 isSynDecl (TySynonym {}) = True
 329 isSynDecl other          = False
 330
 331 isDataDecl (TyData {}) = True
 332 isDataDecl other       = False
 333
 334 isClassDecl (ClassDecl {}) = True
 335 isClassDecl other          = False
 336
 337 isTypeOrClassDecl (ClassDecl   {}) = True
 338 isTypeOrClassDecl (TyData      {}) = True
 339 isTypeOrClassDecl (TySynonym   {}) = True
 340 isTypeOrClassDecl (ForeignType {}) = True
 341 isTypeOrClassDecl other            = False
 342 \end{code}
 343
 344 Dealing with names
 345
 346 \begin{code}
 347 --------------------------------
 348 tyClDeclName :: TyClDecl name -> name
 349 tyClDeclName tycl_decl = tcdName tycl_decl
 350
 351 --------------------------------
 352 tyClDeclNames :: Eq name => TyClDecl name -> [(name, SrcLoc)]
 353 -- Returns all the *binding* names of the decl, along with their SrcLocs
 354 -- The first one is guaranteed to be the name of the decl
 355 -- For record fields, the first one counts as the SrcLoc
 356 -- We use the equality to filter out duplicate field names
 357
 358 tyClDeclNames (TySynonym   {tcdName = name, tcdLoc = loc})  = [(name,loc)]
 359 tyClDeclNames (IfaceSig    {tcdName = name, tcdLoc = loc})  = [(name,loc)]
 360 tyClDeclNames (ForeignType {tcdName = name, tcdLoc = loc})  = [(name,loc)]
 361
 362 tyClDeclNames (ClassDecl {tcdName = cls_name, tcdSigs = sigs, tcdLoc = loc})
 363   = (cls_name,loc) : [(n,loc) | ClassOpSig n _ _ loc <- sigs]
 364
 365 tyClDeclNames (TyData {tcdName = tc_name, tcdCons = cons, tcdLoc = loc})
 366   = (tc_name,loc) : conDeclsNames cons
 367
 368
 369 tyClDeclTyVars (TySynonym {tcdTyVars = tvs}) = tvs
 370 tyClDeclTyVars (TyData    {tcdTyVars = tvs}) = tvs
 371 tyClDeclTyVars (ClassDecl {tcdTyVars = tvs}) = tvs
 372 tyClDeclTyVars (ForeignType {})              = []
 373 tyClDeclTyVars (IfaceSig {})                 = []
 374 \end{code}
 375
 376 \begin{code}
 377 instance (NamedThing name, Ord name) => Eq (TyClDecl name) where
 378         -- Used only when building interface files
 379   (==) d1@(IfaceSig {}) d2@(IfaceSig {})
 380       = tcdName d1 == tcdName d2 &&
 381         tcdType d1 == tcdType d2 &&
 382         tcdIdInfo d1 == tcdIdInfo d2
 383
 384   (==) d1@(ForeignType {}) d2@(ForeignType {})
 385       = tcdName d1 == tcdName d2 &&
 386         tcdFoType d1 == tcdFoType d2
 387
 388   (==) d1@(TyData {}) d2@(TyData {})
 389       = tcdName d1 == tcdName d2 &&
 390         tcdND d1   == tcdND   d2 &&
 391         eqWithHsTyVars (tcdTyVars d1) (tcdTyVars d2) (\ env ->
 392           eq_hsContext env (tcdCtxt d1) (tcdCtxt d2)  &&
 393           eq_hsCD      env (tcdCons d1) (tcdCons d2)
 394         )
 395
 396   (==) d1@(TySynonym {}) d2@(TySynonym {})
 397       = tcdName d1 == tcdName d2 &&
 398         eqWithHsTyVars (tcdTyVars d1) (tcdTyVars d2) (\ env ->
 399           eq_hsType env (tcdSynRhs d1) (tcdSynRhs d2)
 400         )
 401
 402   (==) d1@(ClassDecl {}) d2@(ClassDecl {})
 403     = tcdName d1 == tcdName d2 &&
 404       eqWithHsTyVars (tcdTyVars d1) (tcdTyVars d2) (\ env ->
 405           eq_hsContext env (tcdCtxt d1) (tcdCtxt d2)  &&
 406           eqListBy (eq_hsFD env) (tcdFDs d1) (tcdFDs d2) &&
 407           eqListBy (eq_cls_sig env) (tcdSigs d1) (tcdSigs d2)
 408        )
 409
 410   (==) _ _ = False      -- default case
 411
 412 eq_hsCD env (DataCons c1) (DataCons c2) = eqListBy (eq_ConDecl env) c1 c2
 413 eq_hsCD env Unknown       Unknown       = True
 414 eq_hsCD env (HasCons n1)  (HasCons n2)  = n1 == n2
 415 eq_hsCD env d1            d2            = False
 416
 417 eq_hsFD env (ns1,ms1) (ns2,ms2)
 418   = eqListBy (eq_hsVar env) ns1 ns2 && eqListBy (eq_hsVar env) ms1 ms2
 419
 420 eq_cls_sig env (ClassOpSig n1 dm1 ty1 _) (ClassOpSig n2 dm2 ty2 _)
 421   = n1==n2 && dm1 `eq_dm` dm2 && eq_hsType env ty1 ty2
 422   where
 423         -- Ignore the name of the default method for (DefMeth id)
 424         -- This is used for comparing declarations before putting
 425         -- them into interface files, and the name of the default
 426         -- method isn't relevant
 427     NoDefMeth  `eq_dm` NoDefMeth  = True
 428     GenDefMeth `eq_dm` GenDefMeth = True
 429     DefMeth _  `eq_dm` DefMeth _  = True
 430     dm1        `eq_dm` dm2        = False
 431 \end{code}
 432
 433 \begin{code}
 434 countTyClDecls :: [TyClDecl name] -> (Int, Int, Int, Int, Int)
 435         -- class, data, newtype, synonym decls
 436 countTyClDecls decls
 437  = (count isClassDecl     decls,
 438     count isSynDecl       decls,
 439     count isIfaceSigDecl  decls,
 440     count isDataTy        decls,
 441     count isNewTy         decls)
 442  where
 443    isDataTy TyData{tcdND=DataType} = True
 444    isDataTy _                      = False
 445
 446    isNewTy TyData{tcdND=NewType} = True
 447    isNewTy _                     = False
 448 \end{code}
 449
 450 \begin{code}
 451 instance OutputableBndr name
 452               => Outputable (TyClDecl name) where
 453
 454     ppr (IfaceSig {tcdName = var, tcdType = ty, tcdIdInfo = info})
 455         = getPprStyle $ \ sty ->
 456            hsep [ pprHsVar var, dcolon, ppr ty, pprHsIdInfo info ]
 457
 458     ppr (ForeignType {tcdName = tycon})
 459         = hsep [ptext SLIT("foreign import type dotnet"), ppr tycon]
 460
 461     ppr (TySynonym {tcdName = tycon, tcdTyVars = tyvars, tcdSynRhs = mono_ty})
 462       = hang (ptext SLIT("type") <+> pp_decl_head [] tycon tyvars <+> equals)
 463              4 (ppr mono_ty)
 464
 465     ppr (TyData {tcdND = new_or_data, tcdCtxt = context, tcdName = tycon,
 466                  tcdTyVars = tyvars, tcdCons = condecls,
 467                  tcdDerivs = derivings})
 468       = pp_tydecl (ptext keyword <+> pp_decl_head context tycon tyvars)
 469                   (pp_condecls condecls)
 470                   derivings
 471       where
 472         keyword = case new_or_data of
 473                         NewType  -> SLIT("newtype")
 474                         DataType -> SLIT("data")
 475
 476     ppr (ClassDecl {tcdCtxt = context, tcdName = clas, tcdTyVars = tyvars, tcdFDs = fds,
 477                     tcdSigs = sigs, tcdMeths = methods})
 478       | null sigs       -- No "where" part
 479       = top_matter
 480
 481       | otherwise       -- Laid out
 482       = sep [hsep [top_matter, ptext SLIT("where {")],
 483              nest 4 (sep [sep (map ppr_sig sigs), pp_methods, char '}'])]
 484       where
 485         top_matter  = ptext SLIT("class") <+> pp_decl_head context clas tyvars <+> pprFundeps fds
 486         ppr_sig sig = ppr sig <> semi
 487
 488         pp_methods = if isNothing methods
 489                         then empty
 490                         else ppr (fromJust methods)
 491
 492 pp_decl_head :: OutputableBndr name => HsContext name -> name -> [HsTyVarBndr name] -> SDoc
 493 pp_decl_head context thing tyvars = hsep [pprHsContext context, ppr thing, interppSP tyvars]
 494
 495 pp_condecls Unknown       = ptext SLIT("{- abstract -}")
 496 pp_condecls (HasCons n)   = ptext SLIT("{- abstract with") <+> int n <+> ptext SLIT("constructors -}")
 497 pp_condecls (DataCons cs) = equals <+> sep (punctuate (ptext SLIT(" |")) (map ppr cs))
 498
 499 pp_tydecl pp_head pp_decl_rhs derivings
 500   = hang pp_head 4 (sep [
 501         pp_decl_rhs,
 502         case derivings of
 503           Nothing          -> empty
 504           Just ds          -> hsep [ptext SLIT("deriving"), ppr_hs_context ds]
 505     ])
 506 \end{code}
 507
 508
 509 %************************************************************************
 510 %*                                                                      *
 511 \subsection[ConDecl]{A data-constructor declaration}
 512 %*                                                                      *
 513 %************************************************************************
 514
 515 \begin{code}
 516 data ConDecl name
 517   = ConDecl     name                    -- Constructor name; this is used for the
 518                                         -- DataCon itself, and for the user-callable wrapper Id
 519
 520                 [HsTyVarBndr name]      -- Existentially quantified type variables
 521                 (HsContext name)        -- ...and context
 522                                         -- If both are empty then there are no existentials
 523
 524                 (HsConDetails name (BangType name))
 525                 SrcLoc
 526 \end{code}
 527
 528 \begin{code}
 529 conDeclsNames :: Eq name => DataConDetails (ConDecl name) -> [(name,SrcLoc)]
 530   -- See tyClDeclNames for what this does
 531   -- The function is boringly complicated because of the records
 532   -- And since we only have equality, we have to be a little careful
 533 conDeclsNames cons
 534   = snd (foldl do_one ([], []) (visibleDataCons cons))
 535   where
 536     do_one (flds_seen, acc) (ConDecl name _ _ (RecCon flds) loc)
 537         = (new_flds ++ flds_seen, (name,loc) : [(f,loc) | f <- new_flds] ++ acc)
 538         where
 539           new_flds = [ f | (f,_) <- flds, not (f `elem` flds_seen) ]
 540
 541     do_one (flds_seen, acc) (ConDecl name _ _ _ loc)
 542         = (flds_seen, (name,loc):acc)
 543 \end{code}
 544
 545 \begin{code}
 546 conDetailsTys details = map getBangType (hsConArgs details)
 547
 548 eq_ConDecl env (ConDecl n1 tvs1 cxt1 cds1 _)
 549                (ConDecl n2 tvs2 cxt2 cds2 _)
 550   = n1 == n2 &&
 551     (eq_hsTyVars env tvs1 tvs2  $ \ env ->
 552      eq_hsContext env cxt1 cxt2 &&
 553      eq_ConDetails env cds1 cds2)
 554
 555 eq_ConDetails env (PrefixCon bts1) (PrefixCon bts2)
 556   = eqListBy (eq_btype env) bts1 bts2
 557 eq_ConDetails env (InfixCon bta1 btb1) (InfixCon bta2 btb2)
 558   = eq_btype env bta1 bta2 && eq_btype env btb1 btb2
 559 eq_ConDetails env (RecCon fs1) (RecCon fs2)
 560   = eqListBy (eq_fld env) fs1 fs2
 561 eq_ConDetails env _ _ = False
 562
 563 eq_fld env (ns1,bt1) (ns2, bt2) = ns1==ns2 && eq_btype env bt1 bt2
 564 \end{code}
 565
 566 \begin{code}
 567 data BangType name = BangType StrictnessMark (HsType name)
 568
 569 getBangType       (BangType _ ty) = ty
 570 getBangStrictness (BangType s _)  = s
 571
 572 unbangedType ty = BangType NotMarkedStrict ty
 573
 574 eq_btype env (BangType s1 t1) (BangType s2 t2) = s1==s2 && eq_hsType env t1 t2
 575 \end{code}
 576
 577 \begin{code}
 578 instance (OutputableBndr name) => Outputable (ConDecl name) where
 579     ppr (ConDecl con tvs cxt con_details loc)
 580       = sep [pprHsForAll tvs cxt, ppr_con_details con con_details]
 581
 582 ppr_con_details con (InfixCon ty1 ty2)
 583   = hsep [ppr_bang ty1, ppr con, ppr_bang ty2]
 584
 585 -- ConDecls generated by MkIface.ifaceTyThing always have a PrefixCon, even
 586 -- if the constructor is an infix one.  This is because in an interface file
 587 -- we don't distinguish between the two.  Hence when printing these for the
 588 -- user, we need to parenthesise infix constructor names.
 589 ppr_con_details con (PrefixCon tys)
 590   = hsep (pprHsVar con : map ppr_bang tys)
 591
 592 ppr_con_details con (RecCon fields)
 593   = ppr con <+> braces (sep (punctuate comma (map ppr_field fields)))
 594   where
 595     ppr_field (n, ty) = ppr n <+> dcolon <+> ppr_bang ty
 596
 597 instance OutputableBndr name => Outputable (BangType name) where
 598     ppr = ppr_bang
 599
 600 ppr_bang (BangType s ty) = ppr s <> pprParendHsType ty
 601 \end{code}
 602
 603
 604 %************************************************************************
 605 %*                                                                      *
 606 \subsection[InstDecl]{An instance declaration
 607 %*                                                                      *
 608 %************************************************************************
 609
 610 \begin{code}
 611 data InstDecl name
 612   = InstDecl    (HsType name)   -- Context => Class Instance-type
 613                                 -- Using a polytype means that the renamer conveniently
 614                                 -- figures out the quantified type variables for us.
 615
 616                 (MonoBinds name)
 617
 618                 [Sig name]              -- User-supplied pragmatic info
 619
 620                 (Maybe name)            -- Name for the dictionary function
 621                                         -- Nothing for source-file instance decls
 622
 623                 SrcLoc
 624
 625 isSourceInstDecl :: InstDecl name -> Bool
 626 isSourceInstDecl (InstDecl _ _ _ maybe_dfun _) = isNothing maybe_dfun
 627 \end{code}
 628
 629 \begin{code}
 630 instance (OutputableBndr name) => Outputable (InstDecl name) where
 631
 632     ppr (InstDecl inst_ty binds uprags maybe_dfun_name src_loc)
 633       = vcat [hsep [ptext SLIT("instance"), ppr inst_ty, ptext SLIT("where")],
 634               nest 4 (ppr uprags),
 635               nest 4 (ppr binds) ]
 636       where
 637         pp_dfun = case maybe_dfun_name of
 638                     Just df -> ppr df
 639                     Nothing -> empty
 640 \end{code}
 641
 642 \begin{code}
 643 instance Ord name => Eq (InstDecl name) where
 644         -- Used for interface comparison only, so don't compare bindings
 645   (==) (InstDecl inst_ty1 _ _ dfun1 _) (InstDecl inst_ty2 _ _ dfun2 _)
 646        = inst_ty1 == inst_ty2 && dfun1 == dfun2
 647 \end{code}
 648
 649
 650 %************************************************************************
 651 %*                                                                      *
 652 \subsection[DefaultDecl]{A @default@ declaration}
 653 %*                                                                      *
 654 %************************************************************************
 655
 656 There can only be one default declaration per module, but it is hard
 657 for the parser to check that; we pass them all through in the abstract
 658 syntax, and that restriction must be checked in the front end.
 659
 660 \begin{code}
 661 data DefaultDecl name
 662   = DefaultDecl [HsType name]
 663                 SrcLoc
 664
 665 instance (OutputableBndr name)
 666               => Outputable (DefaultDecl name) where
 667
 668     ppr (DefaultDecl tys src_loc)
 669       = ptext SLIT("default") <+> parens (interpp'SP tys)
 670 \end{code}
 671
 672 %************************************************************************
 673 %*                                                                      *
 674 \subsection{Foreign function interface declaration}
 675 %*                                                                      *
 676 %************************************************************************
 677
 678 \begin{code}
 679
 680 -- foreign declarations are distinguished as to whether they define or use a
 681 -- Haskell name
 682 --
 683 -- * the Boolean value indicates whether the pre-standard deprecated syntax
 684 --   has been used
 685 --
 686 data ForeignDecl name
 687   = ForeignImport name (HsType name) ForeignImport Bool SrcLoc  -- defines name
 688   | ForeignExport name (HsType name) ForeignExport Bool SrcLoc  -- uses name
 689
 690 -- yield the Haskell name defined or used in a foreign declaration
 691 --
 692 foreignDeclName                           :: ForeignDecl name -> name
 693 foreignDeclName (ForeignImport n _ _ _ _)  = n
 694 foreignDeclName (ForeignExport n _ _ _ _)  = n
 695
 696 -- specification of an imported external entity in dependence on the calling
 697 -- convention
 698 --
 699 data ForeignImport = -- import of a C entity
 700                      --
 701                      -- * the two strings specifying a header file or library
 702                      --   may be empty, which indicates the absence of a
 703                      --   header or object specification (both are not used
 704                      --   in the case of `CWrapper' and when `CFunction'
 705                      --   has a dynamic target)
 706                      --
 707                      -- * the calling convention is irrelevant for code
 708                      --   generation in the case of `CLabel', but is needed
 709                      --   for pretty printing
 710                      --
 711                      -- * `Safety' is irrelevant for `CLabel' and `CWrapper'
 712                      --
 713                      CImport  CCallConv       -- ccall or stdcall
 714                               Safety          -- safe or unsafe
 715                               FastString      -- name of C header
 716                               FastString      -- name of library object
 717                               CImportSpec     -- details of the C entity
 718
 719                      -- import of a .NET function
 720                      --
 721                    | DNImport DNCallSpec
 722
 723 -- details of an external C entity
 724 --
 725 data CImportSpec = CLabel    CLabelString     -- import address of a C label
 726                  | CFunction CCallTarget      -- static or dynamic function
 727                  | CWrapper                   -- wrapper to expose closures
 728                                               -- (former f.e.d.)
 729
 730 -- specification of an externally exported entity in dependence on the calling
 731 -- convention
 732 --
 733 data ForeignExport = CExport  CExportSpec    -- contains the calling convention
 734                    | DNExport                -- presently unused
 735
 736 -- abstract type imported from .NET
 737 --
 738 data FoType = DNType            -- In due course we'll add subtype stuff
 739             deriving (Eq)       -- Used for equality instance for TyClDecl
 740
 741
 742 -- pretty printing of foreign declarations
 743 --
 744
 745 instance OutputableBndr name => Outputable (ForeignDecl name) where
 746   ppr (ForeignImport n ty fimport _ _) =
 747     ptext SLIT("foreign import") <+> ppr fimport <+>
 748     ppr n <+> dcolon <+> ppr ty
 749   ppr (ForeignExport n ty fexport _ _) =
 750     ptext SLIT("foreign export") <+> ppr fexport <+>
 751     ppr n <+> dcolon <+> ppr ty
 752
 753 instance Outputable ForeignImport where
 754   ppr (DNImport                         spec) =
 755     ptext SLIT("dotnet") <+> ppr spec
 756   ppr (CImport  cconv safety header lib spec) =
 757     ppr cconv <+> ppr safety <+>
 758     char '"' <> pprCEntity header lib spec <> char '"'
 759     where
 760       pprCEntity header lib (CLabel lbl) =
 761         ptext SLIT("static") <+> ftext header <+> char '&' <>
 762         pprLib lib <> ppr lbl
 763       pprCEntity header lib (CFunction (StaticTarget lbl)) =
 764         ptext SLIT("static") <+> ftext header <+> char '&' <>
 765         pprLib lib <> ppr lbl
 766       pprCEntity header lib (CFunction (DynamicTarget)) =
 767         ptext SLIT("dynamic")
 768       pprCEntity header lib (CFunction (CasmTarget _)) =
 769         panic "HsDecls.pprCEntity: malformed C function target"
 770       pprCEntity _      _   (CWrapper) = ptext SLIT("wrapper")
 771       --
 772       pprLib lib | nullFastString lib = empty
 773                  | otherwise          = char '[' <> ppr lib <> char ']'
 774
 775 instance Outputable ForeignExport where
 776   ppr (CExport  (CExportStatic lbl cconv)) =
 777     ppr cconv <+> char '"' <> ppr lbl <> char '"'
 778   ppr (DNExport                          ) =
 779     ptext SLIT("dotnet") <+> ptext SLIT("\"<unused>\"")
 780
 781 instance Outputable FoType where
 782   ppr DNType = ptext SLIT("type dotnet")
 783 \end{code}
 784
 785
 786 %************************************************************************
 787 %*                                                                      *
 788 \subsection{Transformation rules}
 789 %*                                                                      *
 790 %************************************************************************
 791
 792 \begin{code}
 793 data RuleDecl name
 794   = HsRule                      -- Source rule
 795         RuleName                -- Rule name
 796         Activation
 797         [RuleBndr name]         -- Forall'd vars; after typechecking this includes tyvars
 798         (HsExpr name)   -- LHS
 799         (HsExpr name)   -- RHS
 800         SrcLoc
 801
 802   | IfaceRule                   -- One that's come in from an interface file; pre-typecheck
 803         RuleName
 804         Activation
 805         [UfBinder name]         -- Tyvars and term vars
 806         name                    -- Head of lhs
 807         [UfExpr name]           -- Args of LHS
 808         (UfExpr name)           -- Pre typecheck
 809         SrcLoc
 810
 811   | IfaceRuleOut                -- Post typecheck
 812         name                    -- Head of LHS
 813         CoreRule
 814
 815 isSrcRule (HsRule _ _ _ _ _ _) = True
 816 isSrcRule other                = False
 817
 818 ifaceRuleDeclName :: RuleDecl name -> name
 819 ifaceRuleDeclName (IfaceRule _ _ _ n _ _ _) = n
 820 ifaceRuleDeclName (IfaceRuleOut n r)        = n
 821 ifaceRuleDeclName (HsRule fs _ _ _ _ _)     = pprPanic "ifaceRuleDeclName" (ppr fs)
 822
 823 data RuleBndr name
 824   = RuleBndr name
 825   | RuleBndrSig name (HsType name)
 826
 827 collectRuleBndrSigTys :: [RuleBndr name] -> [HsType name]
 828 collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ ty <- bndrs]
 829
 830 instance (NamedThing name, Ord name) => Eq (RuleDecl name) where
 831   -- Works for IfaceRules only; used when comparing interface file versions
 832   (IfaceRule n1 a1 bs1 f1 es1 rhs1 _) == (IfaceRule n2 a2 bs2 f2 es2 rhs2 _)
 833      = n1==n2 && f1 == f2 && a1==a2 &&
 834        eq_ufBinders emptyEqHsEnv bs1 bs2 (\env ->
 835        eqListBy (eq_ufExpr env) (rhs1:es1) (rhs2:es2))
 836
 837 instance OutputableBndr name => Outputable (RuleDecl name) where
 838   ppr (HsRule name act ns lhs rhs loc)
 839         = sep [text "{-# RULES" <+> doubleQuotes (ftext name) <+> ppr act,
 840                pp_forall, pprExpr lhs, equals <+> pprExpr rhs,
 841                text "#-}" ]
 842         where
 843           pp_forall | null ns   = empty
 844                     | otherwise = text "forall" <+> fsep (map ppr ns) <> dot
 845
 846   ppr (IfaceRule name act tpl_vars fn tpl_args rhs loc)
 847     = hsep [ doubleQuotes (ftext name), ppr act,
 848            ptext SLIT("__forall") <+> braces (interppSP tpl_vars),
 849            ppr fn <+> sep (map (pprUfExpr parens) tpl_args),
 850            ptext SLIT("=") <+> ppr rhs
 851       ] <+> semi
 852
 853   ppr (IfaceRuleOut fn rule) = pprCoreRule (ppr fn) rule
 854
 855 instance OutputableBndr name => Outputable (RuleBndr name) where
 856    ppr (RuleBndr name) = ppr name
 857    ppr (RuleBndrSig name ty) = ppr name <> dcolon <> ppr ty
 858 \end{code}
 859
 860
 861 %************************************************************************
 862 %*                                                                      *
 863 \subsection[DeprecDecl]{Deprecations}
 864 %*                                                                      *
 865 %************************************************************************
 866
 867 We use exported entities for things to deprecate.
 868
 869 \begin{code}
 870 data DeprecDecl name = Deprecation name DeprecTxt SrcLoc
 871
 872 type DeprecTxt = FastString     -- reason/explanation for deprecation
 873
 874 instance OutputableBndr name => Outputable (DeprecDecl name) where
 875     ppr (Deprecation thing txt _)
 876       = hsep [text "{-# DEPRECATED", ppr thing, doubleQuotes (ppr txt), text "#-}"]
 877 \end{code}
 878
 879
 880 %************************************************************************
 881 %*                                                                      *
 882                 External-core declarations
 883 %*                                                                      *
 884 %************************************************************************
 885
 886 \begin{code}
 887 data CoreDecl name      -- a Core value binding (from 'external Core' input)
 888   = CoreDecl    name
 889                 (HsType name)
 890                 (UfExpr name)
 891                 SrcLoc
 892
 893 instance OutputableBndr name => Outputable (CoreDecl name) where
 894     ppr (CoreDecl var ty rhs loc)
 895         = getPprStyle $ \ sty ->
 896           hsep [ pprHsVar var, dcolon, ppr ty, ppr rhs ]
 897 \end{code}