ghc/compiler/rename/RnSource.lhs

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