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