[project @ 2005-10-26 12:05:03 by simonpj]

MERGE TO STABLE

Fix two small Template Haskell bugs.

(1) A bug in the renaming of [d| brackets |].  The problem was
that when we renamed the bracket we messed up the name cache, because
the module was still that of the parent module.  Now we set a fake
module before renaming it.

TH_spliceDecl4 is the test.

(2) An expression splice can in principle mention *any* variable,
so the renamer really has to assume that it does when doing depdendency
analysis.  For example
	f = ...
	h = ...$(thing "f")...
The renamer had better not put 'h' before 'f', else the type checker
won't find a defn for 'f' in the type envt.

TH_spliceE5 is the test

diff --git a/ghc/compiler/prelude/PrelNames.lhs b/ghc/compiler/prelude/PrelNames.lhs
index 0d7d558..0d99121 100644 (file)
--- a/ghc/compiler/prelude/PrelNames.lhs
+++ b/ghc/compiler/prelude/PrelNames.lhs
@@ -274,6 +274,7 @@ rOOT_MAIN   = mkModule ":Main"              -- Root module for initialisation
        -- the z-encoded version consistent.
 
 iNTERACTIVE    = mkModule ":Interactive"
+thFAKE         = mkModule ":THFake"
 \end{code}
 
 %************************************************************************

diff --git a/ghc/compiler/rename/RnExpr.lhs b/ghc/compiler/rename/RnExpr.lhs
index c252080..6c8a18c 100644 (file)
--- a/ghc/compiler/rename/RnExpr.lhs
+++ b/ghc/compiler/rename/RnExpr.lhs
@@ -30,12 +30,12 @@ import RnTypes              ( rnHsTypeFVs, rnLPat, rnOverLit, rnPatsAndThen, rnLit,
                          dupFieldErr, checkTupSize )
 import DynFlags                ( DynFlag(..) )
 import BasicTypes      ( FixityDirection(..) )
-import PrelNames       ( hasKey, assertIdKey, assertErrorName,
+import PrelNames       ( thFAKE, hasKey, assertIdKey, assertErrorName,
                          loopAName, choiceAName, appAName, arrAName, composeAName, firstAName,
                          negateName, thenMName, bindMName, failMName )
 import Name            ( Name, nameOccName, nameIsLocalOrFrom )
 import NameSet
-import RdrName         ( RdrName, emptyGlobalRdrEnv, extendLocalRdrEnv, lookupLocalRdrEnv )
+import RdrName         ( RdrName, emptyGlobalRdrEnv, plusGlobalRdrEnv, extendLocalRdrEnv, lookupLocalRdrEnv )
 import LoadIface       ( loadHomeInterface )
 import UnicodeUtil     ( stringToUtf8 )
 import UniqFM          ( isNullUFM )
@@ -546,17 +546,32 @@ rnBracket (TypBr t) = do { (t', fvs) <- rnHsTypeFVs doc t
                      doc = ptext SLIT("In a Template-Haskell quoted type")
 rnBracket (DecBr group) 
   = do         { gbl_env  <- getGblEnv
-       ; names    <- getLocalDeclBinders gbl_env group
-       ; rdr_env' <- extendRdrEnvRn (tcg_mod gbl_env) emptyGlobalRdrEnv names
 
-       ; setGblEnv (gbl_env { tcg_rdr_env = tcg_rdr_env gbl_env `plusOccEnv` rdr_env',
+       ; let gbl_env1 = gbl_env { tcg_mod = thFAKE }
+       -- Note the thFAKE.  The top-level names from the bracketed 
+       -- declarations will go into the name cache, and we don't want them to 
+       -- confuse the Names for the current module.  
+       -- By using a pretend module, thFAKE, we keep them safely out of the way.
+
+       ; names    <- getLocalDeclBinders gbl_env1 group
+       ; rdr_env' <- extendRdrEnvRn thFAKE emptyGlobalRdrEnv names
+       -- Furthermore, the names in the bracket shouldn't conflict with
+       -- existing top-level names E.g.
+       --      foo = 1
+       --      bar = [d| foo = 1|]
+       -- But both 'foo's get a LocalDef provenance, so we'd get a complaint unless
+       -- we start with an emptyGlobalRdrEnv
+
+       ; setGblEnv (gbl_env { tcg_rdr_env = tcg_rdr_env gbl_env1 `plusOccEnv` rdr_env',
                               tcg_dus = emptyDUs }) $ do
                -- Notice plusOccEnv, not plusGlobalRdrEnv.  In this situation we want
-               -- to *shadow* top-level bindings.  E.g.
-               --      foo = 1
-               --      bar = [d| foo = 1|]
-               -- So we drop down to plusOccEnv.  (Perhaps there should be a fn in RdrName.)
-               --      
+               -- to *shadow* top-level bindings.  (See the 'foo' example above.)
+               -- If we don't shadow, we'll get an ambiguity complaint when we do 
+               -- a lookupTopBndrRn (which uses lookupGreLocalRn) on the binder of the 'foo'
+               --
+               -- Furthermore, arguably if the splice does define foo, that should hide
+               -- any foo's further out
+               --
                -- The emptyDUs is so that we just collect uses for this group alone
 
        { (tcg_env, group') <- rnSrcDecls group

diff --git a/ghc/compiler/rename/RnSource.lhs b/ghc/compiler/rename/RnSource.lhs
index c113af7..84ff47d 100644 (file)
--- a/ghc/compiler/rename/RnSource.lhs
+++ b/ghc/compiler/rename/RnSource.lhs
@@ -15,7 +15,8 @@ module RnSource (
 import {-# SOURCE #-} RnExpr( rnLExpr )
 
 import HsSyn
-import RdrName         ( RdrName, isRdrDataCon, elemLocalRdrEnv )
+import RdrName         ( RdrName, isRdrDataCon, elemLocalRdrEnv, globalRdrEnvElts,
+                         GlobalRdrElt(..), isLocalGRE )
 import RdrHsSyn                ( extractGenericPatTyVars, extractHsRhoRdrTyVars )
 import RnHsSyn
 import RnTypes         ( rnLHsType, rnLHsTypes, rnHsSigType, rnHsTypeFVs, rnContext )
@@ -35,6 +36,7 @@ import Class          ( FunDep )
 import Name            ( Name, nameOccName )
 import NameSet
 import NameEnv
+import OccName         ( occEnvElts )
 import Outputable
 import SrcLoc          ( Located(..), unLoc, getLoc, noLoc )
 import DynFlags        ( DynFlag(..) )
@@ -661,14 +663,41 @@ rnHsTyvar doc tyvar = lookupOccRn tyvar
 %*                                                     *
 %*********************************************************
 
+Note [Splices]
+~~~~~~~~~~~~~~
+Consider
+       f = ...
+       h = ...$(thing "f")...
+
+The splice can expand into literally anything, so when we do dependency
+analysis we must assume that it might mention 'f'.  So we simply treat
+all locally-defined names as mentioned by any splice.  This is terribly
+brutal, but I don't see what else to do.  For example, it'll mean
+that every locally-defined thing will appear to be used, so no unused-binding
+warnings.  But if we miss the dependency, then we might typecheck 'h' before 'f',
+and that will crash the type checker because 'f' isn't in scope.
+
+Currently, I'm not treating a splice as also mentioning every import,
+which is a bit inconsistent -- but there are a lot of them.  We might
+thereby get some bogus unused-import warnings, but we won't crash the
+type checker.  Not very satisfactory really.
+
 \begin{code}
 rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
 rnSplice (HsSplice n expr)
-  = checkTH expr "splice"      `thenM_`
-    getSrcSpanM                `thenM` \ loc ->
-    newLocalsRn [L loc n]      `thenM` \ [n'] ->
-    rnLExpr expr               `thenM` \ (expr', fvs) ->
-    returnM (HsSplice n' expr', fvs)
+  = do { checkTH expr "splice"
+       ; loc  <- getSrcSpanM
+       ; [n'] <- newLocalsRn [L loc n]
+       ; (expr', fvs) <- rnLExpr expr
+
+       -- Ugh!  See Note [Splices] above
+       ; lcl_rdr <- getLocalRdrEnv
+       ; gbl_rdr <- getGlobalRdrEnv
+       ; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr, 
+                                                   isLocalGRE gre]
+             lcl_names = mkNameSet (occEnvElts lcl_rdr)
+
+       ; return (HsSplice n' expr', fvs `plusFV` lcl_names `plusFV` gbl_names) }
 
 #ifdef GHCI 
 checkTH e what = returnM ()    -- OK