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 {-# OPTIONS -w #-}
   8 -- The above warning supression flag is a temporary kludge.
   9 -- While working on this module you are encouraged to remove it and fix
  10 -- any warnings in the module. See
  11 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
  12 -- for details
  13
  14 module RnSource (
  15         rnSrcDecls, addTcgDUs,
  16         rnTyClDecls,
  17         rnSplice, checkTH
  18     ) where
  19
  20 #include "HsVersions.h"
  21
  22 import {-# SOURCE #-} RnExpr( rnLExpr )
  23
  24 import HsSyn
  25 import RdrName          ( RdrName, isRdrDataCon, elemLocalRdrEnv,
  26                           globalRdrEnvElts, GlobalRdrElt(..), isLocalGRE, rdrNameOcc )
  27 import RdrHsSyn         ( extractGenericPatTyVars, extractHsRhoRdrTyVars )
  28 import RnHsSyn
  29 import RnTypes          ( rnLHsType, rnLHsTypes, rnHsSigType, rnHsTypeFVs, rnContext )
  30 import RnBinds          ( rnTopBindsLHS, rnTopBindsRHS, rnMethodBinds, renameSigs, mkSigTvFn,
  31                                 makeMiniFixityEnv)
  32 import RnEnv            ( lookupLocalDataTcNames,
  33                           lookupLocatedTopBndrRn, lookupLocatedOccRn,
  34                           lookupOccRn, newLocalsRn,
  35                           bindLocatedLocalsFV, bindPatSigTyVarsFV,
  36                           bindTyVarsRn, extendTyVarEnvFVRn,
  37                           bindLocalNames, checkDupRdrNames, mapFvRn, lookupGreLocalRn,
  38                         )
  39 import RnNames       (importsFromLocalDecls, extendRdrEnvRn)
  40 import HscTypes      (GenAvailInfo(..))
  41 import RnHsDoc          ( rnHsDoc, rnMbLHsDoc )
  42 import TcRnMonad
  43
  44 import HscTypes         ( FixityEnv, FixItem(..), Deprecations(..), plusDeprecs )
  45 import Class            ( FunDep )
  46 import Name             ( Name, nameOccName )
  47 import NameSet
  48 import NameEnv
  49 import UniqFM
  50 import OccName
  51 import Outputable
  52 import SrcLoc           ( Located(..), unLoc, noLoc )
  53 import DynFlags ( DynFlag(..) )
  54 import Maybes           ( seqMaybe )
  55 import Maybe            ( isNothing )
  56 import Monad            ( liftM, when )
  57 import BasicTypes       ( Boxity(..) )
  58
  59 import ListSetOps    (findDupsEq, mkLookupFun)
  60 \end{code}
  61
  62 @rnSourceDecl@ `renames' declarations.
  63 It simultaneously performs dependency analysis and precedence parsing.
  64 It also does the following error checks:
  65 \begin{enumerate}
  66 \item
  67 Checks that tyvars are used properly. This includes checking
  68 for undefined tyvars, and tyvars in contexts that are ambiguous.
  69 (Some of this checking has now been moved to module @TcMonoType@,
  70 since we don't have functional dependency information at this point.)
  71 \item
  72 Checks that all variable occurences are defined.
  73 \item
  74 Checks the @(..)@ etc constraints in the export list.
  75 \end{enumerate}
  76
  77
  78 \begin{code}
  79 -- brings the binders of the group into scope in the appropriate places;
  80 -- does NOT assume that anything is in scope already
  81 --
  82 -- the Bool determines whether (True) names in the group shadow existing
  83 -- Unquals in the global environment (used in Template Haskell) or
  84 -- (False) whether duplicates are reported as an error
  85 rnSrcDecls :: Bool -> HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name)
  86
  87 rnSrcDecls shadowP group@(HsGroup {hs_valds  = val_decls,
  88                                    hs_tyclds = tycl_decls,
  89                                    hs_instds = inst_decls,
  90                                    hs_derivds = deriv_decls,
  91                                    hs_fixds  = fix_decls,
  92                                    hs_depds  = deprec_decls,
  93                                    hs_fords  = foreign_decls,
  94                                    hs_defds  = default_decls,
  95                                    hs_ruleds = rule_decls,
  96                                    hs_docs   = docs })
  97  = do {
  98    -- (A) Process the fixity declarations, creating a mapping from
  99    --     FastStrings to FixItems.
 100    --     Also checks for duplcates.
 101    local_fix_env <- makeMiniFixityEnv fix_decls;
 102
 103    -- (B) Bring top level binders (and their fixities) into scope,
 104    --     except for the value bindings, which get brought in below.
 105    inNewEnv (importsFromLocalDecls shadowP group local_fix_env) $ \ tcg_env -> do {
 106
 107    failIfErrsM ; -- No point in continuing if (say) we have duplicate declarations
 108
 109    -- (C) Extract the mapping from data constructors to field names and
 110    --     extend the record field env.
 111    --     This depends on the data constructors and field names being in
 112    --     scope from (B) above
 113    inNewEnv (extendRecordFieldEnv tycl_decls) $ \ tcg_env -> do {
 114
 115    -- (D) Rename the left-hand sides of the value bindings.
 116    --     This depends on everything from (B) being in scope,
 117    --     and on (C) for resolving record wild cards.
 118    --     It uses the fixity env from (A) to bind fixities for view patterns.
 119    new_lhs <- rnTopBindsLHS local_fix_env val_decls ;
 120    -- bind the LHSes (and their fixities) in the global rdr environment
 121    let { lhs_binders = map unLoc $ collectHsValBinders new_lhs;
 122          lhs_avails = map Avail lhs_binders
 123        } ;
 124    inNewEnv (extendRdrEnvRn shadowP (tcg_rdr_env tcg_env, tcg_fix_env tcg_env)
 125                              lhs_avails local_fix_env
 126               >>= \ (new_rdr_env, new_fix_env) ->
 127                          return (tcg_env { tcg_rdr_env = new_rdr_env,
 128                                            tcg_fix_env = new_fix_env
 129                                          })) $ \tcg_env -> do {
 130
 131    --  Now everything is in scope, as the remaining renaming assumes.
 132
 133    -- (E) Rename type and class decls
 134    --     (note that value LHSes need to be in scope for default methods)
 135    --
 136    -- You might think that we could build proper def/use information
 137    -- for type and class declarations, but they can be involved
 138    -- in mutual recursion across modules, and we only do the SCC
 139    -- analysis for them in the type checker.
 140    -- So we content ourselves with gathering uses only; that
 141    -- means we'll only report a declaration as unused if it isn't
 142    -- mentioned at all.  Ah well.
 143    traceRn (text "Start rnTyClDecls") ;
 144    (rn_tycl_decls, src_fvs1) <- rnList rnTyClDecl tycl_decls ;
 145
 146    -- (F) Rename Value declarations right-hand sides
 147    traceRn (text "Start rnmono") ;
 148    (rn_val_decls, bind_dus) <- rnTopBindsRHS lhs_binders new_lhs ;
 149    traceRn (text "finish rnmono" <+> ppr rn_val_decls) ;
 150
 151    -- (G) Rename Fixity and deprecations
 152
 153    -- rename fixity declarations and error if we try to
 154    -- fix something from another module (duplicates were checked in (A))
 155    rn_fix_decls                 <- rnSrcFixityDecls fix_decls ;
 156    -- rename deprec decls;
 157    -- check for duplicates and ensure that deprecated things are defined locally
 158    -- at the moment, we don't keep these around past renaming
 159    rn_deprecs <- rnSrcDeprecDecls deprec_decls ;
 160
 161    -- (H) Rename Everything else
 162
 163    (rn_inst_decls,    src_fvs2) <- rnList rnSrcInstDecl   inst_decls ;
 164    (rn_rule_decls,    src_fvs3) <- rnList rnHsRuleDecl    rule_decls ;
 165    (rn_foreign_decls, src_fvs4) <- rnList rnHsForeignDecl foreign_decls ;
 166    (rn_default_decls, src_fvs5) <- rnList rnDefaultDecl   default_decls ;
 167    (rn_deriv_decls,   src_fvs6) <- rnList rnSrcDerivDecl  deriv_decls ;
 168       -- Haddock docs; no free vars
 169    rn_docs <- mapM (wrapLocM rnDocDecl) docs ;
 170
 171    -- (I) Compute the results and return
 172    let {rn_group = HsGroup { hs_valds  = rn_val_decls,
 173                                 hs_tyclds = rn_tycl_decls,
 174                                 hs_instds = rn_inst_decls,
 175                              hs_derivds = rn_deriv_decls,
 176                                 hs_fixds  = rn_fix_decls,
 177                                 hs_depds  = [], -- deprecs are returned in the tcg_env (see below)
 178                                              -- not in the HsGroup
 179                                 hs_fords  = rn_foreign_decls,
 180                                 hs_defds  = rn_default_decls,
 181                                 hs_ruleds = rn_rule_decls,
 182                              hs_docs   = rn_docs } ;
 183
 184         other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs6, src_fvs3,
 185                              src_fvs4, src_fvs5] ;
 186         src_dus = bind_dus `plusDU` usesOnly other_fvs;
 187                 -- Note: src_dus will contain *uses* for locally-defined types
 188                 -- and classes, but no *defs* for them.  (Because rnTyClDecl
 189                 -- returns only the uses.)  This is a little
 190                 -- surprising but it doesn't actually matter at all.
 191
 192        final_tcg_env = let tcg_env' = (tcg_env `addTcgDUs` src_dus)
 193                        in -- we return the deprecs in the env, not in the HsGroup above
 194                          tcg_env' { tcg_deprecs = tcg_deprecs tcg_env' `plusDeprecs` rn_deprecs };
 195        } ;
 196
 197    traceRn (text "finish rnSrc" <+> ppr rn_group) ;
 198    traceRn (text "finish Dus" <+> ppr src_dus ) ;
 199    return (final_tcg_env , rn_group)
 200                     }}}}
 201
 202 -- some utils because we do this a bunch above
 203 -- compute and install the new env
 204 inNewEnv :: TcM TcGblEnv -> (TcGblEnv -> TcM a) -> TcM a
 205 inNewEnv env cont = do e <- env
 206                        setGblEnv e $ cont e
 207
 208 rnTyClDecls :: [LTyClDecl RdrName] -> RnM [LTyClDecl Name]
 209 -- Used for external core
 210 rnTyClDecls tycl_decls = do  (decls', fvs) <- rnList rnTyClDecl tycl_decls
 211                              return decls'
 212
 213 addTcgDUs :: TcGblEnv -> DefUses -> TcGblEnv
 214 addTcgDUs tcg_env dus = tcg_env { tcg_dus = tcg_dus tcg_env `plusDU` dus }
 215
 216 rnList :: (a -> RnM (b, FreeVars)) -> [Located a] -> RnM ([Located b], FreeVars)
 217 rnList f xs = mapFvRn (wrapLocFstM f) xs
 218 \end{code}
 219
 220
 221 %*********************************************************
 222 %*                                                       *
 223         HsDoc stuff
 224 %*                                                       *
 225 %*********************************************************
 226
 227 \begin{code}
 228 rnDocDecl :: DocDecl RdrName -> RnM (DocDecl Name)
 229 rnDocDecl (DocCommentNext doc) = do
 230   rn_doc <- rnHsDoc doc
 231   return (DocCommentNext rn_doc)
 232 rnDocDecl (DocCommentPrev doc) = do
 233   rn_doc <- rnHsDoc doc
 234   return (DocCommentPrev rn_doc)
 235 rnDocDecl (DocCommentNamed str doc) = do
 236   rn_doc <- rnHsDoc doc
 237   return (DocCommentNamed str rn_doc)
 238 rnDocDecl (DocGroup lev doc) = do
 239   rn_doc <- rnHsDoc doc
 240   return (DocGroup lev rn_doc)
 241 \end{code}
 242
 243
 244 %*********************************************************
 245 %*                                                       *
 246         Source-code fixity declarations
 247 %*                                                       *
 248 %*********************************************************
 249
 250 \begin{code}
 251 rnSrcFixityDecls :: [LFixitySig RdrName] -> RnM [LFixitySig Name]
 252 -- Rename the fixity decls, so we can put
 253 -- the renamed decls in the renamed syntax tree
 254 -- Errors if the thing being fixed is not defined locally.
 255 rnSrcFixityDecls fix_decls
 256   = do fix_decls <- mapM rn_decl fix_decls
 257        return (concat fix_decls)
 258   where
 259     rn_decl :: LFixitySig RdrName -> RnM [LFixitySig Name]
 260         -- GHC extension: look up both the tycon and data con
 261         -- for con-like things; hence returning a list
 262         -- If neither are in scope, report an error; otherwise
 263         -- add both to the fixity env
 264     rn_decl (L loc (FixitySig (L name_loc rdr_name) fixity))
 265       = setSrcSpan name_loc $
 266                     -- this lookup will fail if the definition isn't local
 267         do names <- lookupLocalDataTcNames rdr_name
 268            return [ L loc (FixitySig (L name_loc name) fixity)
 269                     | name <- names ]
 270 \end{code}
 271
 272
 273 %*********************************************************
 274 %*                                                       *
 275         Source-code deprecations declarations
 276 %*                                                       *
 277 %*********************************************************
 278
 279 Check that the deprecated names are defined, are defined locally, and
 280 that there are no duplicate deprecations.
 281
 282 It's only imported deprecations, dealt with in RnIfaces, that we
 283 gather them together.
 284
 285 \begin{code}
 286 -- checks that the deprecations are defined locally, and that there are no duplicates
 287 rnSrcDeprecDecls :: [LDeprecDecl RdrName] -> RnM Deprecations
 288 rnSrcDeprecDecls []
 289   = returnM NoDeprecs
 290
 291 rnSrcDeprecDecls decls
 292   = do { -- check for duplicates
 293        ; mappM_ (\ (lrdr:lrdr':_) -> addLocErr lrdr (dupDeprecDecl lrdr')) deprec_rdr_dups
 294        ; mappM (addLocM rn_deprec) decls        `thenM` \ pairs_s ->
 295          returnM (DeprecSome ((concat pairs_s))) }
 296  where
 297    rn_deprec (Deprecation rdr_name txt)
 298        -- ensures that the names are defined locally
 299      = lookupLocalDataTcNames rdr_name  `thenM` \ names ->
 300        returnM [(nameOccName name, txt) | name <- names]
 301
 302    -- look for duplicates among the OccNames;
 303    -- we check that the names are defined above
 304    -- invt: the lists returned by findDupsEq always have at least two elements
 305    deprec_rdr_dups = findDupsEq (\ x -> \ y -> rdrNameOcc (unLoc x) == rdrNameOcc (unLoc y))
 306                      (map (\ (L loc (Deprecation rdr_name _)) -> L loc rdr_name) decls)
 307
 308 dupDeprecDecl (L loc _) rdr_name
 309   = vcat [ptext SLIT("Multiple deprecation declarations for") <+> quotes (ppr rdr_name),
 310           ptext SLIT("also at ") <+> ppr loc]
 311
 312 \end{code}
 313
 314 %*********************************************************
 315 %*                                                      *
 316 \subsection{Source code declarations}
 317 %*                                                      *
 318 %*********************************************************
 319
 320 \begin{code}
 321 rnDefaultDecl (DefaultDecl tys)
 322   = mapFvRn (rnHsTypeFVs doc_str) tys   `thenM` \ (tys', fvs) ->
 323     returnM (DefaultDecl tys', fvs)
 324   where
 325     doc_str = text "In a `default' declaration"
 326 \end{code}
 327
 328 %*********************************************************
 329 %*                                                      *
 330 \subsection{Foreign declarations}
 331 %*                                                      *
 332 %*********************************************************
 333
 334 \begin{code}
 335 rnHsForeignDecl (ForeignImport name ty spec)
 336   = lookupLocatedTopBndrRn name         `thenM` \ name' ->
 337     rnHsTypeFVs (fo_decl_msg name) ty   `thenM` \ (ty', fvs) ->
 338     returnM (ForeignImport name' ty' spec, fvs)
 339
 340 rnHsForeignDecl (ForeignExport name ty spec)
 341   = lookupLocatedOccRn name             `thenM` \ name' ->
 342     rnHsTypeFVs (fo_decl_msg name) ty   `thenM` \ (ty', fvs) ->
 343     returnM (ForeignExport name' ty' spec, fvs `addOneFV` unLoc name')
 344         -- NB: a foreign export is an *occurrence site* for name, so
 345         --     we add it to the free-variable list.  It might, for example,
 346         --     be imported from another module
 347
 348 fo_decl_msg name = ptext SLIT("In the foreign declaration for") <+> ppr name
 349 \end{code}
 350
 351
 352 %*********************************************************
 353 %*                                                      *
 354 \subsection{Instance declarations}
 355 %*                                                      *
 356 %*********************************************************
 357
 358 \begin{code}
 359 rnSrcInstDecl (InstDecl inst_ty mbinds uprags ats)
 360         -- Used for both source and interface file decls
 361   = rnHsSigType (text "an instance decl") inst_ty       `thenM` \ inst_ty' ->
 362
 363         -- Rename the bindings
 364         -- The typechecker (not the renamer) checks that all
 365         -- the bindings are for the right class
 366     let
 367         meth_doc    = text "In the bindings in an instance declaration"
 368         meth_names  = collectHsBindLocatedBinders mbinds
 369         (inst_tyvars, _, cls,_) = splitHsInstDeclTy (unLoc inst_ty')
 370     in
 371     checkDupRdrNames meth_doc meth_names        `thenM_`
 372         -- Check that the same method is not given twice in the
 373         -- same instance decl   instance C T where
 374         --                            f x = ...
 375         --                            g y = ...
 376         --                            f x = ...
 377         -- We must use checkDupRdrNames because the Name of the
 378         -- method is the Name of the class selector, whose SrcSpan
 379         -- points to the class declaration
 380
 381     extendTyVarEnvForMethodBinds inst_tyvars (
 382         -- (Slightly strangely) the forall-d tyvars scope over
 383         -- the method bindings too
 384         rnMethodBinds cls (\n->[])      -- No scoped tyvars
 385                       [] mbinds
 386     )                                           `thenM` \ (mbinds', meth_fvs) ->
 387         -- Rename the associated types
 388         -- The typechecker (not the renamer) checks that all
 389         -- the declarations are for the right class
 390     let
 391         at_doc   = text "In the associated types of an instance declaration"
 392         at_names = map (head . tyClDeclNames . unLoc) ats
 393     in
 394     checkDupRdrNames at_doc at_names            `thenM_`
 395         -- See notes with checkDupRdrNames for methods, above
 396
 397     rnATInsts ats                               `thenM` \ (ats', at_fvs) ->
 398
 399         -- Rename the prags and signatures.
 400         -- Note that the type variables are not in scope here,
 401         -- so that      instance Eq a => Eq (T a) where
 402         --                      {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
 403         -- works OK.
 404         --
 405         -- But the (unqualified) method names are in scope
 406     let
 407         binders = collectHsBindBinders mbinds'
 408         ok_sig  = okInstDclSig (mkNameSet binders)
 409     in
 410     bindLocalNames binders (renameSigs ok_sig uprags)   `thenM` \ uprags' ->
 411
 412     returnM (InstDecl inst_ty' mbinds' uprags' ats',
 413              meth_fvs `plusFV` at_fvs
 414                       `plusFV` hsSigsFVs uprags'
 415                       `plusFV` extractHsTyNames inst_ty')
 416              -- We return the renamed associated data type declarations so
 417              -- that they can be entered into the list of type declarations
 418              -- for the binding group, but we also keep a copy in the instance.
 419              -- The latter is needed for well-formedness checks in the type
 420              -- checker (eg, to ensure that all ATs of the instance actually
 421              -- receive a declaration).
 422              -- NB: Even the copies in the instance declaration carry copies of
 423              --     the instance context after renaming.  This is a bit
 424              --     strange, but should not matter (and it would be more work
 425              --     to remove the context).
 426 \end{code}
 427
 428 Renaming of the associated types in instances.
 429
 430 \begin{code}
 431 rnATInsts :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
 432 rnATInsts atDecls = rnList rnATInst atDecls
 433   where
 434     rnATInst tydecl@TyData     {} = rnTyClDecl tydecl
 435     rnATInst tydecl@TySynonym  {} = rnTyClDecl tydecl
 436     rnATInst tydecl               =
 437       pprPanic "RnSource.rnATInsts: invalid AT instance"
 438                (ppr (tcdName tydecl))
 439 \end{code}
 440
 441 For the method bindings in class and instance decls, we extend the
 442 type variable environment iff -fglasgow-exts
 443
 444 \begin{code}
 445 extendTyVarEnvForMethodBinds tyvars thing_inside
 446   = do  { scoped_tvs <- doptM Opt_ScopedTypeVariables
 447         ; if scoped_tvs then
 448                 extendTyVarEnvFVRn (map hsLTyVarName tyvars) thing_inside
 449           else
 450                 thing_inside }
 451 \end{code}
 452
 453 %*********************************************************
 454 %*                                                      *
 455 \subsection{Stand-alone deriving declarations}
 456 %*                                                      *
 457 %*********************************************************
 458
 459 \begin{code}
 460 rnSrcDerivDecl :: DerivDecl RdrName -> RnM (DerivDecl Name, FreeVars)
 461 rnSrcDerivDecl (DerivDecl ty)
 462   = do ty' <- rnLHsType (text "a deriving decl") ty
 463        let fvs = extractHsTyNames ty'
 464        return (DerivDecl ty', fvs)
 465 \end{code}
 466
 467 %*********************************************************
 468 %*                                                      *
 469 \subsection{Rules}
 470 %*                                                      *
 471 %*********************************************************
 472
 473 \begin{code}
 474 rnHsRuleDecl (HsRule rule_name act vars lhs fv_lhs rhs fv_rhs)
 475   = bindPatSigTyVarsFV (collectRuleBndrSigTys vars)     $
 476
 477     bindLocatedLocalsFV doc (map get_var vars)          $ \ ids ->
 478     mapFvRn rn_var (vars `zip` ids)             `thenM` \ (vars', fv_vars) ->
 479
 480     rnLExpr lhs                                 `thenM` \ (lhs', fv_lhs') ->
 481     rnLExpr rhs                                 `thenM` \ (rhs', fv_rhs') ->
 482
 483     checkValidRule rule_name ids lhs' fv_lhs'   `thenM_`
 484
 485     returnM (HsRule rule_name act vars' lhs' fv_lhs' rhs' fv_rhs',
 486              fv_vars `plusFV` fv_lhs' `plusFV` fv_rhs')
 487   where
 488     doc = text "In the transformation rule" <+> ftext rule_name
 489
 490     get_var (RuleBndr v)      = v
 491     get_var (RuleBndrSig v _) = v
 492
 493     rn_var (RuleBndr (L loc v), id)
 494         = returnM (RuleBndr (L loc id), emptyFVs)
 495     rn_var (RuleBndrSig (L loc v) t, id)
 496         = rnHsTypeFVs doc t     `thenM` \ (t', fvs) ->
 497           returnM (RuleBndrSig (L loc id) t', fvs)
 498
 499 badRuleVar name var
 500   = sep [ptext SLIT("Rule") <+> doubleQuotes (ftext name) <> colon,
 501          ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
 502                 ptext SLIT("does not appear on left hand side")]
 503 \end{code}
 504
 505 Note [Rule LHS validity checking]
 506 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 507 Check the shape of a transformation rule LHS.  Currently we only allow
 508 LHSs of the form @(f e1 .. en)@, where @f@ is not one of the
 509 @forall@'d variables.
 510
 511 We used restrict the form of the 'ei' to prevent you writing rules
 512 with LHSs with a complicated desugaring (and hence unlikely to match);
 513 (e.g. a case expression is not allowed: too elaborate.)
 514
 515 But there are legitimate non-trivial args ei, like sections and
 516 lambdas.  So it seems simmpler not to check at all, and that is why
 517 check_e is commented out.
 518
 519 \begin{code}
 520 checkValidRule rule_name ids lhs' fv_lhs'
 521   = do  {       -- Check for the form of the LHS
 522           case (validRuleLhs ids lhs') of
 523                 Nothing  -> return ()
 524                 Just bad -> failWithTc (badRuleLhsErr rule_name lhs' bad)
 525
 526                 -- Check that LHS vars are all bound
 527         ; let bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs')]
 528         ; mappM (addErr . badRuleVar rule_name) bad_vars }
 529
 530 validRuleLhs :: [Name] -> LHsExpr Name -> Maybe (HsExpr Name)
 531 -- Nothing => OK
 532 -- Just e  => Not ok, and e is the offending expression
 533 validRuleLhs foralls lhs
 534   = checkl lhs
 535   where
 536     checkl (L loc e) = check e
 537
 538     check (OpApp e1 op _ e2)              = checkl op `seqMaybe` checkl_e e1 `seqMaybe` checkl_e e2
 539     check (HsApp e1 e2)                   = checkl e1 `seqMaybe` checkl_e e2
 540     check (HsVar v) | v `notElem` foralls = Nothing
 541     check other                           = Just other  -- Failure
 542
 543         -- Check an argument
 544     checkl_e (L loc e) = Nothing        -- Was (check_e e); see Note [Rule LHS validity checking]
 545
 546 {-      Commented out; see Note [Rule LHS validity checking] above
 547     check_e (HsVar v)     = Nothing
 548     check_e (HsPar e)     = checkl_e e
 549     check_e (HsLit e)     = Nothing
 550     check_e (HsOverLit e) = Nothing
 551
 552     check_e (OpApp e1 op _ e2)   = checkl_e e1 `seqMaybe` checkl_e op `seqMaybe` checkl_e e2
 553     check_e (HsApp e1 e2)        = checkl_e e1 `seqMaybe` checkl_e e2
 554     check_e (NegApp e _)         = checkl_e e
 555     check_e (ExplicitList _ es)  = checkl_es es
 556     check_e (ExplicitTuple es _) = checkl_es es
 557     check_e other                = Just other   -- Fails
 558
 559     checkl_es es = foldr (seqMaybe . checkl_e) Nothing es
 560 -}
 561
 562 badRuleLhsErr name lhs bad_e
 563   = sep [ptext SLIT("Rule") <+> ftext name <> colon,
 564          nest 4 (vcat [ptext SLIT("Illegal expression:") <+> ppr bad_e,
 565                        ptext SLIT("in left-hand side:") <+> ppr lhs])]
 566     $$
 567     ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
 568 \end{code}
 569
 570
 571 %*********************************************************
 572 %*                                                      *
 573 \subsection{Type, class and iface sig declarations}
 574 %*                                                      *
 575 %*********************************************************
 576
 577 @rnTyDecl@ uses the `global name function' to create a new type
 578 declaration in which local names have been replaced by their original
 579 names, reporting any unknown names.
 580
 581 Renaming type variables is a pain. Because they now contain uniques,
 582 it is necessary to pass in an association list which maps a parsed
 583 tyvar to its @Name@ representation.
 584 In some cases (type signatures of values),
 585 it is even necessary to go over the type first
 586 in order to get the set of tyvars used by it, make an assoc list,
 587 and then go over it again to rename the tyvars!
 588 However, we can also do some scoping checks at the same time.
 589
 590 \begin{code}
 591 rnTyClDecl (ForeignType {tcdLName = name, tcdFoType = fo_type, tcdExtName = ext_name})
 592   = lookupLocatedTopBndrRn name         `thenM` \ name' ->
 593     returnM (ForeignType {tcdLName = name', tcdFoType = fo_type, tcdExtName = ext_name},
 594              emptyFVs)
 595
 596 -- all flavours of type family declarations ("type family", "newtype fanily",
 597 -- and "data family")
 598 rnTyClDecl (tydecl@TyFamily {}) =
 599   rnFamily tydecl bindTyVarsRn
 600
 601 -- "data", "newtype", "data instance, and "newtype instance" declarations
 602 rnTyClDecl (tydecl@TyData {tcdND = new_or_data, tcdCtxt = context,
 603                            tcdLName = tycon, tcdTyVars = tyvars,
 604                            tcdTyPats = typatsMaybe, tcdCons = condecls,
 605                            tcdKindSig = sig, tcdDerivs = derivs})
 606   | is_vanilla            -- Normal Haskell data type decl
 607   = ASSERT( isNothing sig )     -- In normal H98 form, kind signature on the
 608                                 -- data type is syntactically illegal
 609     bindTyVarsRn data_doc tyvars                $ \ tyvars' ->
 610     do  { tycon' <- if isFamInstDecl tydecl
 611                     then lookupLocatedOccRn     tycon -- may be imported family
 612                     else lookupLocatedTopBndrRn tycon
 613         ; context' <- rnContext data_doc context
 614         ; typats' <- rnTyPats data_doc typatsMaybe
 615         ; (derivs', deriv_fvs) <- rn_derivs derivs
 616         ; condecls' <- rnConDecls (unLoc tycon') condecls
 617                 -- No need to check for duplicate constructor decls
 618                 -- since that is done by RnNames.extendRdrEnvRn
 619         ; returnM (TyData {tcdND = new_or_data, tcdCtxt = context',
 620                            tcdLName = tycon', tcdTyVars = tyvars',
 621                            tcdTyPats = typats', tcdKindSig = Nothing,
 622                            tcdCons = condecls', tcdDerivs = derivs'},
 623                    delFVs (map hsLTyVarName tyvars')    $
 624                    extractHsCtxtTyNames context'        `plusFV`
 625                    plusFVs (map conDeclFVs condecls')   `plusFV`
 626                    deriv_fvs                            `plusFV`
 627                    (if isFamInstDecl tydecl
 628                    then unitFV (unLoc tycon')   -- type instance => use
 629                    else emptyFVs))
 630         }
 631
 632   | otherwise             -- GADT
 633   = ASSERT( none typatsMaybe )    -- GADTs cannot have type patterns for now
 634     do  { tycon' <- if isFamInstDecl tydecl
 635                     then lookupLocatedOccRn     tycon -- may be imported family
 636                     else lookupLocatedTopBndrRn tycon
 637         ; checkTc (null (unLoc context)) (badGadtStupidTheta tycon)
 638         ; tyvars' <- bindTyVarsRn data_doc tyvars
 639                                   (\ tyvars' -> return tyvars')
 640                 -- For GADTs, the type variables in the declaration
 641                 -- do not scope over the constructor signatures
 642                 --      data T a where { T1 :: forall b. b-> b }
 643         ; (derivs', deriv_fvs) <- rn_derivs derivs
 644         ; condecls' <- rnConDecls (unLoc tycon') condecls
 645                 -- No need to check for duplicate constructor decls
 646                 -- since that is done by RnNames.extendRdrEnvRn
 647         ; returnM (TyData {tcdND = new_or_data, tcdCtxt = noLoc [],
 648                            tcdLName = tycon', tcdTyVars = tyvars',
 649                            tcdTyPats = Nothing, tcdKindSig = sig,
 650                            tcdCons = condecls', tcdDerivs = derivs'},
 651                    plusFVs (map conDeclFVs condecls') `plusFV`
 652                    deriv_fvs                          `plusFV`
 653                    (if isFamInstDecl tydecl
 654                    then unitFV (unLoc tycon')   -- type instance => use
 655                    else emptyFVs))
 656         }
 657   where
 658     is_vanilla = case condecls of       -- Yuk
 659                      []                    -> True
 660                      L _ (ConDecl { con_res = ResTyH98 }) : _  -> True
 661                      other                 -> False
 662
 663     none Nothing   = True
 664     none (Just []) = True
 665     none _         = False
 666
 667     data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
 668     con_names = map con_names_helper condecls
 669
 670     con_names_helper (L _ c) = con_name c
 671
 672     rn_derivs Nothing   = returnM (Nothing, emptyFVs)
 673     rn_derivs (Just ds) = rnLHsTypes data_doc ds        `thenM` \ ds' ->
 674                           returnM (Just ds', extractHsTyNames_s ds')
 675
 676 -- "type" and "type instance" declarations
 677 rnTyClDecl tydecl@(TySynonym {tcdLName = name, tcdTyVars = tyvars,
 678                               tcdTyPats = typatsMaybe, tcdSynRhs = ty})
 679   = bindTyVarsRn syn_doc tyvars                 $ \ tyvars' ->
 680     do { name' <- if isFamInstDecl tydecl
 681                   then lookupLocatedOccRn     name -- may be imported family
 682                   else lookupLocatedTopBndrRn name
 683        ; typats' <- rnTyPats syn_doc typatsMaybe
 684        ; (ty', fvs) <- rnHsTypeFVs syn_doc ty
 685        ; returnM (TySynonym {tcdLName = name', tcdTyVars = tyvars',
 686                              tcdTyPats = typats', tcdSynRhs = ty'},
 687                   delFVs (map hsLTyVarName tyvars') $
 688                   fvs                         `plusFV`
 689                    (if isFamInstDecl tydecl
 690                    then unitFV (unLoc name')    -- type instance => use
 691                    else emptyFVs))
 692        }
 693   where
 694     syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
 695
 696 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname,
 697                        tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
 698                        tcdMeths = mbinds, tcdATs = ats, tcdDocs = docs})
 699   = do  { cname' <- lookupLocatedTopBndrRn cname
 700
 701         -- Tyvars scope over superclass context and method signatures
 702         ; (tyvars', context', fds', ats', ats_fvs, sigs')
 703             <- bindTyVarsRn cls_doc tyvars $ \ tyvars' -> do
 704              { context' <- rnContext cls_doc context
 705              ; fds' <- rnFds cls_doc fds
 706              ; (ats', ats_fvs) <- rnATs ats
 707              ; sigs' <- renameSigs okClsDclSig sigs
 708              ; return   (tyvars', context', fds', ats', ats_fvs, sigs') }
 709
 710         -- No need to check for duplicate associated type decls
 711         -- since that is done by RnNames.extendRdrEnvRn
 712
 713         -- Check the signatures
 714         -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
 715         ; let sig_rdr_names_w_locs = [op | L _ (TypeSig op _) <- sigs]
 716         ; checkDupRdrNames sig_doc sig_rdr_names_w_locs
 717                 -- Typechecker is responsible for checking that we only
 718                 -- give default-method bindings for things in this class.
 719                 -- The renamer *could* check this for class decls, but can't
 720                 -- for instance decls.
 721
 722         -- The newLocals call is tiresome: given a generic class decl
 723         --      class C a where
 724         --        op :: a -> a
 725         --        op {| x+y |} (Inl a) = ...
 726         --        op {| x+y |} (Inr b) = ...
 727         --        op {| a*b |} (a*b)   = ...
 728         -- we want to name both "x" tyvars with the same unique, so that they are
 729         -- easy to group together in the typechecker.
 730         ; (mbinds', meth_fvs)
 731             <- extendTyVarEnvForMethodBinds tyvars' $ do
 732             { name_env <- getLocalRdrEnv
 733             ; let meth_rdr_names_w_locs = collectHsBindLocatedBinders mbinds
 734                   gen_rdr_tyvars_w_locs = [ tv | tv <- extractGenericPatTyVars mbinds,
 735                                                  not (unLoc tv `elemLocalRdrEnv` name_env) ]
 736                 -- No need to check for duplicate method signatures
 737                 -- since that is done by RnNames.extendRdrEnvRn
 738                 -- and the methods are already in scope
 739             ; gen_tyvars <- newLocalsRn gen_rdr_tyvars_w_locs
 740             ; rnMethodBinds (unLoc cname') (mkSigTvFn sigs') gen_tyvars mbinds }
 741
 742   -- Haddock docs
 743         ; docs' <- mapM (wrapLocM rnDocDecl) docs
 744
 745         ; return (ClassDecl { tcdCtxt = context', tcdLName = cname',
 746                               tcdTyVars = tyvars', tcdFDs = fds', tcdSigs = sigs',
 747                               tcdMeths = mbinds', tcdATs = ats', tcdDocs = docs'},
 748
 749                   delFVs (map hsLTyVarName tyvars')     $
 750                   extractHsCtxtTyNames context'         `plusFV`
 751                   plusFVs (map extractFunDepNames (map unLoc fds'))  `plusFV`
 752                   hsSigsFVs sigs'                       `plusFV`
 753                   meth_fvs                              `plusFV`
 754                   ats_fvs) }
 755   where
 756     meth_doc = text "In the default-methods for class"  <+> ppr cname
 757     cls_doc  = text "In the declaration for class"      <+> ppr cname
 758     sig_doc  = text "In the signatures for class"       <+> ppr cname
 759     at_doc   = text "In the associated types for class" <+> ppr cname
 760
 761 badGadtStupidTheta tycon
 762   = vcat [ptext SLIT("No context is allowed on a GADT-style data declaration"),
 763           ptext SLIT("(You can put a context on each contructor, though.)")]
 764 \end{code}
 765
 766 %*********************************************************
 767 %*                                                      *
 768 \subsection{Support code for type/data declarations}
 769 %*                                                      *
 770 %*********************************************************
 771
 772 \begin{code}
 773 -- Although, we are processing type patterns here, all type variables will
 774 -- already be in scope (they are the same as in the 'tcdTyVars' field of the
 775 -- type declaration to which these patterns belong)
 776 --
 777 rnTyPats :: SDoc -> Maybe [LHsType RdrName] -> RnM (Maybe [LHsType Name])
 778 rnTyPats _   Nothing       = return Nothing
 779 rnTyPats doc (Just typats) = liftM Just $ rnLHsTypes doc typats
 780
 781 rnConDecls :: Name -> [LConDecl RdrName] -> RnM [LConDecl Name]
 782 rnConDecls tycon condecls
 783   = mappM (wrapLocM rnConDecl) condecls
 784
 785 rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
 786 rnConDecl (ConDecl name expl tvs cxt details res_ty mb_doc)
 787   = do  { addLocM checkConName name
 788
 789         ; new_name <- lookupLocatedTopBndrRn name
 790         ; name_env <- getLocalRdrEnv
 791
 792         -- For H98 syntax, the tvs are the existential ones
 793         -- For GADT syntax, the tvs are all the quantified tyvars
 794         -- Hence the 'filter' in the ResTyH98 case only
 795         ; let not_in_scope  = not . (`elemLocalRdrEnv` name_env) . unLoc
 796               arg_tys       = hsConDeclArgTys details
 797               implicit_tvs  = case res_ty of
 798                                 ResTyH98 -> filter not_in_scope $
 799                                                 get_rdr_tvs arg_tys
 800                                 ResTyGADT ty -> get_rdr_tvs (ty : arg_tys)
 801               tvs' = case expl of
 802                         Explicit -> tvs
 803                         Implicit -> userHsTyVarBndrs implicit_tvs
 804
 805         ; mb_doc' <- rnMbLHsDoc mb_doc
 806
 807         ; bindTyVarsRn doc tvs' $ \new_tyvars -> do
 808         { new_context <- rnContext doc cxt
 809         ; new_details <- rnConDeclDetails doc details
 810         ; (new_details', new_res_ty)  <- rnConResult doc new_details res_ty
 811         ; return (ConDecl new_name expl new_tyvars new_context new_details' new_res_ty mb_doc') }}
 812  where
 813     doc = text "In the definition of data constructor" <+> quotes (ppr name)
 814     get_rdr_tvs tys  = extractHsRhoRdrTyVars cxt (noLoc (HsTupleTy Boxed tys))
 815
 816 rnConResult _ details ResTyH98 = return (details, ResTyH98)
 817
 818 rnConResult doc details (ResTyGADT ty) = do
 819     ty' <- rnHsSigType doc ty
 820     let (arg_tys, res_ty) = splitHsFunType ty'
 821         -- We can split it up, now the renamer has dealt with fixities
 822     case details of
 823         PrefixCon _xs -> ASSERT( null _xs ) return (PrefixCon arg_tys, ResTyGADT res_ty)
 824         RecCon fields -> return (details, ResTyGADT ty')
 825         InfixCon {}   -> panic "rnConResult"
 826
 827 rnConDeclDetails doc (PrefixCon tys)
 828   = mappM (rnLHsType doc) tys   `thenM` \ new_tys  ->
 829     returnM (PrefixCon new_tys)
 830
 831 rnConDeclDetails doc (InfixCon ty1 ty2)
 832   = rnLHsType doc ty1           `thenM` \ new_ty1 ->
 833     rnLHsType doc ty2           `thenM` \ new_ty2 ->
 834     returnM (InfixCon new_ty1 new_ty2)
 835
 836 rnConDeclDetails doc (RecCon fields)
 837   = do  { new_fields <- mappM (rnField doc) fields
 838                 -- No need to check for duplicate fields
 839                 -- since that is done by RnNames.extendRdrEnvRn
 840         ; return (RecCon new_fields) }
 841
 842 rnField doc (ConDeclField name ty haddock_doc)
 843   = lookupLocatedTopBndrRn name `thenM` \ new_name ->
 844     rnLHsType doc ty            `thenM` \ new_ty ->
 845     rnMbLHsDoc haddock_doc      `thenM` \ new_haddock_doc ->
 846     returnM (ConDeclField new_name new_ty new_haddock_doc)
 847
 848 -- Rename family declarations
 849 --
 850 -- * This function is parametrised by the routine handling the index
 851 --   variables.  On the toplevel, these are defining occurences, whereas they
 852 --   are usage occurences for associated types.
 853 --
 854 rnFamily :: TyClDecl RdrName
 855          -> (SDoc -> [LHsTyVarBndr RdrName] ->
 856              ([LHsTyVarBndr Name] -> RnM (TyClDecl Name, FreeVars)) ->
 857              RnM (TyClDecl Name, FreeVars))
 858          -> RnM (TyClDecl Name, FreeVars)
 859
 860 rnFamily (tydecl@TyFamily {tcdFlavour = flavour,
 861                            tcdLName = tycon, tcdTyVars = tyvars})
 862         bindIdxVars =
 863       do { checkM (isDataFlavour flavour                      -- for synonyms,
 864                    || not (null tyvars)) $ addErr needOneIdx  -- #indexes >= 1
 865          ; bindIdxVars (family_doc tycon) tyvars $ \tyvars' -> do {
 866          ; tycon' <- lookupLocatedTopBndrRn tycon
 867          ; returnM (TyFamily {tcdFlavour = flavour, tcdLName = tycon',
 868                               tcdTyVars = tyvars', tcdKind = tcdKind tydecl},
 869                     emptyFVs)
 870          } }
 871       where
 872         isDataFlavour DataFamily = True
 873         isDataFlavour _          = False
 874
 875 family_doc tycon = text "In the family declaration for" <+> quotes (ppr tycon)
 876 needOneIdx = text "Type family declarations requires at least one type index"
 877
 878 -- Rename associated type declarations (in classes)
 879 --
 880 -- * This can be family declarations and (default) type instances
 881 --
 882 rnATs :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
 883 rnATs ats = mapFvRn (wrapLocFstM rn_at) ats
 884   where
 885     rn_at (tydecl@TyFamily  {}) = rnFamily tydecl lookupIdxVars
 886     rn_at (tydecl@TySynonym {}) =
 887       do
 888         checkM (isNothing (tcdTyPats tydecl)) $ addErr noPatterns
 889         rnTyClDecl tydecl
 890     rn_at _                      = panic "RnSource.rnATs: invalid TyClDecl"
 891
 892     lookupIdxVars _ tyvars cont =
 893       do { checkForDups tyvars;
 894          ; tyvars' <- mappM lookupIdxVar tyvars
 895          ; cont tyvars'
 896          }
 897     -- Type index variables must be class parameters, which are the only
 898     -- type variables in scope at this point.
 899     lookupIdxVar (L l tyvar) =
 900       do
 901         name' <- lookupOccRn (hsTyVarName tyvar)
 902         return $ L l (replaceTyVarName tyvar name')
 903
 904     -- Type variable may only occur once.
 905     --
 906     checkForDups [] = return ()
 907     checkForDups (L loc tv:ltvs) =
 908       do { setSrcSpan loc $
 909              when (hsTyVarName tv `ltvElem` ltvs) $
 910                addErr (repeatedTyVar tv)
 911          ; checkForDups ltvs
 912          }
 913
 914     rdrName `ltvElem` [] = False
 915     rdrName `ltvElem` (L _ tv:ltvs)
 916       | rdrName == hsTyVarName tv = True
 917       | otherwise                 = rdrName `ltvElem` ltvs
 918
 919 noPatterns = text "Default definition for an associated synonym cannot have"
 920              <+> text "type pattern"
 921
 922 repeatedTyVar tv = ptext SLIT("Illegal repeated type variable") <+>
 923                    quotes (ppr tv)
 924
 925 -- This data decl will parse OK
 926 --      data T = a Int
 927 -- treating "a" as the constructor.
 928 -- It is really hard to make the parser spot this malformation.
 929 -- So the renamer has to check that the constructor is legal
 930 --
 931 -- We can get an operator as the constructor, even in the prefix form:
 932 --      data T = :% Int Int
 933 -- from interface files, which always print in prefix form
 934
 935 checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
 936
 937 badDataCon name
 938    = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
 939 \end{code}
 940
 941
 942 %*********************************************************
 943 %*                                                      *
 944 \subsection{Support code for type/data declarations}
 945 %*                                                      *
 946 %*********************************************************
 947
 948 Get the mapping from constructors to fields for this module.
 949 It's convenient to do this after the data type decls have been renamed
 950 \begin{code}
 951 extendRecordFieldEnv :: [LTyClDecl RdrName] -> TcM TcGblEnv
 952 extendRecordFieldEnv decls
 953   = do  { tcg_env <- getGblEnv
 954         ; field_env' <- foldrM get (tcg_field_env tcg_env) decls
 955         ; return (tcg_env { tcg_field_env = field_env' }) }
 956   where
 957     -- we want to lookup:
 958     --  (a) a datatype constructor
 959     --  (b) a record field
 960     -- knowing that they're from this module.
 961     -- lookupLocatedTopBndrRn does this, because it does a lookupGreLocalRn,
 962     -- which keeps only the local ones.
 963     lookup x = do { x' <- lookupLocatedTopBndrRn x
 964                     ; return $ unLoc x'}
 965
 966     get (L _ (TyData { tcdCons = cons })) env = foldrM get_con env cons
 967     get other                        env = return env
 968
 969     get_con (L _ (ConDecl { con_name = con, con_details = RecCon flds })) env
 970         = do { con' <- lookup con
 971             ; flds' <- mappM lookup (map cd_fld_name flds)
 972             ; return $ extendNameEnv env con' flds' }
 973     get_con other env
 974         = return env
 975 \end{code}
 976
 977 %*********************************************************
 978 %*                                                      *
 979 \subsection{Support code to rename types}
 980 %*                                                      *
 981 %*********************************************************
 982
 983 \begin{code}
 984 rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
 985
 986 rnFds doc fds
 987   = mappM (wrapLocM rn_fds) fds
 988   where
 989     rn_fds (tys1, tys2)
 990       = rnHsTyVars doc tys1             `thenM` \ tys1' ->
 991         rnHsTyVars doc tys2             `thenM` \ tys2' ->
 992         returnM (tys1', tys2')
 993
 994 rnHsTyVars doc tvs  = mappM (rnHsTyvar doc) tvs
 995 rnHsTyvar doc tyvar = lookupOccRn tyvar
 996 \end{code}
 997
 998
 999 %*********************************************************
1000 %*                                                      *
1001                 Splices
1002 %*                                                      *
1003 %*********************************************************
1004
1005 Note [Splices]
1006 ~~~~~~~~~~~~~~
1007 Consider
1008         f = ...
1009         h = ...$(thing "f")...
1010
1011 The splice can expand into literally anything, so when we do dependency
1012 analysis we must assume that it might mention 'f'.  So we simply treat
1013 all locally-defined names as mentioned by any splice.  This is terribly
1014 brutal, but I don't see what else to do.  For example, it'll mean
1015 that every locally-defined thing will appear to be used, so no unused-binding
1016 warnings.  But if we miss the dependency, then we might typecheck 'h' before 'f',
1017 and that will crash the type checker because 'f' isn't in scope.
1018
1019 Currently, I'm not treating a splice as also mentioning every import,
1020 which is a bit inconsistent -- but there are a lot of them.  We might
1021 thereby get some bogus unused-import warnings, but we won't crash the
1022 type checker.  Not very satisfactory really.
1023
1024 \begin{code}
1025 rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
1026 rnSplice (HsSplice n expr)
1027   = do  { checkTH expr "splice"
1028         ; loc  <- getSrcSpanM
1029         ; [n'] <- newLocalsRn [L loc n]
1030         ; (expr', fvs) <- rnLExpr expr
1031
1032         -- Ugh!  See Note [Splices] above
1033         ; lcl_rdr <- getLocalRdrEnv
1034         ; gbl_rdr <- getGlobalRdrEnv
1035         ; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr,
1036                                                     isLocalGRE gre]
1037               lcl_names = mkNameSet (occEnvElts lcl_rdr)
1038
1039         ; return (HsSplice n' expr', fvs `plusFV` lcl_names `plusFV` gbl_names) }
1040
1041 #ifdef GHCI
1042 checkTH e what = returnM ()     -- OK
1043 #else
1044 checkTH e what  -- Raise an error in a stage-1 compiler
1045   = addErr (vcat [ptext SLIT("Template Haskell") <+> text what <+>
1046                   ptext SLIT("illegal in a stage-1 compiler"),
1047                   nest 2 (ppr e)])
1048 #endif
1049 \end{code}