Make the LocalRdrEnv keep track of all the Names that are in scope

This allows us to give a sensible error message when a Template Haskell
splice generates an occurrence without a binding site.

Fixes Trac #5959 and #5971

compiler/basicTypes/Name.lhs

@@ -55,7 +55,7 @@ module Name (
 	nameOccName, nameModule, nameModule_maybe,
 	tidyNameOcc, 
 	hashName, localiseName,
-  mkLocalisedOccName,
+        mkLocalisedOccName,
 
 	nameSrcLoc, nameSrcSpan, pprNameDefnLoc, pprDefinedAt,
 

compiler/basicTypes/RdrName.lhs

@@ -49,7 +49,8 @@ module RdrName (
 
 	-- * Local mapping of 'RdrName' to 'Name.Name'
 	LocalRdrEnv, emptyLocalRdrEnv, extendLocalRdrEnv, extendLocalRdrEnvList,
-	lookupLocalRdrEnv, lookupLocalRdrOcc, elemLocalRdrEnv,
+	lookupLocalRdrEnv, lookupLocalRdrOcc, elemLocalRdrEnv, inLocalRdrEnvScope, 
+        localRdrEnvElts, delLocalRdrEnvList,
 
 	-- * Global mapping of 'RdrName' to 'GlobalRdrElt's
 	GlobalRdrEnv, emptyGlobalRdrEnv, mkGlobalRdrEnv, plusGlobalRdrEnv, 
@@ -70,6 +71,7 @@ module RdrName (
 
 import Module
 import Name
+import NameSet
 import Maybes
 import SrcLoc
 import FastString
@@ -333,30 +335,42 @@ instance Ord RdrName where
 \begin{code}
 -- | This environment is used to store local bindings (@let@, @where@, lambda, @case@).
 -- It is keyed by OccName, because we never use it for qualified names
-type LocalRdrEnv = OccEnv Name
+-- We keep the current mapping, *and* the set of all Names in scope
+-- Reason: see Note [Splicing Exact Names] in RnEnv
+type LocalRdrEnv = (OccEnv Name, NameSet) 
 
 emptyLocalRdrEnv :: LocalRdrEnv
-emptyLocalRdrEnv = emptyOccEnv
+emptyLocalRdrEnv = (emptyOccEnv, emptyNameSet)
 
 extendLocalRdrEnv :: LocalRdrEnv -> Name -> LocalRdrEnv
-extendLocalRdrEnv env name
-  = extendOccEnv env (nameOccName name) name
+extendLocalRdrEnv (env, ns) name
+  = (extendOccEnv env (nameOccName name) name, addOneToNameSet ns name)
 
 extendLocalRdrEnvList :: LocalRdrEnv -> [Name] -> LocalRdrEnv
-extendLocalRdrEnvList env names
-  = extendOccEnvList env [(nameOccName n, n) | n <- names]
+extendLocalRdrEnvList (env, ns) names
+  = (extendOccEnvList env [(nameOccName n, n) | n <- names], addListToNameSet  ns names)
 
 lookupLocalRdrEnv :: LocalRdrEnv -> RdrName -> Maybe Name
-lookupLocalRdrEnv env (Unqual occ) = lookupOccEnv env occ
-lookupLocalRdrEnv _   _            = Nothing
+lookupLocalRdrEnv (env, _) (Unqual occ) = lookupOccEnv env occ
+lookupLocalRdrEnv _        _            = Nothing
 
 lookupLocalRdrOcc :: LocalRdrEnv -> OccName -> Maybe Name
-lookupLocalRdrOcc env occ = lookupOccEnv env occ
+lookupLocalRdrOcc (env, _) occ = lookupOccEnv env occ
 
 elemLocalRdrEnv :: RdrName -> LocalRdrEnv -> Bool
-elemLocalRdrEnv rdr_name env 
+elemLocalRdrEnv rdr_name (env, _)
   | isUnqual rdr_name = rdrNameOcc rdr_name `elemOccEnv` env
   | otherwise	      = False
+
+localRdrEnvElts :: LocalRdrEnv -> [Name]
+localRdrEnvElts (env, _) = occEnvElts env
+
+inLocalRdrEnvScope :: Name -> LocalRdrEnv -> Bool
+-- This is the point of the NameSet
+inLocalRdrEnvScope name (_, ns) = name `elemNameSet` ns
+
+delLocalRdrEnvList :: LocalRdrEnv -> [OccName] -> LocalRdrEnv
+delLocalRdrEnvList (env, ns) occs = (delListFromOccEnv env occs, ns)
 \end{code}
 
 %************************************************************************

compiler/rename/RnEnv.lhs

@@ -240,10 +240,19 @@ lookupExactOcc name
   = do { env <- getGlobalRdrEnv
        ; let gres = lookupGRE_Name env name
        ; case gres of
-           []    -> return name
+           []    -> -- See Note [Splicing Exact names]
+                    do { lcl_env <- getLocalRdrEnv
+                       ; unless (name `inLocalRdrEnvScope` lcl_env)
+                                (addErr exact_nm_err)
+                       ; return name }
+   
            [gre] -> return (gre_name gre)
            _     -> pprPanic "lookupExactOcc" (ppr name $$ ppr gres) }
 
+  where
+    exact_nm_err = hang (ptext (sLit "The exact Name") <+> quotes (ppr name) <+> ptext (sLit "is not in scope"))
+                      2 (ptext (sLit "Probable cause: you used a unique name (NameU) in Template Haskell but did not bind it"))
+
 -----------------------------------------------
 lookupInstDeclBndr :: Name -> SDoc -> RdrName -> RnM Name
 -- This is called on the method name on the left-hand side of an 
@@ -427,6 +436,7 @@ positions for constructors, TyCons etc.  For example
     [d| data T = MkT Int |]
 when we splice in and Convert to HsSyn RdrName, we'll get
     data (Exact (system Name "T")) = (Exact (system Name "MkT")) ...
+These System names are generated by Convert.thRdrName
 
 But, constructors and the like need External Names, not System Names!
 So we do the following
@@ -437,7 +447,7 @@ So we do the following
 
  * When looking up an occurrence of an Exact name, done in
    RnEnv.lookupExactOcc, we find the Name with the right unique in the
-   GlobalRdrEnv, and use the on from the envt -- it will be an
+   GlobalRdrEnv, and use the one from the envt -- it will be an
    External Name in the case of the data type/constructor above.
 
  * Exact names are also use for purely local binders generated
@@ -449,6 +459,15 @@ So we do the following
    will find the Name is not in the GlobalRdrEnv, so we just use
    the Exact supplied Name.
 
+Note [Splicing Exact names]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider the splice $(do { x <- newName "x"; return (VarE x) })
+This will generate a (HsExpr RdrName) term that mentions the 
+Exact RdrName "x_56" (or whatever), but does not bind it.  So
+when looking such Exact names we want to check that it's in scope,
+otherwise the type checker will get confused.  To do this we need to
+keep track of all the Names in scope, and the LocalRdrEnv does just that;
+we consult it with RdrName.inLocalRdrEnvScope.
 
 Note [Usage for sub-bndrs]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1230,7 +1249,7 @@ unknownNameSuggestErr where_look tried_rdr_name
       | tried_is_qual = []
       | not local_ok  = []
       | otherwise     = [ (mkRdrUnqual occ, nameSrcSpan name)
-                      	| name <- occEnvElts env
+                      	| name <- localRdrEnvElts env
                       	, let occ = nameOccName name
                       	, correct_name_space occ]
 

compiler/rename/RnNames.lhs

@@ -406,7 +406,8 @@ extendGlobalRdrEnvRn avails new_fixities
               new_occs = map (nameOccName . gre_name) gres
               rdr_env_TH = transformGREs qual_gre new_occs rdr_env
               rdr_env_GHCi = delListFromOccEnv rdr_env new_occs
-              lcl_env1 = lcl_env { tcl_rdr = delListFromOccEnv (tcl_rdr lcl_env) new_occs }
+
+              lcl_env1 = lcl_env { tcl_rdr = delLocalRdrEnvList (tcl_rdr lcl_env) new_occs }
               (rdr_env2, lcl_env2) | shadowP   = (rdr_env_TH,   lcl_env1)
                                    | isGHCi    = (rdr_env_GHCi, lcl_env1)
                                    | otherwise = (rdr_env,      lcl_env)
@@ -921,8 +922,7 @@ rnExports explicit_mod exports
         ; (rn_exports, avails) <- exports_from_avail real_exports rdr_env imports this_mod
         ; let final_avails = nubAvails avails    -- Combine families
 
-        ; traceRn (vcat [ text "rnExports: RdrEnv:" <+> ppr rdr_env
-                        , text "     Exports:" <+> ppr final_avails] )
+        ; traceRn (text "rnExports: Exports:" <+> ppr final_avails)
 
         ; return (tcg_env { tcg_exports    = final_avails,
                             tcg_rn_exports = case tcg_rn_exports tcg_env of

compiler/rename/RnTypes.lhs

@@ -838,7 +838,7 @@ rnSplice (HsSplice n expr)
 	; gbl_rdr <- getGlobalRdrEnv
 	; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr, 
 						    isLocalGRE gre]
-	      lcl_names = mkNameSet (occEnvElts lcl_rdr)
+	      lcl_names = mkNameSet (localRdrEnvElts lcl_rdr)
 
 	; return (HsSplice n' expr', fvs `plusFV` lcl_names `plusFV` gbl_names) }