X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Frename%2FRnEnv.lhs;h=c6468b4e304137e44ad68011bae4858c144d8d0d;hb=7299e42cc5214458ba16034dbfbf58de55f7121b;hp=63db61ccb646e766e7529786b62f29d50d03b17d;hpb=d1984e439154e95b2804ee83897e740b1713c53d;p=ghc-hetmet.git

diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs
index 63db61c..c6468b4 100644
--- a/compiler/rename/RnEnv.lhs
+++ b/compiler/rename/RnEnv.lhs
@@ -30,7 +30,7 @@ module RnEnv (
 	mapFvRn, mapFvRnCPS,
 	warnUnusedMatches, warnUnusedModules, warnUnusedImports, 
 	warnUnusedTopBinds, warnUnusedLocalBinds,
-	dataTcOccs, unknownNameErr
+	dataTcOccs, unknownNameErr, perhapsForallMsg
     ) where
 
 #include "HsVersions.h"
@@ -41,7 +41,7 @@ import HsSyn
 import RdrHsSyn		( extractHsTyRdrTyVars )
 import RdrName
 import HscTypes		( availNames, ModIface(..), FixItem(..), lookupFixity)
-import TcEnv		( tcLookupDataCon )
+import TcEnv		( tcLookupDataCon, isBrackStage )
 import TcRnMonad
 import Name		( Name, nameIsLocalOrFrom, mkInternalName, isWiredInName,
 			  nameSrcLoc, nameSrcSpan, nameOccName, nameModule, isExternalName )
@@ -140,7 +140,16 @@ newTopSrcBinder this_mod (L loc rdr_name)
 	         (addErrAt loc (badQualBndrErr rdr_name))
 	 	-- Binders should not be qualified; if they are, and with a different
 		-- module name, we we get a confusing "M.T is not in scope" error later
-	; newGlobalBinder this_mod (rdrNameOcc rdr_name) loc }
+
+	; stage <- getStage
+	; if isBrackStage stage then
+	        -- We are inside a TH bracket, so make an *Internal* name
+		-- See Note [Top-level Names in Template Haskell decl quotes] in RnNames
+	     do { uniq <- newUnique
+	        ; return (mkInternalName uniq (rdrNameOcc rdr_name) loc) } 
+	  else	
+	  	-- Normal case
+	     newGlobalBinder this_mod (rdrNameOcc rdr_name) loc }
 \end{code}
 
 %*********************************************************
@@ -470,7 +479,7 @@ lookupQualifiedName rdr_name
   | Just (mod,occ) <- isQual_maybe rdr_name
    -- Note: we want to behave as we would for a source file import here,
    -- and respect hiddenness of modules/packages, hence loadSrcInterface.
-   = loadSrcInterface doc mod False	`thenM` \ iface ->
+   = loadSrcInterface doc mod False Nothing	`thenM` \ iface ->
 
    case  [ (mod,occ) | 
 	   (mod,avails) <- mi_exports iface,
@@ -868,11 +877,9 @@ checkShadowedNames doc_str (global_env,local_env) loc_rdr_names
 \begin{code}
 -- A useful utility
 mapFvRn :: (a -> RnM (b, FreeVars)) -> [a] -> RnM ([b], FreeVars)
-mapFvRn f xs = mappM f xs	`thenM` \ stuff ->
-	       let
-		  (ys, fvs_s) = unzip stuff
-	       in
-	       returnM (ys, plusFVs fvs_s)
+mapFvRn f xs = do stuff <- mappM f xs
+                  case unzip stuff of
+                      (ys, fvs_s) -> returnM (ys, plusFVs fvs_s)
 
 -- because some of the rename functions are CPSed:
 -- maps the function across the list from left to right; 
@@ -986,9 +993,13 @@ unknownNameErr rdr_name
 			  <+> quotes (ppr rdr_name))
 	 , extra ]
   where
-    extra | rdr_name == forall_tv_RDR 
-	  = ptext (sLit "Perhaps you intended to use -XRankNTypes or similar flag")
-	  | otherwise = empty
+    extra | rdr_name == forall_tv_RDR = perhapsForallMsg
+	  | otherwise 		      = empty
+
+perhapsForallMsg :: SDoc
+perhapsForallMsg 
+  = vcat [ ptext (sLit "Perhaps you intended to use -XRankNTypes or similar flag")
+	 , ptext (sLit "to enable explicit-forall syntax: forall <tvs>. <type>")]
 
 unknownSubordinateErr :: SDoc -> RdrName -> SDoc
 unknownSubordinateErr doc op	-- Doc is "method of class" or