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