From: simonmar <unknown>
Date: Mon, 20 Aug 2001 10:20:34 +0000 (+0000)
Subject: [project @ 2001-08-20 10:20:34 by simonmar]
X-Git-Tag: Approximately_9120_patches~1182
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=72e0e2a878d596cebdfb44b4a156e9ee2fce8e51;p=ghc-hetmet.git

[project @ 2001-08-20 10:20:34 by simonmar]
Now copes with more forms of identifiers, as suggested by Marcin.
---

diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs
index 290f177..2e38352 100644
--- a/ghc/compiler/main/HscMain.lhs
+++ b/ghc/compiler/main/HscMain.lhs
@@ -18,9 +18,10 @@ import ByteCodeGen	( byteCodeGen )
 import CoreTidy		( tidyCoreExpr )
 import CorePrep		( corePrepExpr )
 import Rename		( renameStmt, renameRdrName )
-import RdrName          ( mkUnqual, mkQual )
+import RdrName          ( rdrNameOcc, setRdrNameOcc )
 import RdrHsSyn		( RdrNameStmt )
-import OccName          ( varName, dataName, tcClsName )
+import OccName          ( dataName, tcClsName, 
+			  occNameSpace, setOccNameSpace )
 import Type		( Type )
 import Id		( Id, idName, setGlobalIdDetails )
 import IdInfo		( GlobalIdDetails(VanillaGlobal) )
@@ -623,22 +624,23 @@ hscThing dflags hst hit pcs0 icontext str
    = do let 
 	  InteractiveContext {
 	     ic_rn_env   = rn_env,
-	     ic_type_env = type_env,
 	     ic_module   = scope_mod } = icontext
 
-	  rdr_names
-	     | '.' `elem` str 
-		= [ mkQual ns (fmod,fvar) | ns <- namespaces var ]
-	     | otherwise
-		= [ mkUnqual ns fstr | ns <- namespaces str ]
- 	     where (mod,var) = split_longest_prefix str '.'
-		   fmod = mkFastString mod
-		   fvar = mkFastString var
-		   fstr = mkFastString str
-	  	   namespaces s 
-			| isUpper c || c == ':' = [ tcClsName, dataName ]
-			| otherwise             = [ varName ]
-		        where c = head s
+	maybe_rdr_name <- myParseIdentifier dflags str
+	case maybe_rdr_name of {
+	  Nothing -> return (pcs0, []);
+	  Just rdr_name -> do
+
+	-- if the identifier is a constructor (begins with an
+	-- upper-case letter), then we need to consider both
+	-- constructor and type class identifiers.
+	let rdr_names
+		| occNameSpace occ == dataName = [ rdr_name, tccls_name ]
+		| otherwise                    = [ rdr_name ]
+	      where
+		occ        = rdrNameOcc rdr_name
+		tccls_occ  = setOccNameSpace occ tcClsName
+		tccls_name = setRdrNameOcc rdr_name tccls_occ
 
 	(pcs, unqual, maybe_rn_result) <- 
 	   renameRdrName dflags hit hst pcs0 scope_mod scope_mod 
@@ -657,7 +659,25 @@ hscThing dflags hst hit pcs0 icontext str
 		let maybe_ty_things = map (lookupType hst (pcs_PTE pcs)) names
 		in
 		return (pcs, catMaybes maybe_ty_things) }
-        }}
+        }}}
+
+myParseIdentifier dflags str
+  = do buf <- stringToStringBuffer str
+ 
+       let glaexts | dopt Opt_GlasgowExts dflags = 1#
+		   | otherwise			 = 0#
+
+       case parseIdentifier buf 
+		PState{ bol = 0#, atbol = 1#,
+ 		        context = [], glasgow_exts = glaexts,
+		        loc = mkSrcLoc SLIT("<interactive>") 1 } of
+
+	  PFailed err -> do { hPutStrLn stderr (showSDoc err);
+           		      freeStringBuffer buf;
+                              return Nothing }
+
+	  POk _ rdr_name -> do { --should, but can't: freeStringBuffer buf;
+			         return (Just rdr_name) }
 #endif
 \end{code}