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