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 4ef778a561c1..6cf8adb1b209 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 4f2fc9457dbd..689d9a3f13fd 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
--
GitLab