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