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