[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 10ea30a..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}
@@ -483,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
@@ -491,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 
@@ -501,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)
@@ -518,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 _)