From 1ea67691a1d115d95d6c3e8e593c2c2dbc36aa9c Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Thu, 25 Nov 1999 10:33:23 +0000
Subject: [PATCH] [project @ 1999-11-25 10:33:20 by simonpj] Report decent
 error for top-level defn of a qualified name

---
 ghc/compiler/basicTypes/RdrName.lhs |    8 ++++----
 ghc/compiler/rename/RnEnv.lhs       |    1 -
 ghc/compiler/rename/RnNames.lhs     |   18 ++++++++++++------
 3 files changed, 16 insertions(+), 11 deletions(-)

diff --git a/ghc/compiler/basicTypes/RdrName.lhs b/ghc/compiler/basicTypes/RdrName.lhs
index ca98d8f..32774d9 100644
--- a/ghc/compiler/basicTypes/RdrName.lhs
+++ b/ghc/compiler/basicTypes/RdrName.lhs
@@ -28,7 +28,7 @@ import OccName	( NameSpace, tcName,
 		  mkSrcOccFS, mkSrcVarOcc,
 		  isDataOcc, isTvOcc
 		)
-import Module   ( ModuleName,
+import Module   ( ModuleName, pprModuleName,
 		  mkSysModuleFS, mkSrcModuleFS
 		)
 import Outputable
@@ -95,8 +95,8 @@ mkPreludeQual :: NameSpace -> ModuleName -> FAST_STRING -> RdrName
 mkPreludeQual sp mod n = RdrName (Qual mod) (mkSrcOccFS sp n)
 
 qualifyRdrName :: ModuleName -> RdrName -> RdrName
-qualifyRdrName mod (RdrName Unqual occ) = RdrName (Qual mod) occ
-qualifyRdrName mod rdr_name		= rdr_name 
+	-- Sets the module name of a RdrName, even if it has one already
+qualifyRdrName mod (RdrName _ occ) = RdrName (Qual mod) occ
 \end{code}
 
 \begin{code}
@@ -132,7 +132,7 @@ instance Outputable RdrName where
     ppr (RdrName qual occ) = pp_qual qual <> ppr occ
 			   where
 				pp_qual Unqual = empty
-				pp_qual (Qual mod) = ppr mod <> dot
+				pp_qual (Qual mod) = pprModuleName mod <> dot
 
 instance Eq RdrName where
     a == b = case (a `compare` b) of { EQ -> True;  _ -> False }
diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs
index df7ad7f..a4fad13 100644
--- a/ghc/compiler/rename/RnEnv.lhs
+++ b/ghc/compiler/rename/RnEnv.lhs
@@ -794,4 +794,3 @@ dupNamesErr descriptor ((name,loc) : dup_things)
 	      $$ 
 	      (ptext SLIT("in") <+> descriptor))
 \end{code}
-
diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs
index f549234..911718c 100644
--- a/ghc/compiler/rename/RnNames.lhs
+++ b/ghc/compiler/rename/RnNames.lhs
@@ -273,10 +273,7 @@ importsFromLocalDecls mod_name rec_exp_fn decls
 	all_names = [name | avail <- avails, name <- availNames avail]
 
 	dups :: [[Name]]
-	dups = filter non_singleton (equivClassesByUniq getUnique all_names)
-	     where
-		non_singleton (x1:x2:xs) = True
-		non_singleton other      = False
+	(_, dups) = removeDups compare all_names
     in
 	-- Check for duplicate definitions
     mapRn_ (addErrRn . dupDeclErr) dups		`thenRn_` 
@@ -293,10 +290,19 @@ importsFromLocalDecls mod_name rec_exp_fn decls
 		   (\n -> n)
 
   where
-    newLocalName rdr_name loc = newLocalTopBinder mod (rdrNameOcc rdr_name)
-						  rec_exp_fn loc
     mod = mkThisModule mod_name
 
+    newLocalName rdr_name loc 
+	= (if isQual rdr_name then
+		qualNameErr (text "the binding for" <+> quotes (ppr rdr_name)) (rdr_name,loc)
+		-- There should never be a qualified name in a binding position (except in instance decls)
+		-- The parser doesn't check this because the same parser parses instance decls
+	    else 
+		returnRn ())			`thenRn_`
+
+	  newLocalTopBinder mod (rdrNameOcc rdr_name) rec_exp_fn loc
+
+
 getLocalDeclBinders :: (RdrName -> SrcLoc -> RnMG Name)	-- New-name function
 		    -> RdrNameHsDecl
 		    -> RnMG Avails
-- 
1.7.10.4