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