From ff8cd2c58cdc05c05964a631664a9347a86f8964 Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Tue, 10 Dec 2002 17:34:35 +0000
Subject: [PATCH] [project @ 2002-12-10 17:34:34 by simonpj] Check for
 qualified names in binding positions in the parser instead
 of the rename.  In External Core it's OK to have qualified
 names in these places.

---
 ghc/compiler/parser/RdrHsSyn.lhs |   17 ++++++++++++-----
 ghc/compiler/rename/RnEnv.lhs    |   22 +++++++++-------------
 2 files changed, 21 insertions(+), 18 deletions(-)

diff --git a/ghc/compiler/parser/RdrHsSyn.lhs b/ghc/compiler/parser/RdrHsSyn.lhs
index 4ef778a..6cf8adb 100644
--- a/ghc/compiler/parser/RdrHsSyn.lhs
+++ b/ghc/compiler/parser/RdrHsSyn.lhs
@@ -92,7 +92,7 @@ module RdrHsSyn (
 
 import HsSyn		-- Lots of it
 import RdrName		( RdrName, isRdrTyVar, mkRdrUnqual, mkUnqual, rdrNameOcc, 
-			  isRdrTyVar, isRdrDataCon, isUnqual, getRdrName,
+			  isRdrTyVar, isRdrDataCon, isUnqual, getRdrName, isQual,
 			  setRdrNameSpace )
 import BasicTypes	( RecFlag(..), FixitySig(..), maxPrecedence )
 import Class            ( DefMeth (..) )
@@ -612,8 +612,9 @@ checkPat (HsApp f x) args =
 	checkPat x [] `thenP` \x ->
 	checkPat f (x:args)
 checkPat e [] = case e of
-	EWildPat	   -> returnP (WildPat placeHolderType)
-	HsVar x		   -> returnP (VarPat x)
+	EWildPat	    -> returnP (WildPat placeHolderType)
+	HsVar x	| isQual x  -> parseError ("Qualified variable in pattern: " ++ showRdrName x)
+		| otherwise -> returnP (VarPat x)
 	HsLit l 	   -> returnP (LitPat l)
 	HsOverLit l	   -> returnP (NPatIn l Nothing)
 	ELazyPat e	   -> checkPat e [] `thenP` (returnP . LazyPat)
@@ -684,8 +685,11 @@ checkValDef
 
 checkValDef lhs opt_sig grhss loc
  = case isFunLhs lhs [] of
-	   Just (f,inf,es) -> 
-		checkPatterns loc es `thenP` \ps ->
+	   Just (f,inf,es) 
+	     | isQual f
+	     -> parseError ("Qualified name in function definition: "  ++ showRdrName f)
+	     | otherwise
+	     -> checkPatterns loc es `thenP` \ps ->
 		returnP (RdrValBinding (FunMonoBind f inf [Match ps opt_sig grhss] loc))
 
            Nothing ->
@@ -862,6 +866,9 @@ mkIfaceExports decls = map getExport decls
 -- Misc utils
 
 \begin{code}
+showRdrName :: RdrName -> String
+showRdrName r = showSDoc (ppr r)
+
 parseError :: String -> P a
 parseError s = 
   getSrcLocP `thenP` \ loc ->
diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs
index 4f2fc94..689d9a3 100644
--- a/ghc/compiler/rename/RnEnv.lhs
+++ b/ghc/compiler/rename/RnEnv.lhs
@@ -233,14 +233,11 @@ lookupTopBndrRn rdr_name
 -- A separate function (importsFromLocalDecls) reports duplicate top level
 -- decls, so here it's safe just to choose an arbitrary one.
 
-   	-- There should never be a qualified name in a binding position 
-	-- The parser could check this, but doesn't (yet)
-  | isQual rdr_name
-  = getSrcLocM							`thenM` \ loc ->
-    qualNameErr (text "In its declaration") (rdr_name,loc)	`thenM_`
-    returnM (mkUnboundName rdr_name)
+  	-- There should never be a qualified name in a binding position in Haskell,
+	-- but there can be if we have read in an external-Core file.
+	-- The Haskell parser checks for the illegal qualified name, so we 
+	-- don't need to do so here.
 
-  | otherwise
   = ASSERT( not (isOrig rdr_name) )
 	-- Original names are used only for occurrences, 
 	-- not binding sites
@@ -338,15 +335,12 @@ lookupInstDeclBndr cls_name rdr_name
 
 	other		    -> pprPanic "lookupInstDeclBndr" (ppr cls_name)
 
-  | isQual rdr_name	-- Should never have a qualified name in a binding position
-  = getSrcLocM							`thenM` \ loc ->
-    qualNameErr (text "In an instance method") (rdr_name,loc)	`thenM_`
-    returnM (mkUnboundName rdr_name)
-	
+
   | otherwise	 	-- Occurs in derived instances, where we just
 			-- refer directly to the right method, and avail_env
 			-- isn't available
   = ASSERT2( not (isQual rdr_name), ppr rdr_name )
+	  -- NB: qualified names are rejected by the parser
     lookupOrigName rdr_name
 
   where
@@ -832,7 +826,9 @@ checkDupOrQualNames, checkDupNames :: SDoc
 	-- Works in any variant of the renamer monad
 
 checkDupOrQualNames doc_str rdr_names_w_loc
-  =	-- Check for use of qualified names
+  =	-- Qualified names in patterns are now rejected by the parser
+	-- but I'm not 100% certain that it finds all cases, so I've left
+	-- this check in for now.  Should go eventually.
     mappM_ (qualNameErr doc_str) quals 	`thenM_`
     checkDupNames doc_str rdr_names_w_loc
   where
-- 
1.7.10.4