[haddock @ 2002-05-17 10:51:57 by simonmar]

Fix bugs in qualified name handling (A.B.f was returned as B.f)

1 files changed, 9 insertions, 10 deletions

diff --git a/src/HsLexer.lhs b/src/HsLexer.lhs
index fb4447d3..dcf3ebbc 100644
--- a/src/HsLexer.lhs
+++ b/src/HsLexer.lhs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: HsLexer.lhs,v 1.10 2002/05/15 13:28:46 simonmar Exp $
+-- $Id: HsLexer.lhs,v 1.11 2002/05/17 10:51:57 simonmar Exp $
 --
 -- (c) The GHC Team, 1997-2000
 --
@@ -425,6 +425,9 @@ lexCon qual cont s loc y x =
     just_a_conid 
 	| null qual = forward l_con (ConId con) rest
 	| otherwise = forward l_con (QConId (qual,con)) rest
+
+    qual' | null qual = con
+	  | otherwise = qual ++ '.':con
   in
   case rest of
     '.':c1:s1 
@@ -437,12 +440,9 @@ lexCon qual cont s loc y x =
 	case lookup id reserved_ids of
 	   -- cannot qualify a reserved word
 	   Just keyword -> just_a_conid
-	   Nothing -> forward (l_con+1+l_id) (QVarId (con, id)) rest1
+	   Nothing -> forward (l_con+1+l_id) (QVarId (qual',id)) rest1
 
      | isUpper c1 ->	-- qualified conid?
-        let qual' | null qual = con
-		  | otherwise = qual ++ '.':con
-	in
 	lexCon qual' cont (c1:s1) loc y (x+l_con+1)
 
      | isSymbol c1 ->	-- qualified symbol?
@@ -454,11 +454,10 @@ lexCon qual cont s loc y x =
 	case lookup sym reserved_ops of
 	    -- cannot qualify a reserved operator
 	    Just _  -> just_a_conid
-	    Nothing -> case c1 of
-			':' -> forward (l_con+1+l_sym) 
-				(QConSym (con, sym)) rest1
-			_   -> forward (l_con+1+l_sym)
-				(QVarSym (con, sym)) rest1
+	    Nothing -> 
+		case c1 of
+		  ':' -> forward (l_con+1+l_sym) (QConSym (qual', sym)) rest1
+		  _   -> forward (l_con+1+l_sym) (QVarSym (qual', sym)) rest1
 
     _ -> just_a_conid -- not a qualified thing