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