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