ghc/compiler/rename/RnSource.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section[RnSource]{Main pass of renamer}
   5
   6 \begin{code}
   7 module RnSource ( rnDecl, rnSourceDecls, rnHsType, rnHsSigType ) where
   8
   9 #include "HsVersions.h"
  10
  11 import RnExpr
  12 import HsSyn
  13 import HsPragmas
  14 import HsTypes          ( getTyVarName )
  15 import RdrName          ( RdrName, isRdrDataCon, rdrNameOcc, isRdrTyVar, mkRdrNameWkr )
  16 import RdrHsSyn         ( RdrNameContext, RdrNameHsType, RdrNameConDecl,
  17                           extractRuleBndrsTyVars, extractHsTyRdrTyVars, extractHsTysRdrTyVars
  18                         )
  19 import RnHsSyn
  20 import HsCore
  21
  22 import RnBinds          ( rnTopBinds, rnMethodBinds, renameSigs, unknownSigErr )
  23 import RnEnv            ( bindTyVarsRn, lookupBndrRn, lookupOccRn, getIPName,
  24                           lookupImplicitOccRn, lookupImplicitOccsRn,
  25                           bindLocalsRn, bindLocalRn, bindLocalsFVRn, bindUVarRn,
  26                           bindTyVarsFVRn, bindTyVarsFV2Rn, extendTyVarEnvFVRn,
  27                           bindCoreLocalFVRn, bindCoreLocalsFVRn,
  28                           checkDupOrQualNames, checkDupNames,
  29                           mkImportedGlobalName, mkImportedGlobalFromRdrName,
  30                           newDFunName, getDFunKey, newImplicitBinder,
  31                           FreeVars, emptyFVs, plusFV, plusFVs, unitFV, addOneFV, mapFvRn
  32                         )
  33 import RnMonad
  34
  35 import FunDeps          ( oclose )
  36 import Class            ( FunDep )
  37
  38 import Name             ( Name, OccName,
  39                           ExportFlag(..), Provenance(..),
  40                           nameOccName, NamedThing(..)
  41                         )
  42 import NameSet
  43 import OccName          ( mkDefaultMethodOcc )
  44 import BasicTypes       ( TopLevelFlag(..) )
  45 import FiniteMap        ( elemFM )
  46 import PrelInfo         ( derivableClassKeys, cCallishClassKeys,
  47                           deRefStablePtr_RDR, makeStablePtr_RDR, bindIO_RDR
  48                         )
  49 import Bag              ( bagToList )
  50 import List             ( partition, nub )
  51 import Outputable
  52 import SrcLoc           ( SrcLoc )
  53 import CmdLineOpts      ( opt_GlasgowExts, opt_WarnUnusedMatches )      -- Warn of unused for-all'd tyvars
  54 import Unique           ( Uniquable(..) )
  55 import UniqFM           ( lookupUFM )
  56 import ErrUtils         ( Message )
  57 import CStrings         ( isCLabelString )
  58 import Maybes           ( maybeToBool, catMaybes )
  59 import Util
  60 \end{code}
  61
  62 @rnDecl@ `renames' declarations.
  63 It simultaneously performs dependency analysis and precedence parsing.
  64 It also does the following error checks:
  65 \begin{enumerate}
  66 \item
  67 Checks that tyvars are used properly. This includes checking
  68 for undefined tyvars, and tyvars in contexts that are ambiguous.
  69 (Some of this checking has now been moved to module @TcMonoType@,
  70 since we don't have functional dependency information at this point.)
  71 \item
  72 Checks that all variable occurences are defined.
  73 \item
  74 Checks the @(..)@ etc constraints in the export list.
  75 \end{enumerate}
  76
  77
  78 %*********************************************************
  79 %*                                                      *
  80 \subsection{Value declarations}
  81 %*                                                      *
  82 %*********************************************************
  83
  84 \begin{code}
  85 rnSourceDecls :: [RdrNameHsDecl] -> RnMS ([RenamedHsDecl], FreeVars)
  86         -- The decls get reversed, but that's ok
  87
  88 rnSourceDecls decls
  89   = go emptyFVs [] decls
  90   where
  91         -- Fixity and deprecations have been dealt with already; ignore them
  92     go fvs ds' []             = returnRn (ds', fvs)
  93     go fvs ds' (FixD _:ds)    = go fvs ds' ds
  94     go fvs ds' (DeprecD _:ds) = go fvs ds' ds
  95     go fvs ds' (d:ds)         = rnDecl d        `thenRn` \(d', fvs') ->
  96                                 go (fvs `plusFV` fvs') (d':ds') ds
  97 \end{code}
  98
  99
 100 %*********************************************************
 101 %*                                                      *
 102 \subsection{Value declarations}
 103 %*                                                      *
 104 %*********************************************************
 105
 106 \begin{code}
 107 -- rnDecl does all the work
 108 rnDecl :: RdrNameHsDecl -> RnMS (RenamedHsDecl, FreeVars)
 109
 110 rnDecl (ValD binds) = rnTopBinds binds  `thenRn` \ (new_binds, fvs) ->
 111                       returnRn (ValD new_binds, fvs)
 112
 113
 114 rnDecl (SigD (IfaceSig name ty id_infos loc))
 115   = pushSrcLocRn loc $
 116     mkImportedGlobalFromRdrName name    `thenRn` \ name' ->
 117     rnHsType doc_str ty                 `thenRn` \ (ty',fvs1) ->
 118     mapFvRn rnIdInfo id_infos           `thenRn` \ (id_infos', fvs2) ->
 119     returnRn (SigD (IfaceSig name' ty' id_infos' loc), fvs1 `plusFV` fvs2)
 120   where
 121     doc_str = text "the interface signature for" <+> quotes (ppr name)
 122 \end{code}
 123
 124 %*********************************************************
 125 %*                                                      *
 126 \subsection{Type declarations}
 127 %*                                                      *
 128 %*********************************************************
 129
 130 @rnTyDecl@ uses the `global name function' to create a new type
 131 declaration in which local names have been replaced by their original
 132 names, reporting any unknown names.
 133
 134 Renaming type variables is a pain. Because they now contain uniques,
 135 it is necessary to pass in an association list which maps a parsed
 136 tyvar to its @Name@ representation.
 137 In some cases (type signatures of values),
 138 it is even necessary to go over the type first
 139 in order to get the set of tyvars used by it, make an assoc list,
 140 and then go over it again to rename the tyvars!
 141 However, we can also do some scoping checks at the same time.
 142
 143 \begin{code}
 144 rnDecl (TyClD (TyData new_or_data context tycon tyvars condecls nconstrs derivings pragmas src_loc))
 145   = pushSrcLocRn src_loc $
 146     lookupBndrRn tycon                          `thenRn` \ tycon' ->
 147     bindTyVarsFVRn data_doc tyvars              $ \ tyvars' ->
 148     rnContext data_doc context                  `thenRn` \ (context', cxt_fvs) ->
 149     checkDupOrQualNames data_doc con_names      `thenRn_`
 150     mapFvRn rnConDecl condecls                  `thenRn` \ (condecls', con_fvs) ->
 151     rnDerivs derivings                          `thenRn` \ (derivings', deriv_fvs) ->
 152     ASSERT(isNoDataPragmas pragmas)
 153     returnRn (TyClD (TyData new_or_data context' tycon' tyvars' condecls' nconstrs
 154                      derivings' noDataPragmas src_loc),
 155               cxt_fvs `plusFV` con_fvs `plusFV` deriv_fvs)
 156   where
 157     data_doc = text "the data type declaration for" <+> quotes (ppr tycon)
 158     con_names = map conDeclName condecls
 159
 160 rnDecl (TyClD (TySynonym name tyvars ty src_loc))
 161   = pushSrcLocRn src_loc $
 162     lookupBndrRn name                           `thenRn` \ name' ->
 163     bindTyVarsFVRn syn_doc tyvars               $ \ tyvars' ->
 164     rnHsType syn_doc (unquantify ty)            `thenRn` \ (ty', ty_fvs) ->
 165     returnRn (TyClD (TySynonym name' tyvars' ty' src_loc), ty_fvs)
 166   where
 167     syn_doc = text "the declaration for type synonym" <+> quotes (ppr name)
 168
 169         -- For H98 we do *not* universally quantify on the RHS of a synonym
 170         -- Silently discard context... but the tyvars in the rest won't be in scope
 171     unquantify (HsForAllTy Nothing ctxt ty) | not opt_GlasgowExts = ty
 172     unquantify ty                                                 = ty
 173
 174 rnDecl (TyClD (ClassDecl context cname tyvars fds sigs mbinds pragmas
 175                tname dname dwname snames src_loc))
 176   = pushSrcLocRn src_loc $
 177
 178     lookupBndrRn cname                                  `thenRn` \ cname' ->
 179
 180         -- Deal with the implicit tycon and datacon name
 181         -- They aren't in scope (because they aren't visible to the user)
 182         -- and what we want to do is simply look them up in the cache;
 183         -- we jolly well ought to get a 'hit' there!
 184         -- So the 'Imported' part of this call is not relevant.
 185         -- Unclean; but since these two are the only place this happens
 186         -- I can't work up the energy to do it more beautifully
 187     mkImportedGlobalFromRdrName tname                   `thenRn` \ tname' ->
 188     mkImportedGlobalFromRdrName dname                   `thenRn` \ dname' ->
 189     mkImportedGlobalFromRdrName dwname                  `thenRn` \ dwname' ->
 190     mapRn mkImportedGlobalFromRdrName snames            `thenRn` \ snames' ->
 191
 192         -- Tyvars scope over bindings and context
 193     bindTyVarsFV2Rn cls_doc tyvars              ( \ clas_tyvar_names tyvars' ->
 194
 195         -- Check the superclasses
 196     rnContext cls_doc context                   `thenRn` \ (context', cxt_fvs) ->
 197
 198         -- Check the functional dependencies
 199     rnFds cls_doc fds                   `thenRn` \ (fds', fds_fvs) ->
 200
 201         -- Check the signatures
 202     let
 203             -- First process the class op sigs, then the fixity sigs.
 204           (op_sigs, non_op_sigs) = partition isClassOpSig sigs
 205     in
 206     checkDupOrQualNames sig_doc sig_rdr_names_w_locs      `thenRn_`
 207     mapFvRn (rn_op cname' clas_tyvar_names fds') op_sigs  `thenRn` \ (sigs', sig_fvs) ->
 208     let
 209      binders = mkNameSet [ nm | (ClassOpSig nm _ _ _ _) <- sigs' ]
 210     in
 211     renameSigs (okClsDclSig binders) non_op_sigs          `thenRn` \ (non_ops', fix_fvs) ->
 212
 213         -- Check the methods
 214     checkDupOrQualNames meth_doc meth_rdr_names_w_locs  `thenRn_`
 215     rnMethodBinds mbinds
 216     `thenRn` \ (mbinds', meth_fvs) ->
 217
 218         -- Typechecker is responsible for checking that we only
 219         -- give default-method bindings for things in this class.
 220         -- The renamer *could* check this for class decls, but can't
 221         -- for instance decls.
 222
 223     ASSERT(isNoClassPragmas pragmas)
 224     returnRn (TyClD (ClassDecl context' cname' tyvars' fds' (non_ops' ++ sigs') mbinds'
 225                                NoClassPragmas tname' dname' dwname' snames' src_loc),
 226               sig_fvs   `plusFV`
 227               fix_fvs   `plusFV`
 228               cxt_fvs   `plusFV`
 229               fds_fvs   `plusFV`
 230               meth_fvs
 231              )
 232     )
 233   where
 234     cls_doc  = text "the declaration for class"         <+> ppr cname
 235     sig_doc  = text "the signatures for class"          <+> ppr cname
 236     meth_doc = text "the default-methods for class"     <+> ppr cname
 237
 238     sig_rdr_names_w_locs  = [(op,locn) | ClassOpSig op _ _ _ locn <- sigs]
 239     meth_rdr_names_w_locs = bagToList (collectMonoBinders mbinds)
 240     meth_rdr_names        = map fst meth_rdr_names_w_locs
 241
 242     rn_op clas clas_tyvars clas_fds sig@(ClassOpSig op dm_rdr_name explicit_dm ty locn)
 243       = pushSrcLocRn locn $
 244         lookupBndrRn op                         `thenRn` \ op_name ->
 245
 246                 -- Check the signature
 247         rnHsSigType (quotes (ppr op)) ty        `thenRn` \ (new_ty, op_ty_fvs)  ->
 248         let
 249             check_in_op_ty clas_tyvar =
 250                  checkRn (clas_tyvar `elemNameSet` oclose clas_fds op_ty_fvs)
 251                          (classTyVarNotInOpTyErr clas_tyvar sig)
 252         in
 253         mapRn_ check_in_op_ty clas_tyvars                `thenRn_`
 254
 255                 -- Make the default-method name
 256         getModeRn                                       `thenRn` \ mode ->
 257         (case mode of
 258             SourceMode -> -- Source class decl
 259                    newImplicitBinder (mkDefaultMethodOcc (rdrNameOcc op)) locn     `thenRn` \ dm_name ->
 260                    returnRn (dm_name, op `elem` meth_rdr_names, emptyFVs)
 261
 262             InterfaceMode
 263                 ->      -- Imported class that has a default method decl
 264                         -- See comments with tname, snames, above
 265                     lookupImplicitOccRn dm_rdr_name     `thenRn` \ dm_name ->
 266                     returnRn (dm_name, explicit_dm, if explicit_dm then unitFV dm_name else emptyFVs)
 267                         -- An imported class decl for a class decl that had an explicit default
 268                         -- method, mentions, rather than defines,
 269                         -- the default method, so we must arrange to pull it in
 270         )                                               `thenRn` \ (dm_name, final_explicit_dm, dm_fvs) ->
 271
 272         returnRn (ClassOpSig op_name dm_name final_explicit_dm new_ty locn, op_ty_fvs `plusFV` dm_fvs)
 273 \end{code}
 274
 275
 276 %*********************************************************
 277 %*                                                      *
 278 \subsection{Instance declarations}
 279 %*                                                      *
 280 %*********************************************************
 281
 282 \begin{code}
 283 rnDecl (InstD (InstDecl inst_ty mbinds uprags dfun_rdr_name src_loc))
 284   = pushSrcLocRn src_loc $
 285     rnHsSigType (text "an instance decl") inst_ty `thenRn` \ (inst_ty', inst_fvs) ->
 286     let
 287         inst_tyvars = case inst_ty' of
 288                         HsForAllTy (Just inst_tyvars) _ _ -> inst_tyvars
 289                         other                             -> []
 290         -- (Slightly strangely) the forall-d tyvars scope over
 291         -- the method bindings too
 292     in
 293
 294         -- Rename the bindings
 295         -- NB meth_names can be qualified!
 296     checkDupNames meth_doc meth_names           `thenRn_`
 297     extendTyVarEnvFVRn inst_tyvars (
 298         rnMethodBinds mbinds
 299     )                                           `thenRn` \ (mbinds', meth_fvs) ->
 300     let
 301         binders = mkNameSet (map fst (bagToList (collectMonoBinders mbinds')))
 302     in
 303         -- Rename the prags and signatures.
 304         -- Note that the type variables are not in scope here,
 305         -- so that      instance Eq a => Eq (T a) where
 306         --                      {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
 307         -- works OK.
 308     renameSigs (okInstDclSig binders) uprags    `thenRn` \ (new_uprags, prag_fvs) ->
 309
 310     getModeRn           `thenRn` \ mode ->
 311     (case mode of
 312         InterfaceMode -> lookupImplicitOccRn dfun_rdr_name      `thenRn` \ dfun_name ->
 313                          returnRn (dfun_name, unitFV dfun_name)
 314         SourceMode    -> newDFunName (getDFunKey inst_ty') src_loc
 315                          `thenRn` \ dfun_name ->
 316                          returnRn (dfun_name, emptyFVs)
 317     )
 318     `thenRn` \ (dfun_name, dfun_fv) ->
 319
 320     -- The typechecker checks that all the bindings are for the right class.
 321     returnRn (InstD (InstDecl inst_ty' mbinds' new_uprags dfun_name src_loc),
 322               inst_fvs `plusFV` meth_fvs `plusFV` prag_fvs `plusFV` dfun_fv)
 323   where
 324     meth_doc = text "the bindings in an instance declaration"
 325     meth_names   = bagToList (collectMonoBinders mbinds)
 326 \end{code}
 327
 328 %*********************************************************
 329 %*                                                      *
 330 \subsection{Default declarations}
 331 %*                                                      *
 332 %*********************************************************
 333
 334 \begin{code}
 335 rnDecl (DefD (DefaultDecl tys src_loc))
 336   = pushSrcLocRn src_loc $
 337     rnHsTypes doc_str tys               `thenRn` \ (tys', fvs) ->
 338     returnRn (DefD (DefaultDecl tys' src_loc), fvs)
 339   where
 340     doc_str = text "a `default' declaration"
 341 \end{code}
 342
 343 %*********************************************************
 344 %*                                                      *
 345 \subsection{Foreign declarations}
 346 %*                                                      *
 347 %*********************************************************
 348
 349 \begin{code}
 350 rnDecl (ForD (ForeignDecl name imp_exp ty ext_nm cconv src_loc))
 351   = pushSrcLocRn src_loc $
 352     lookupOccRn name                    `thenRn` \ name' ->
 353     let
 354         extra_fvs FoExport
 355           | isDyn       = lookupImplicitOccsRn [makeStablePtr_RDR, deRefStablePtr_RDR, bindIO_RDR]
 356           | otherwise   = returnRn (unitFV name')
 357         extra_fvs other = returnRn emptyFVs
 358     in
 359     checkRn (ok_ext_nm ext_nm) (badExtName ext_nm)      `thenRn_`
 360     extra_fvs imp_exp                                   `thenRn` \ fvs1 ->
 361     rnHsSigType fo_decl_msg ty                          `thenRn` \ (ty', fvs2) ->
 362     returnRn (ForD (ForeignDecl name' imp_exp ty' ext_nm cconv src_loc),
 363               fvs1 `plusFV` fvs2)
 364  where
 365   fo_decl_msg = ptext SLIT("a foreign declaration")
 366   isDyn       = isDynamicExtName ext_nm
 367
 368   ok_ext_nm Dynamic                = True
 369   ok_ext_nm (ExtName nm (Just mb)) = isCLabelString nm && isCLabelString mb
 370   ok_ext_nm (ExtName nm Nothing)   = isCLabelString nm
 371 \end{code}
 372
 373 %*********************************************************
 374 %*                                                      *
 375 \subsection{Rules}
 376 %*                                                      *
 377 %*********************************************************
 378
 379 \begin{code}
 380 rnDecl (RuleD (IfaceRule rule_name vars fn args rhs src_loc))
 381   = pushSrcLocRn src_loc        $
 382     lookupOccRn fn              `thenRn` \ fn' ->
 383     rnCoreBndrs vars            $ \ vars' ->
 384     mapFvRn rnCoreExpr args     `thenRn` \ (args', fvs1) ->
 385     rnCoreExpr rhs              `thenRn` \ (rhs',  fvs2) ->
 386     returnRn (RuleD (IfaceRule rule_name vars' fn' args' rhs' src_loc),
 387               (fvs1 `plusFV` fvs2) `addOneFV` fn')
 388
 389 rnDecl (RuleD (IfaceRuleOut fn rule))
 390         -- This one is used for BuiltInRules
 391         -- The rule itself is already done, but the thing
 392         -- to attach it to is not.
 393   = lookupOccRn fn              `thenRn` \ fn' ->
 394     returnRn (RuleD (IfaceRuleOut fn' rule), unitFV fn')
 395
 396 rnDecl (RuleD (HsRule rule_name tvs vars lhs rhs src_loc))
 397   = ASSERT( null tvs )
 398     pushSrcLocRn src_loc                        $
 399
 400     bindTyVarsFV2Rn doc (map UserTyVar sig_tvs) $ \ sig_tvs' _ ->
 401     bindLocalsFVRn doc (map get_var vars)       $ \ ids ->
 402     mapFvRn rn_var (vars `zip` ids)             `thenRn` \ (vars', fv_vars) ->
 403
 404     rnExpr lhs                                  `thenRn` \ (lhs', fv_lhs) ->
 405     rnExpr rhs                                  `thenRn` \ (rhs', fv_rhs) ->
 406     checkRn (validRuleLhs ids lhs')
 407             (badRuleLhsErr rule_name lhs')      `thenRn_`
 408     let
 409         bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs)]
 410     in
 411     mapRn (addErrRn . badRuleVar rule_name) bad_vars    `thenRn_`
 412     returnRn (RuleD (HsRule rule_name sig_tvs' vars' lhs' rhs' src_loc),
 413               fv_vars `plusFV` fv_lhs `plusFV` fv_rhs)
 414   where
 415     doc = text "the transformation rule" <+> ptext rule_name
 416     sig_tvs = extractRuleBndrsTyVars vars
 417
 418     get_var (RuleBndr v)      = v
 419     get_var (RuleBndrSig v _) = v
 420
 421     rn_var (RuleBndr v, id)      = returnRn (RuleBndr id, emptyFVs)
 422     rn_var (RuleBndrSig v t, id) = rnHsType doc t       `thenRn` \ (t', fvs) ->
 423                                    returnRn (RuleBndrSig id t', fvs)
 424 \end{code}
 425
 426
 427 %*********************************************************
 428 %*                                                      *
 429 \subsection{Support code for type/data declarations}
 430 %*                                                      *
 431 %*********************************************************
 432
 433 \begin{code}
 434 rnDerivs :: Maybe [RdrName] -> RnMS (Maybe [Name], FreeVars)
 435
 436 rnDerivs Nothing -- derivs not specified
 437   = returnRn (Nothing, emptyFVs)
 438
 439 rnDerivs (Just clss)
 440   = mapRn do_one clss   `thenRn` \ clss' ->
 441     returnRn (Just clss', mkNameSet clss')
 442   where
 443     do_one cls = lookupOccRn cls        `thenRn` \ clas_name ->
 444                  checkRn (getUnique clas_name `elem` derivableClassKeys)
 445                          (derivingNonStdClassErr clas_name)     `thenRn_`
 446                  returnRn clas_name
 447 \end{code}
 448
 449 \begin{code}
 450 conDeclName :: RdrNameConDecl -> (RdrName, SrcLoc)
 451 conDeclName (ConDecl n _ _ _ _ l) = (n,l)
 452
 453 rnConDecl :: RdrNameConDecl -> RnMS (RenamedConDecl, FreeVars)
 454 rnConDecl (ConDecl name wkr tvs cxt details locn)
 455   = pushSrcLocRn locn $
 456     checkConName name                   `thenRn_`
 457     lookupBndrRn name                   `thenRn` \ new_name ->
 458
 459     mkImportedGlobalFromRdrName wkr     `thenRn` \ new_wkr ->
 460         -- See comments with ClassDecl
 461
 462     bindTyVarsFVRn doc tvs              $ \ new_tyvars ->
 463     rnContext doc cxt                   `thenRn` \ (new_context, cxt_fvs) ->
 464     rnConDetails doc locn details       `thenRn` \ (new_details, det_fvs) ->
 465     returnRn (ConDecl new_name new_wkr new_tyvars new_context new_details locn,
 466               cxt_fvs `plusFV` det_fvs)
 467   where
 468     doc = text "the definition of data constructor" <+> quotes (ppr name)
 469
 470 rnConDetails doc locn (VanillaCon tys)
 471   = mapFvRn (rnBangTy doc) tys  `thenRn` \ (new_tys, fvs)  ->
 472     returnRn (VanillaCon new_tys, fvs)
 473
 474 rnConDetails doc locn (InfixCon ty1 ty2)
 475   = rnBangTy doc ty1            `thenRn` \ (new_ty1, fvs1) ->
 476     rnBangTy doc ty2            `thenRn` \ (new_ty2, fvs2) ->
 477     returnRn (InfixCon new_ty1 new_ty2, fvs1 `plusFV` fvs2)
 478
 479 rnConDetails doc locn (NewCon ty mb_field)
 480   = rnHsType doc ty                     `thenRn` \ (new_ty, fvs) ->
 481     rn_field mb_field                   `thenRn` \ new_mb_field  ->
 482     returnRn (NewCon new_ty new_mb_field, fvs)
 483   where
 484     rn_field Nothing  = returnRn Nothing
 485     rn_field (Just f) =
 486        lookupBndrRn f       `thenRn` \ new_f ->
 487        returnRn (Just new_f)
 488
 489 rnConDetails doc locn (RecCon fields)
 490   = checkDupOrQualNames doc field_names `thenRn_`
 491     mapFvRn (rnField doc) fields        `thenRn` \ (new_fields, fvs) ->
 492     returnRn (RecCon new_fields, fvs)
 493   where
 494     field_names = [(fld, locn) | (flds, _) <- fields, fld <- flds]
 495
 496 rnField doc (names, ty)
 497   = mapRn lookupBndrRn names    `thenRn` \ new_names ->
 498     rnBangTy doc ty             `thenRn` \ (new_ty, fvs) ->
 499     returnRn ((new_names, new_ty), fvs)
 500
 501 rnBangTy doc (Banged ty)
 502   = rnHsType doc ty             `thenRn` \ (new_ty, fvs) ->
 503     returnRn (Banged new_ty, fvs)
 504
 505 rnBangTy doc (Unbanged ty)
 506   = rnHsType doc ty             `thenRn` \ (new_ty, fvs) ->
 507     returnRn (Unbanged new_ty, fvs)
 508
 509 rnBangTy doc (Unpacked ty)
 510   = rnHsType doc ty             `thenRn` \ (new_ty, fvs) ->
 511     returnRn (Unpacked new_ty, fvs)
 512
 513 -- This data decl will parse OK
 514 --      data T = a Int
 515 -- treating "a" as the constructor.
 516 -- It is really hard to make the parser spot this malformation.
 517 -- So the renamer has to check that the constructor is legal
 518 --
 519 -- We can get an operator as the constructor, even in the prefix form:
 520 --      data T = :% Int Int
 521 -- from interface files, which always print in prefix form
 522
 523 checkConName name
 524   = checkRn (isRdrDataCon name)
 525             (badDataCon name)
 526 \end{code}
 527
 528
 529 %*********************************************************
 530 %*                                                      *
 531 \subsection{Support code to rename types}
 532 %*                                                      *
 533 %*********************************************************
 534
 535 \begin{code}
 536 rnHsSigType :: SDoc -> RdrNameHsType -> RnMS (RenamedHsType, FreeVars)
 537         -- rnHsSigType is used for source-language type signatures,
 538         -- which use *implicit* universal quantification.
 539 rnHsSigType doc_str ty
 540   = rnHsType (text "the type signature for" <+> doc_str) ty
 541
 542 ---------------------------------------
 543 rnHsType :: SDoc -> RdrNameHsType -> RnMS (RenamedHsType, FreeVars)
 544
 545 rnHsType doc (HsForAllTy Nothing ctxt ty)
 546         -- Implicit quantifiction in source code (no kinds on tyvars)
 547         -- Given the signature  C => T  we universally quantify
 548         -- over FV(T) \ {in-scope-tyvars}
 549   = getLocalNameEnv             `thenRn` \ name_env ->
 550     let
 551         mentioned_in_tau = extractHsTyRdrTyVars ty
 552         forall_tyvars    = filter (not . (`elemFM` name_env)) mentioned_in_tau
 553     in
 554     checkConstraints doc forall_tyvars mentioned_in_tau ctxt ty `thenRn` \ ctxt' ->
 555     rnForAll doc (map UserTyVar forall_tyvars) ctxt' ty
 556
 557 rnHsType doc (HsForAllTy (Just forall_tyvars) ctxt tau)
 558         -- Explicit quantification.
 559         -- Check that the forall'd tyvars are a subset of the
 560         -- free tyvars in the tau-type part
 561         -- That's only a warning... unless the tyvar is constrained by a
 562         -- context in which case it's an error
 563   = let
 564         mentioned_in_tau  = extractHsTyRdrTyVars tau
 565         mentioned_in_ctxt = nub [tv | p <- ctxt,
 566                                       ty <- tys_of_pred p,
 567                                       tv <- extractHsTyRdrTyVars ty]
 568         tys_of_pred (HsPClass clas tys) = tys
 569         tys_of_pred (HsPIParam n ty) = [ty]
 570
 571         dubious_guys          = filter (`notElem` mentioned_in_tau) forall_tyvar_names
 572                 -- dubious = explicitly quantified but not mentioned in tau type
 573
 574         (bad_guys, warn_guys) = partition (`elem` mentioned_in_ctxt) dubious_guys
 575                 -- bad  = explicitly quantified and constrained, but not mentioned in tau
 576                 -- warn = explicitly quantified but not mentioned in ctxt or tau
 577
 578         forall_tyvar_names    = map getTyVarName forall_tyvars
 579     in
 580     -- mapRn_ (forAllErr doc tau) bad_guys                                      `thenRn_`
 581     mapRn_ (forAllWarn doc tau) warn_guys                                       `thenRn_`
 582     checkConstraints doc forall_tyvar_names mentioned_in_tau ctxt tau   `thenRn` \ ctxt' ->
 583     rnForAll doc forall_tyvars ctxt' tau
 584
 585 rnHsType doc (HsTyVar tyvar)
 586   = lookupOccRn tyvar           `thenRn` \ tyvar' ->
 587     returnRn (HsTyVar tyvar', unitFV tyvar')
 588
 589 rnHsType doc (HsFunTy ty1 ty2)
 590   = rnHsType doc ty1    `thenRn` \ (ty1', fvs1) ->
 591         -- Might find a for-all as the arg of a function type
 592     rnHsType doc ty2    `thenRn` \ (ty2', fvs2) ->
 593         -- Or as the result.  This happens when reading Prelude.hi
 594         -- when we find return :: forall m. Monad m -> forall a. a -> m a
 595     returnRn (HsFunTy ty1' ty2', fvs1 `plusFV` fvs2)
 596
 597 rnHsType doc (HsListTy ty)
 598   = rnHsType doc ty                             `thenRn` \ (ty', fvs) ->
 599     returnRn (HsListTy ty', fvs `addOneFV` listTyCon_name)
 600
 601 -- Unboxed tuples are allowed to have poly-typed arguments.  These
 602 -- sometimes crop up as a result of CPR worker-wrappering dictionaries.
 603 rnHsType doc (HsTupleTy (HsTupCon _ boxity) tys)
 604         -- Don't do lookupOccRn, because this is built-in syntax
 605         -- so it doesn't need to be in scope
 606   = mapFvRn (rnHsType doc) tys          `thenRn` \ (tys', fvs) ->
 607     returnRn (HsTupleTy (HsTupCon n' boxity) tys', fvs `addOneFV` n')
 608   where
 609     n' = tupleTyCon_name boxity (length tys)
 610
 611
 612 rnHsType doc (HsAppTy ty1 ty2)
 613   = rnHsType doc ty1            `thenRn` \ (ty1', fvs1) ->
 614     rnHsType doc ty2            `thenRn` \ (ty2', fvs2) ->
 615     returnRn (HsAppTy ty1' ty2', fvs1 `plusFV` fvs2)
 616
 617 rnHsType doc (HsPredTy pred)
 618   = rnPred doc pred     `thenRn` \ (pred', fvs) ->
 619     returnRn (HsPredTy pred', fvs)
 620
 621 rnHsType doc (HsUsgForAllTy uv_rdr ty)
 622   = bindUVarRn doc uv_rdr $ \ uv_name ->
 623     rnHsType doc ty       `thenRn` \ (ty', fvs) ->
 624     returnRn (HsUsgForAllTy uv_name ty',
 625               fvs )
 626
 627 rnHsType doc (HsUsgTy usg ty)
 628   = newUsg usg                      `thenRn` \ (usg', usg_fvs) ->
 629     rnHsType doc ty                 `thenRn` \ (ty', ty_fvs) ->
 630         -- A for-all can occur inside a usage annotation
 631     returnRn (HsUsgTy usg' ty',
 632               usg_fvs `plusFV` ty_fvs)
 633   where
 634     newUsg usg = case usg of
 635                    HsUsOnce       -> returnRn (HsUsOnce, emptyFVs)
 636                    HsUsMany       -> returnRn (HsUsMany, emptyFVs)
 637                    HsUsVar uv_rdr -> lookupOccRn uv_rdr `thenRn` \ uv_name ->
 638                                        returnRn (HsUsVar uv_name, emptyFVs)
 639
 640 rnHsTypes doc tys = mapFvRn (rnHsType doc) tys
 641 \end{code}
 642
 643 \begin{code}
 644 -- We use lookupOcc here because this is interface file only stuff
 645 -- and we need the workers...
 646 rnHsTupCon (HsTupCon n boxity)
 647   = lookupOccRn n       `thenRn` \ n' ->
 648     returnRn (HsTupCon n' boxity, unitFV n')
 649
 650 rnHsTupConWkr (HsTupCon n boxity)
 651         -- Tuple construtors are for the *worker* of the tuple
 652         -- Going direct saves needless messing about
 653   = lookupOccRn (mkRdrNameWkr n)        `thenRn` \ n' ->
 654     returnRn (HsTupCon n' boxity, unitFV n')
 655 \end{code}
 656
 657 \begin{code}
 658 -- Check that each constraint mentions at least one of the forall'd type variables
 659 -- Since the forall'd type variables are a subset of the free tyvars
 660 -- of the tau-type part, this guarantees that every constraint mentions
 661 -- at least one of the free tyvars in ty
 662 checkConstraints doc forall_tyvars tau_vars ctxt ty
 663    = mapRn (checkPred doc forall_tyvars ty) ctxt `thenRn` \ maybe_ctxt' ->
 664      returnRn (catMaybes maybe_ctxt')
 665             -- Remove problem ones, to avoid duplicate error message.
 666
 667 checkPred doc forall_tyvars ty p@(HsPClass clas tys)
 668   | not_univ  = failWithRn Nothing (univErr  doc p ty)
 669   | otherwise = returnRn (Just p)
 670   where
 671       ct_vars  = extractHsTysRdrTyVars tys
 672       not_univ =  -- At least one of the tyvars in each constraint must
 673                   -- be universally quantified. This restriction isn't in Hugs
 674                   not (any (`elem` forall_tyvars) ct_vars)
 675 checkPred doc forall_tyvars ty p@(HsPIParam _ _)
 676   = returnRn (Just p)
 677
 678 rnForAll doc forall_tyvars ctxt ty
 679   = bindTyVarsFVRn doc forall_tyvars    $ \ new_tyvars ->
 680     rnContext doc ctxt                  `thenRn` \ (new_ctxt, cxt_fvs) ->
 681     rnHsType doc ty                     `thenRn` \ (new_ty, ty_fvs) ->
 682     returnRn (mkHsForAllTy (Just new_tyvars) new_ctxt new_ty,
 683               cxt_fvs `plusFV` ty_fvs)
 684 \end{code}
 685
 686 \begin{code}
 687 rnContext :: SDoc -> RdrNameContext -> RnMS (RenamedContext, FreeVars)
 688 rnContext doc ctxt
 689   = mapAndUnzipRn rn_pred ctxt          `thenRn` \ (theta, fvs_s) ->
 690     let
 691         (_, dups) = removeDupsEq theta
 692                 -- We only have equality, not ordering
 693     in
 694         -- Check for duplicate assertions
 695         -- If this isn't an error, then it ought to be:
 696     mapRn (addWarnRn . dupClassAssertWarn theta) dups           `thenRn_`
 697     returnRn (theta, plusFVs fvs_s)
 698   where
 699         --Someone discovered that @CCallable@ and @CReturnable@
 700         -- could be used in contexts such as:
 701         --      foo :: CCallable a => a -> PrimIO Int
 702         -- Doing this utterly wrecks the whole point of introducing these
 703         -- classes so we specifically check that this isn't being done.
 704     rn_pred pred = rnPred doc pred                              `thenRn` \ (pred', fvs)->
 705                    checkRn (not (bad_pred pred'))
 706                            (naughtyCCallContextErr pred')       `thenRn_`
 707                    returnRn (pred', fvs)
 708
 709     bad_pred (HsPClass clas _) = getUnique clas `elem` cCallishClassKeys
 710     bad_pred other             = False
 711
 712
 713 rnPred doc (HsPClass clas tys)
 714   = lookupOccRn clas            `thenRn` \ clas_name ->
 715     rnHsTypes doc tys           `thenRn` \ (tys', fvs) ->
 716     returnRn (HsPClass clas_name tys', fvs `addOneFV` clas_name)
 717
 718 rnPred doc (HsPIParam n ty)
 719   = getIPName n                 `thenRn` \ name ->
 720     rnHsType doc ty             `thenRn` \ (ty', fvs) ->
 721     returnRn (HsPIParam name ty', fvs)
 722 \end{code}
 723
 724 \begin{code}
 725 rnFds :: SDoc -> [FunDep RdrName] -> RnMS ([FunDep Name], FreeVars)
 726
 727 rnFds doc fds
 728   = mapAndUnzipRn rn_fds fds            `thenRn` \ (theta, fvs_s) ->
 729     returnRn (theta, plusFVs fvs_s)
 730   where
 731     rn_fds (tys1, tys2)
 732       = rnHsTyVars doc tys1             `thenRn` \ (tys1', fvs1) ->
 733         rnHsTyVars doc tys2             `thenRn` \ (tys2', fvs2) ->
 734         returnRn ((tys1', tys2'), fvs1 `plusFV` fvs2)
 735
 736 rnHsTyVars doc tvs = mapFvRn (rnHsTyvar doc) tvs
 737 rnHsTyvar doc tyvar
 738   = lookupOccRn tyvar           `thenRn` \ tyvar' ->
 739     returnRn (tyvar', unitFV tyvar')
 740 \end{code}
 741
 742 %*********************************************************
 743 %*                                                       *
 744 \subsection{IdInfo}
 745 %*                                                       *
 746 %*********************************************************
 747
 748 \begin{code}
 749 rnIdInfo (HsStrictness str) = returnRn (HsStrictness str, emptyFVs)
 750
 751 rnIdInfo (HsWorker worker)
 752   = lookupOccRn worker                  `thenRn` \ worker' ->
 753     returnRn (HsWorker worker', unitFV worker')
 754
 755 rnIdInfo (HsUnfold inline expr) = rnCoreExpr expr `thenRn` \ (expr', fvs) ->
 756                                   returnRn (HsUnfold inline expr', fvs)
 757 rnIdInfo (HsArity arity)        = returnRn (HsArity arity, emptyFVs)
 758 rnIdInfo (HsUpdate update)      = returnRn (HsUpdate update, emptyFVs)
 759 rnIdInfo HsNoCafRefs            = returnRn (HsNoCafRefs, emptyFVs)
 760 rnIdInfo HsCprInfo              = returnRn (HsCprInfo, emptyFVs)
 761
 762 \end{code}
 763
 764 @UfCore@ expressions.
 765
 766 \begin{code}
 767 rnCoreExpr (UfType ty)
 768   = rnHsType (text "unfolding type") ty `thenRn` \ (ty', fvs) ->
 769     returnRn (UfType ty', fvs)
 770
 771 rnCoreExpr (UfVar v)
 772   = lookupOccRn v       `thenRn` \ v' ->
 773     returnRn (UfVar v', unitFV v')
 774
 775 rnCoreExpr (UfLit l)
 776   = returnRn (UfLit l, emptyFVs)
 777
 778 rnCoreExpr (UfLitLit l ty)
 779   = rnHsType (text "litlit") ty `thenRn` \ (ty', fvs) ->
 780     returnRn (UfLitLit l ty', fvs)
 781
 782 rnCoreExpr (UfCCall cc ty)
 783   = rnHsType (text "ccall") ty  `thenRn` \ (ty', fvs) ->
 784     returnRn (UfCCall cc ty', fvs)
 785
 786 rnCoreExpr (UfTuple con args)
 787   = rnHsTupConWkr con                   `thenRn` \ (con', fvs1) ->
 788     mapFvRn rnCoreExpr args             `thenRn` \ (args', fvs2) ->
 789     returnRn (UfTuple con' args', fvs1 `plusFV` fvs2)
 790
 791 rnCoreExpr (UfApp fun arg)
 792   = rnCoreExpr fun              `thenRn` \ (fun', fv1) ->
 793     rnCoreExpr arg              `thenRn` \ (arg', fv2) ->
 794     returnRn (UfApp fun' arg', fv1 `plusFV` fv2)
 795
 796 rnCoreExpr (UfCase scrut bndr alts)
 797   = rnCoreExpr scrut                    `thenRn` \ (scrut', fvs1) ->
 798     bindCoreLocalFVRn bndr              ( \ bndr' ->
 799         mapFvRn rnCoreAlt alts          `thenRn` \ (alts', fvs2) ->
 800         returnRn (UfCase scrut' bndr' alts', fvs2)
 801     )                                           `thenRn` \ (case', fvs3) ->
 802     returnRn (case', fvs1 `plusFV` fvs3)
 803
 804 rnCoreExpr (UfNote note expr)
 805   = rnNote note                 `thenRn` \ (note', fvs1) ->
 806     rnCoreExpr expr             `thenRn` \ (expr', fvs2) ->
 807     returnRn  (UfNote note' expr', fvs1 `plusFV` fvs2)
 808
 809 rnCoreExpr (UfLam bndr body)
 810   = rnCoreBndr bndr             $ \ bndr' ->
 811     rnCoreExpr body             `thenRn` \ (body', fvs) ->
 812     returnRn (UfLam bndr' body', fvs)
 813
 814 rnCoreExpr (UfLet (UfNonRec bndr rhs) body)
 815   = rnCoreExpr rhs              `thenRn` \ (rhs', fvs1) ->
 816     rnCoreBndr bndr             ( \ bndr' ->
 817         rnCoreExpr body         `thenRn` \ (body', fvs2) ->
 818         returnRn (UfLet (UfNonRec bndr' rhs') body', fvs2)
 819     )                           `thenRn` \ (result, fvs3) ->
 820     returnRn (result, fvs1 `plusFV` fvs3)
 821
 822 rnCoreExpr (UfLet (UfRec pairs) body)
 823   = rnCoreBndrs bndrs           $ \ bndrs' ->
 824     mapFvRn rnCoreExpr rhss     `thenRn` \ (rhss', fvs1) ->
 825     rnCoreExpr body             `thenRn` \ (body', fvs2) ->
 826     returnRn (UfLet (UfRec (bndrs' `zip` rhss')) body', fvs1 `plusFV` fvs2)
 827   where
 828     (bndrs, rhss) = unzip pairs
 829 \end{code}
 830
 831 \begin{code}
 832 rnCoreBndr (UfValBinder name ty) thing_inside
 833   = rnHsType doc ty             `thenRn` \ (ty', fvs1) ->
 834     bindCoreLocalFVRn name      ( \ name' ->
 835             thing_inside (UfValBinder name' ty')
 836     )                           `thenRn` \ (result, fvs2) ->
 837     returnRn (result, fvs1 `plusFV` fvs2)
 838   where
 839     doc = text "unfolding id"
 840
 841 rnCoreBndr (UfTyBinder name kind) thing_inside
 842   = bindCoreLocalFVRn name              $ \ name' ->
 843     thing_inside (UfTyBinder name' kind)
 844
 845 rnCoreBndrs []     thing_inside = thing_inside []
 846 rnCoreBndrs (b:bs) thing_inside = rnCoreBndr b          $ \ name' ->
 847                                   rnCoreBndrs bs        $ \ names' ->
 848                                   thing_inside (name':names')
 849 \end{code}
 850
 851 \begin{code}
 852 rnCoreAlt (con, bndrs, rhs)
 853   = rnUfCon con bndrs                   `thenRn` \ (con', fvs1) ->
 854     bindCoreLocalsFVRn bndrs            ( \ bndrs' ->
 855         rnCoreExpr rhs                  `thenRn` \ (rhs', fvs2) ->
 856         returnRn ((con', bndrs', rhs'), fvs2)
 857     )                                   `thenRn` \ (result, fvs3) ->
 858     returnRn (result, fvs1 `plusFV` fvs3)
 859
 860 rnNote (UfCoerce ty)
 861   = rnHsType (text "unfolding coerce") ty       `thenRn` \ (ty', fvs) ->
 862     returnRn (UfCoerce ty', fvs)
 863
 864 rnNote (UfSCC cc)   = returnRn (UfSCC cc, emptyFVs)
 865 rnNote UfInlineCall = returnRn (UfInlineCall, emptyFVs)
 866 rnNote UfInlineMe   = returnRn (UfInlineMe, emptyFVs)
 867
 868
 869 rnUfCon UfDefault _
 870   = returnRn (UfDefault, emptyFVs)
 871
 872 rnUfCon (UfTupleAlt tup_con) bndrs
 873   = rnHsTupCon tup_con          `thenRn` \ (HsTupCon con' _, fvs) ->
 874     returnRn (UfDataAlt con', fvs)
 875         -- Makes the type checker a little easier
 876
 877 rnUfCon (UfDataAlt con) _
 878   = lookupOccRn con             `thenRn` \ con' ->
 879     returnRn (UfDataAlt con', unitFV con')
 880
 881 rnUfCon (UfLitAlt lit) _
 882   = returnRn (UfLitAlt lit, emptyFVs)
 883
 884 rnUfCon (UfLitLitAlt lit ty) _
 885   = rnHsType (text "litlit") ty         `thenRn` \ (ty', fvs) ->
 886     returnRn (UfLitLitAlt lit ty', fvs)
 887 \end{code}
 888
 889 %*********************************************************
 890 %*                                                       *
 891 \subsection{Rule shapes}
 892 %*                                                       *
 893 %*********************************************************
 894
 895 Check the shape of a transformation rule LHS.  Currently
 896 we only allow LHSs of the form @(f e1 .. en)@, where @f@ is
 897 not one of the @forall@'d variables.
 898
 899 \begin{code}
 900 validRuleLhs foralls lhs
 901   = check lhs
 902   where
 903     check (HsApp e1 e2)                   = check e1
 904     check (HsVar v) | v `notElem` foralls = True
 905     check other                           = False
 906 \end{code}
 907
 908
 909 %*********************************************************
 910 %*                                                       *
 911 \subsection{Errors}
 912 %*                                                       *
 913 %*********************************************************
 914
 915 \begin{code}
 916 derivingNonStdClassErr clas
 917   = hsep [ptext SLIT("non-standard class"), ppr clas, ptext SLIT("in deriving clause")]
 918
 919 classTyVarNotInOpTyErr clas_tyvar sig
 920   = hang (hsep [ptext SLIT("Class type variable"),
 921                        quotes (ppr clas_tyvar),
 922                        ptext SLIT("does not appear in method signature")])
 923          4 (ppr sig)
 924
 925 badDataCon name
 926    = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
 927
 928 forAllWarn doc ty tyvar
 929   | not opt_WarnUnusedMatches = returnRn ()
 930   | otherwise
 931   = getModeRn           `thenRn` \ mode ->
 932     case mode of {
 933 #ifndef DEBUG
 934         InterfaceMode -> returnRn () ;  -- Don't warn of unused tyvars in interface files
 935                                         -- unless DEBUG is on, in which case it is slightly
 936                                         -- informative.  They can arise from mkRhsTyLam,
 937 #endif                                  -- leading to (say)     f :: forall a b. [b] -> [b]
 938         other ->
 939
 940     addWarnRn (
 941       sep [ptext SLIT("The universally quantified type variable") <+> quotes (ppr tyvar),
 942            nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))]
 943       $$
 944       (ptext SLIT("In") <+> doc))
 945     }
 946
 947 forAllErr doc ty tyvar
 948   = addErrRn (
 949       sep [ptext SLIT("The constrained type variable") <+> quotes (ppr tyvar),
 950            nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))]
 951       $$
 952       (ptext SLIT("In") <+> doc))
 953
 954 univErr doc constraint ty
 955   = sep [ptext SLIT("All of the type variable(s) in the constraint")
 956           <+> quotes (ppr constraint)
 957           <+> ptext SLIT("are already in scope"),
 958          nest 4 (ptext SLIT("At least one must be universally quantified here"))
 959     ]
 960     $$
 961     (ptext SLIT("In") <+> doc)
 962
 963 ambigErr doc constraint ty
 964   = sep [ptext SLIT("Ambiguous constraint") <+> quotes (ppr constraint),
 965          nest 4 (ptext SLIT("in the type:") <+> ppr ty),
 966          nest 4 (ptext SLIT("Each forall-d type variable mentioned by the constraint must appear after the =>."))]
 967     $$
 968     (ptext SLIT("In") <+> doc)
 969
 970 badRuleLhsErr name lhs
 971   = sep [ptext SLIT("Rule") <+> ptext name <> colon,
 972          nest 4 (ptext SLIT("Illegal left-hand side:") <+> ppr lhs)]
 973     $$
 974     ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
 975
 976 badRuleVar name var
 977   = sep [ptext SLIT("Rule") <+> ptext name <> colon,
 978          ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
 979                 ptext SLIT("does not appear on left hand side")]
 980
 981 badExtName :: ExtName -> Message
 982 badExtName ext_nm
 983   = sep [quotes (ppr ext_nm) <+> ptext SLIT("is not a valid C identifier")]
 984
 985 dupClassAssertWarn ctxt (assertion : dups)
 986   = sep [hsep [ptext SLIT("Duplicate class assertion"),
 987                quotes (ppr assertion),
 988                ptext SLIT("in the context:")],
 989          nest 4 (ppr ctxt <+> ptext SLIT("..."))]
 990
 991 naughtyCCallContextErr (HsPClass clas _)
 992   = sep [ptext SLIT("Can't use class") <+> quotes (ppr clas),
 993          ptext SLIT("in a context")]
 994 \end{code}