summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/basicTypes/Name.lhs2
-rw-r--r--compiler/basicTypes/RdrName.lhs36
-rw-r--r--compiler/rename/RnEnv.lhs25
-rw-r--r--compiler/rename/RnNames.lhs6
-rw-r--r--compiler/rename/RnTypes.lhs2
5 files changed, 52 insertions, 19 deletions
diff --git a/compiler/basicTypes/Name.lhs b/compiler/basicTypes/Name.lhs
index a26729f4b5..3fefd7b59b 100644
--- a/compiler/basicTypes/Name.lhs
+++ b/compiler/basicTypes/Name.lhs
@@ -55,7 +55,7 @@ module Name (
nameOccName, nameModule, nameModule_maybe,
tidyNameOcc,
hashName, localiseName,
- mkLocalisedOccName,
+ mkLocalisedOccName,
nameSrcLoc, nameSrcSpan, pprNameDefnLoc, pprDefinedAt,
diff --git a/compiler/basicTypes/RdrName.lhs b/compiler/basicTypes/RdrName.lhs
index 22bd41f7d6..c8f7c169fd 100644
--- a/compiler/basicTypes/RdrName.lhs
+++ b/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}
%************************************************************************
diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs
index 66c40928a2..f45354dcc2 100644
--- a/compiler/rename/RnEnv.lhs
+++ b/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]
diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs
index 7007eb559c..8741b9ab84 100644
--- a/compiler/rename/RnNames.lhs
+++ b/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
diff --git a/compiler/rename/RnTypes.lhs b/compiler/rename/RnTypes.lhs
index ddd788f0bf..2c5a5a5718 100644
--- a/compiler/rename/RnTypes.lhs
+++ b/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) }
View Lorry Controller Status