X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Frename%2FRnEnv.lhs;h=91b1269a2456f87ac73ebf6dc7ce36c5c97ccd9c;hp=d63c450b9ef71fbc91cb2c6ef11df2308dcac517;hb=39fd94e2727715556805a85a7e803c337df950a9;hpb=b67039a74676cd3d8eab39d3e986b889e92338a5

diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs
index d63c450..91b1269 100644
--- a/compiler/rename/RnEnv.lhs
+++ b/compiler/rename/RnEnv.lhs
@@ -87,14 +87,14 @@ newTopSrcBinder this_mod mb_parent (L loc rdr_name)
 	--	data T = (,) Int Int
 	-- unless we are in GHC.Tup
     ASSERT2( isExternalName name,  ppr name )
-    do	checkErr (this_mod == nameModule name)
-	         (badOrigBinding rdr_name)
-	returnM name
+    do	{ checkM (this_mod == nameModule name)
+	         (addErrAt loc (badOrigBinding rdr_name))
+	; return name }
 
 
   | Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name
-  = do	checkErr (rdr_mod == this_mod || rdr_mod == rOOT_MAIN)
-	         (badOrigBinding rdr_name)
+  = do	{ checkM (rdr_mod == this_mod || rdr_mod == rOOT_MAIN)
+	         (addErrAt loc (badOrigBinding rdr_name))
 	-- When reading External Core we get Orig names as binders, 
 	-- but they should agree with the module gotten from the monad
 	--
@@ -112,11 +112,15 @@ newTopSrcBinder this_mod mb_parent (L loc rdr_name)
 	-- the RdrName, not from the environment.  In principle, it'd be fine to 
 	-- have an arbitrary mixture of external core definitions in a single module,
 	-- (apart from module-initialisation issues, perhaps).
-	newGlobalBinder rdr_mod rdr_occ mb_parent 
-	    	        (srcSpanStart loc) --TODO, should pass the whole span
+	; newGlobalBinder rdr_mod rdr_occ mb_parent (srcSpanStart loc) }
+		--TODO, should pass the whole span
 
   | otherwise
-  = newGlobalBinder this_mod (rdrNameOcc rdr_name) mb_parent (srcSpanStart loc)
+  = do	{ checkM (not (isQual 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) mb_parent (srcSpanStart loc) }
 \end{code}
 
 %*********************************************************
@@ -445,10 +449,9 @@ lookupFixityRn name
 ---------------
 lookupTyFixityRn :: Located Name -> RnM Fixity
 lookupTyFixityRn (L loc n)
-  = doptM Opt_GlasgowExts 			`thenM` \ glaExts ->
-    when (not glaExts) 
-    	 (setSrcSpan loc $ addWarn (infixTyConWarn n))	`thenM_`
-    lookupFixityRn n
+  = do	{ glaExts <- doptM Opt_GlasgowExts
+	; when (not glaExts) (addWarnAt loc (infixTyConWarn n))
+	; lookupFixityRn n }
 
 ---------------
 dataTcOccs :: RdrName -> [RdrName]
@@ -676,7 +679,7 @@ checkShadowing doc_str loc_rdr_names
       check_shadow (L loc rdr_name)
 	|  rdr_name `elemLocalRdrEnv` local_env 
  	|| not (null (lookupGRE_RdrName rdr_name global_env ))
-	= setSrcSpan loc $ addWarn (shadowedNameWarn doc_str rdr_name)
+	= addWarnAt loc (shadowedNameWarn doc_str rdr_name)
         | otherwise = returnM ()
     in
     mappM_ check_shadow loc_rdr_names
@@ -710,7 +713,7 @@ warnUnusedModules :: [(ModuleName,SrcSpan)] -> RnM ()
 warnUnusedModules mods
   = ifOptM Opt_WarnUnusedImports (mappM_ bleat mods)
   where
-    bleat (mod,loc) = setSrcSpan loc $ addWarn (mk_warn mod)
+    bleat (mod,loc) = addWarnAt loc (mk_warn mod)
     mk_warn m = vcat [ptext SLIT("Module") <+> quotes (ppr m)
 			<+> text "is imported, but nothing from it is used,",
 		      nest 2 (ptext SLIT("except perhaps instances visible in") 
@@ -765,10 +768,11 @@ warnUnusedName (name, prov)
 \end{code}
 
 \begin{code}
-addNameClashErrRn rdr_name (np1:nps)
+addNameClashErrRn rdr_name names
   = addErr (vcat [ptext SLIT("Ambiguous occurrence") <+> quotes (ppr rdr_name),
 		  ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)])
   where
+    (np1:nps) = names
     msg1 = ptext  SLIT("either") <+> mk_ref np1
     msgs = [ptext SLIT("    or") <+> mk_ref np | np <- nps]
     mk_ref gre = quotes (ppr (gre_name gre)) <> comma <+> pprNameProvenance gre
@@ -793,10 +797,9 @@ badOrigBinding name
 
 dupNamesErr :: SDoc -> [Located RdrName] -> RnM ()
 dupNamesErr descriptor located_names
-  = setSrcSpan big_loc $
-    addErr (vcat [ptext SLIT("Conflicting definitions for") <+> quotes (ppr name1),
-		  locations,
-		  descriptor])
+  = addErrAt big_loc $
+    vcat [ptext SLIT("Conflicting definitions for") <+> quotes (ppr name1),
+	  locations, descriptor]
   where
     L _ name1 = head located_names
     locs      = map getLoc located_names
@@ -806,6 +809,9 @@ dupNamesErr descriptor located_names
 	      | otherwise = ptext SLIT("Bound at:") <+> 
 			    vcat (map ppr (sortLe (<=) locs))
 
+badQualBndrErr rdr_name
+  = ptext SLIT("Qualified name in binding position:") <+> ppr rdr_name
+
 infixTyConWarn op
   = vcat [ftext FSLIT("Accepting non-standard infix type constructor") <+> quotes (ppr op),
 	  ftext FSLIT("Use -fglasgow-exts to avoid this warning")]