[project @ 1996-05-20 13:15:10 by partain]

[ghc-hetmet.git] / ghc / compiler / rename / RnNames.lhs

diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs
index 0f70372..921cf61 100644 (file)
--- a/ghc/compiler/rename/RnNames.lhs
+++ b/ghc/compiler/rename/RnNames.lhs
@@ -22,7 +22,7 @@ import RnHsSyn
 import RnMonad
 import RnIfaces                ( IfaceCache(..), cachedIface, cachedDecl )
 import RnUtils         ( RnEnv(..), emptyRnEnv, extendGlobalRnEnv,
-                         lubExportFlag, qualNameErr, dupNamesErr, negateNameWarn
+                         lubExportFlag, qualNameErr, dupNamesErr
                        )
 import ParseUtils      ( ParsedIface(..), RdrIfaceDecl(..), RdrIfaceInst )
 
@@ -40,7 +40,7 @@ import Name           ( RdrName(..), Name, isQual, mkTopLevName, origName,
                          pprNonSym, isLexCon, isRdrLexCon, ExportFlag(..)
                        )
 import PrelInfo                ( BuiltinNames(..), BuiltinKeys(..) )
-import PrelMods                ( fromPrelude, pRELUDE )
+import PrelMods                ( fromPrelude, pRELUDE, rATIO, iX )
 import Pretty
 import SrcLoc          ( SrcLoc, mkBuiltinSrcLoc )
 import TyCon           ( tyConDataCons )
@@ -292,7 +292,6 @@ newGlobalName locn maybe_exp rdr
 
        n = mkTopLevName uniq orig locn exp (occ_fn n) -- NB: two "n"s
     in
-    addWarnIfRn (rdr == Unqual SLIT("negate")) (negateNameWarn (rdr, locn)) `thenRn_`
     addErrIfRn (isQual rdr) (qualNameErr "name in definition" (rdr, locn)) `thenRn_`
     returnRn n    
 \end{code}
@@ -348,7 +347,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 +364,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)
@@ -468,7 +482,7 @@ doImport iface_cache info us (ImportDecl mod qual maybe_as maybe_spec src_loc)
 
 
 getBuiltins _ mod maybe_spec
-  | not (fromPrelude mod)
+  | not ((fromPrelude mod) || mod == iX || mod == rATIO )
   = (emptyBag, emptyBag, maybe_spec)
 
 getBuiltins (((b_val_names,b_tc_names),_,_,_),_,_,_) mod maybe_spec
@@ -476,6 +490,7 @@ getBuiltins (((b_val_names,b_tc_names),_,_,_),_,_,_) mod maybe_spec
       Nothing           -> (all_vals, all_tcs, Nothing)
 
       Just (True, ies)  -> -- hiding does not work for builtin names
+                          trace "getBuiltins: import Prelude hiding ( ... )" $
                           (all_vals, all_tcs, maybe_spec)
 
       Just (False, ies) -> let 
@@ -486,15 +501,20 @@ getBuiltins (((b_val_names,b_tc_names),_,_,_),_,_,_) mod maybe_spec
     all_vals = do_all_builtin (fmToList b_val_names)
     all_tcs  = do_all_builtin (fmToList b_tc_names)
 
+    filter_mod = if fromPrelude mod then pRELUDE else mod
+
     do_all_builtin [] = emptyBag
-    do_all_builtin ((str,rn):rest)
+    do_all_builtin (((str,mod),rn):rest)
+      | mod == filter_mod
       = (str, rn) `consBag` do_all_builtin rest
+      | otherwise
+      = do_all_builtin rest
 
     do_builtin [] = (emptyBag,emptyBag,[]) 
     do_builtin (ie:ies)
       = let str = unqual_str (ie_name ie)
        in
-       case (lookupFM b_tc_names str) of -- NB: we favour the tycon/class FM...
+       case (lookupFM b_tc_names (str,mod)) of         -- NB: we favour the tycon/class FM...
          Just rn -> case (ie,rn) of
             (IEThingAbs _, WiredInTyCon tc)
                -> (vals, (str, rn) `consBag` tcs, ies_left)
@@ -503,10 +523,15 @@ getBuiltins (((b_val_names,b_tc_names),_,_,_),_,_,_) mod maybe_spec
                                   (tyConDataCons tc))
                    `unionBags` vals,
                    (str,rn) `consBag` tcs, ies_left)
+            (IEThingWith _ _, WiredInTyCon tc) -- No checking of With...
+               -> (listToBag (map (\ id -> (getLocalName id, WiredInId id)) 
+                                  (tyConDataCons tc))
+                   `unionBags` vals,
+                   (str,rn) `consBag` tcs, ies_left)
             _ -> panic "importing builtin names (1)"
 
          Nothing ->
-           case (lookupFM b_val_names str) of
+           case (lookupFM b_val_names (str,mod)) of
              Nothing -> (vals, tcs, ie:ies_left)
              Just rn -> case (ie,rn) of
                 (IEVar _, WiredInId _)        
@@ -516,7 +541,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 +832,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 "'"])