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