[project @ 1996-05-16 09:48:23 by partain]

Sansom changes through 960515

6 files changed, 38 insertions, 21 deletions

diff --git a/ghc/compiler/rename/Rename.lhs b/ghc/compiler/rename/Rename.lhs
index 1a969990e3..743c83d125 100644
--- a/ghc/compiler/rename/Rename.lhs
+++ b/ghc/compiler/rename/Rename.lhs
@@ -65,7 +65,6 @@ renameModule :: UniqSupply
 \end{code} 
 
 ToDo: May want to arrange to return old interface for this module!
-ToDo: Builtin names which must be read.
 ToDo: Deal with instances (instance version, this module on instance list ???)
 
 \begin{code}
@@ -218,7 +217,7 @@ makeHiMap (Just f)
 
 \begin{code}
 {- TESTING:
-pprPIface (ParsedIface m ?? v mv usgs lcm exm ims lfx ltdm lvdm lids ldp)
+pprPIface (ParsedIface m ms v mv usgs lcm exm ims lfx ltdm lvdm lids ldp)
   = ppAboves [
 	ppCat [ppPStr SLIT("interface"), ppPStr m, ppInt v,
 	       case mv of { Nothing -> ppNil; Just n -> ppInt n }],
diff --git a/ghc/compiler/rename/RnExpr.lhs b/ghc/compiler/rename/RnExpr.lhs
index d00312c42b..9b4a61ba98 100644
--- a/ghc/compiler/rename/RnExpr.lhs
+++ b/ghc/compiler/rename/RnExpr.lhs
@@ -228,8 +228,8 @@ rnExpr (OpApp e1 op e2)
 
 rnExpr (NegApp e n)
   = rnExpr e 		`thenRn` \ (e', fvs_e) ->
-    lookupValue n	`thenRn` \ nname ->
-    returnRn (NegApp e' nname, fvs_e `unionUniqSets` fv_set nname)
+    rnExpr n		`thenRn` \ (n', fvs_n) ->
+    returnRn (NegApp e' n', fvs_e `unionUniqSets` fvs_n)
 
 rnExpr (HsPar e)
   = rnExpr e 		`thenRn` \ (e', fvs_e) ->
diff --git a/ghc/compiler/rename/RnIfaces.lhs b/ghc/compiler/rename/RnIfaces.lhs
index 299a1f34fd..76fe13cdbd 100644
--- a/ghc/compiler/rename/RnIfaces.lhs
+++ b/ghc/compiler/rename/RnIfaces.lhs
@@ -211,7 +211,7 @@ mergeIfaces (ParsedIface mod1 (_, files1) _ _ _ _ _ _ fixes1 tdefs1 vdefs1 idefs
 				    ppStr "merged with", ppPStr mod1]) $
     ASSERT(mod1 == mod2)
     ParsedIface mod1
-	(True, unionBags files1 files2)
+	(True, unionBags files2 files1)
 	(panic "mergeIface: module version numbers")
 	(panic "mergeIface: source version numbers")	-- Version numbers etc must be extracted from
 	(panic "mergeIface: usage version numbers")	-- the merged file interfaces named above
diff --git a/ghc/compiler/rename/RnMonad.lhs b/ghc/compiler/rename/RnMonad.lhs
index cde9eef625..9b7bf0fac6 100644
--- a/ghc/compiler/rename/RnMonad.lhs
+++ b/ghc/compiler/rename/RnMonad.lhs
@@ -43,7 +43,7 @@ import RnHsSyn		( RnName, mkRnName, mkRnUnbound, mkRnImplicit,
 import RnUtils		( RnEnv(..), extendLocalRnEnv,
 			  lookupRnEnv, lookupGlobalRnEnv, lookupTcRnEnv,
 			  unknownNameErr, badClassOpErr, qualNameErr,
-			  dupNamesErr, shadowedNameWarn, negateNameWarn
+			  dupNamesErr, shadowedNameWarn
 			)
 
 import Bag		( Bag, emptyBag, isEmptyBag, snocBag )
@@ -292,12 +292,10 @@ newLocalNames :: String 		-- Documentation string
 	      -> RnMonad x s [RnName]
 
 newLocalNames str names_w_loc
-  = mapRn (addWarnRn . negateNameWarn) negs 	`thenRn_`
-    mapRn (addErrRn . qualNameErr str) quals 	`thenRn_`
+  = mapRn (addErrRn . qualNameErr str) quals 	`thenRn_`
     mapRn (addErrRn . dupNamesErr str) dups  	`thenRn_`
     mkLocalNames these
   where
-    negs  = filter ((== Unqual SLIT("negate")).fst) names_w_loc
     quals = filter (isQual.fst) names_w_loc
     (these, dups) = removeDups cmp_fst names_w_loc
     cmp_fst (a,_) (b,_) = cmp a b
diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs
index 0f7037269d..10ea30ac30 100644
--- a/ghc/compiler/rename/RnNames.lhs
+++ b/ghc/compiler/rename/RnNames.lhs
@@ -348,7 +348,8 @@ doImportDecls iface_cache g_info us src_imps
     ) >>= \ (vals, tcs, unquals, fixes, errs, warns, _) ->
 
     return (vals, tcs, imp_mods, unquals, fixes,
-	    errs, imp_warns `unionBags` warns)
+	    imp_errs `unionBags` errs,
+	    imp_warns `unionBags` warns)
   where
     the_imps = implicit_prel ++ src_imps
     all_imps = implicit_qprel ++ the_imps
@@ -364,21 +365,35 @@ doImportDecls iface_cache g_info us src_imps
 		     then [{- no "import Prelude" -}]
 	             else [ImportDecl pRELUDE False Nothing Nothing prel_loc]
 
-    prel_imps -- WDP: Just guessing on this defn... ToDo
-      = [ imp | imp@(ImportDecl mod _ _ _ _) <- the_imps, fromPrelude mod ]
-
     prel_loc = mkBuiltinSrcLoc
 
     (uniq_imps, imp_dups) = removeDups cmp_mod the_imps
     cmp_mod (ImportDecl m1 _ _ _ _) (ImportDecl m2 _ _ _ _) = cmpPString m1 m2
 
-    qprel_imps = [ imp | imp@(ImportDecl mod True Nothing _ _) <- prel_imps ]
+    qprel_imps = [ imp | imp@(ImportDecl mod True Nothing _ _) <- src_imps,
+		 	 fromPrelude mod ]
+
+    qual_mods = [ (qual_name mod as_mod, imp) | imp@(ImportDecl mod True as_mod _ _) <- src_imps ]
+    qual_name mod (Just as_mod) = as_mod
+    qual_name mod Nothing       = mod
+
+    (_, qual_dups) = removeDups cmp_qual qual_mods
+    bad_qual_dups = filter (not . all_same_mod) qual_dups
+
+    cmp_qual (q1,_) (q2,_) = cmpPString q1 q2
+    all_same_mod ((q,ImportDecl mod _ _ _ _):rest)
+      = all has_same_mod rest
+      where
+	has_same_mod (q,ImportDecl mod2 _ _ _ _) = mod == mod2
+
 
     imp_mods  = [ mod | ImportDecl mod _ _ _ _ <- uniq_imps ]
+
     imp_warns = listToBag (map dupImportWarn imp_dups)
     		`unionBags`
 		listToBag (map qualPreludeImportWarn qprel_imps)
 
+    imp_errs  = listToBag (map dupQualImportErr bad_qual_dups)
 
 doImports iface_cache i_info us []
   = return (emptyBag, emptyBag, emptyBag, emptyBag, emptyBag, emptyBag, emptyBag)
@@ -516,7 +531,7 @@ getBuiltins (((b_val_names,b_tc_names),_,_,_),_,_,_) mod maybe_spec
         (vals, tcs, ies_left) = do_builtin ies
 
 
-getOrigIEs (ParsedIface _ _ _ _ _ _ exps _ _ _ _ _ _) Nothing		-- import all
+getOrigIEs (ParsedIface _ _ _ _ _ _ exps _ _ _ _ _ _) Nothing			-- import all
   = (map mkAllIE (eltsFM exps), [], emptyBag)
 
 getOrigIEs (ParsedIface _ _ _ _ _ _ exps _ _ _ _ _ _) (Just (True, ies))	-- import hiding
@@ -807,6 +822,16 @@ qualPreludeImportWarn (ImportDecl m _ _ _ locn)
   = addShortWarnLocLine locn (\ sty ->
     ppCat [ppStr "qualified import of prelude module", ppPStr m])
 
+dupQualImportErr ((q1,ImportDecl _ _ _ _ locn1):dup_quals) sty
+  = ppAboves (item1 : map dup_item dup_quals)
+  where
+    item1 = addShortErrLocLine locn1 (\ sty ->
+	    ppCat [ppStr "multiple imports (from different modules) with same qualified name", ppPStr q1]) sty
+
+    dup_item (q,ImportDecl _ _ _ _ locn)
+          = addShortErrLocLine locn (\ sty ->
+            ppCat [ppStr "here was another import with qualified name", ppPStr q]) sty
+
 unknownImpSpecErr ie imp_mod locn
   = addShortErrLocLine locn (\ sty ->
     ppBesides [ppStr "module ", ppPStr imp_mod, ppStr " does not export `", ppr sty (ie_name ie), ppStr "'"])
diff --git a/ghc/compiler/rename/RnUtils.lhs b/ghc/compiler/rename/RnUtils.lhs
index ba38151367..1825928e20 100644
--- a/ghc/compiler/rename/RnUtils.lhs
+++ b/ghc/compiler/rename/RnUtils.lhs
@@ -19,8 +19,7 @@ module RnUtils (
 	qualNameErr,
 	dupNamesErr,
 	shadowedNameWarn,
-	multipleOccWarn,
-	negateNameWarn
+	multipleOccWarn
     ) where
 
 import Ubiq
@@ -203,9 +202,5 @@ shadowedNameWarn locn shadow
 multipleOccWarn (name, occs) sty
   = ppBesides [ppStr "warning:multiple names used to refer to `", ppr sty name, ppStr "': ",
 	       ppInterleave ppComma (map (ppr sty) occs)]
-
-negateNameWarn (name,locn) 
-  = addShortWarnLocLine locn ( \ sty ->
-    ppBesides [ppStr "local binding of `negate' will be used for prefix `-'"])
 \end{code}