[project @ 2004-08-26 15:44:50 by simonpj]
[ghc-hetmet.git] / ghc / compiler / rename / RnNames.lhs
index baa7c74..6781ee7 100644 (file)
@@ -23,14 +23,15 @@ import LoadIface    ( loadSrcInterface )
 import TcRnMonad
 
 import FiniteMap
-import PrelNames       ( pRELUDE_Name, isBuiltInSyntaxName, isUnboundName,
+import PrelNames       ( pRELUDE_Name, isUnboundName,
                          main_RDR_Unqual )
 import Module          ( Module, ModuleName, moduleName, mkPackageModule,
                          moduleNameUserString, isHomeModule,
                          unitModuleEnvByName, unitModuleEnv, 
                          lookupModuleEnvByName, moduleEnvElts )
-import Name            ( Name, nameSrcLoc, nameOccName, nameModuleName,
-                         nameParent, nameParent_maybe, isExternalName, nameModule )
+import Name            ( Name, nameSrcLoc, nameOccName, nameModuleName, isWiredInName,
+                         nameParent, nameParent_maybe, isExternalName, nameModule,
+                         isBuiltInSyntax )
 import NameSet
 import NameEnv
 import OccName         ( srcDataName, isTcOcc, occNameFlavour, OccEnv, 
@@ -53,7 +54,7 @@ import SrcLoc         ( noSrcLoc, Located(..), mkGeneralSrcSpan,
                          unLoc, noLoc, srcLocSpan, SrcSpan )
 import BasicTypes      ( DeprecTxt )
 import ListSetOps      ( removeDups )
-import Util            ( sortLt, notNull, isSingleton )
+import Util            ( sortLe, notNull, isSingleton )
 import List            ( partition )
 import IO              ( openFile, IOMode(..) )
 \end{code}
@@ -71,32 +72,32 @@ rnImports :: [LImportDecl RdrName]
          -> RnM (GlobalRdrEnv, ImportAvails)
 
 rnImports imports
-  =            -- PROCESS IMPORT DECLS
+  = do {       -- PROCESS IMPORT DECLS
                -- Do the non {- SOURCE -} ones first, so that we get a helpful
                -- warning for {- SOURCE -} ones that are unnecessary
-       getModule                               `thenM` \ this_mod ->
-       doptM Opt_NoImplicitPrelude             `thenM` \ opt_no_prelude -> 
-       let
-         all_imports        = mk_prel_imports this_mod opt_no_prelude ++ imports
-         (source, ordinary) = partition is_source_import all_imports
-         is_source_import (L _ (ImportDecl _ is_boot _ _ _)) = is_boot
-
-         get_imports = importsFromImportDecl this_mod
-       in
-       mappM get_imports ordinary      `thenM` \ stuff1 ->
-       mappM get_imports source        `thenM` \ stuff2 ->
+         this_mod <- getModule
+       ; opt_no_prelude <- doptM Opt_NoImplicitPrelude
+       ; let
+           all_imports      = mk_prel_imports this_mod opt_no_prelude ++ imports
+           (source, ordinary) = partition is_source_import all_imports
+           is_source_import (L _ (ImportDecl _ is_boot _ _ _)) = is_boot
+
+           get_imports = importsFromImportDecl this_mod
+
+       ; stuff1 <- mappM get_imports ordinary
+       ; stuff2 <- mappM get_imports source
 
                -- COMBINE RESULTS
-       let
+       ; let
            (imp_gbl_envs, imp_avails) = unzip (stuff1 ++ stuff2)
            gbl_env :: GlobalRdrEnv
            gbl_env = foldr plusGlobalRdrEnv emptyGlobalRdrEnv imp_gbl_envs
 
            all_avails :: ImportAvails
            all_avails = foldr plusImportAvails emptyImportAvails imp_avails
-       in
+
                -- ALL DONE
-       returnM (gbl_env, all_avails)
+       ; return (gbl_env, all_avails) }
   where
        -- NB: opt_NoImplicitPrelude is slightly different to import Prelude ();
        -- because the former doesn't even look at Prelude.hi for instance 
@@ -336,10 +337,10 @@ importsFromLocalDecls group
 
        avails' | implicit_prelude = filter not_built_in_syntax avails
                | otherwise        = avails
-       not_built_in_syntax a = not (all isBuiltInSyntaxName (availNames a))
+       not_built_in_syntax a = not (all isBuiltInSyntax (availNames a))
                -- Only filter it if all the names of the avail are built-in
                -- In particular, lists have (:) which is not built in syntax
-               -- so we don't filter it out.  [Sept 03: wrong: see isBuiltInSyntaxName]
+               -- so we don't filter it out.  [Sept 03: wrong: see isBuiltInSyntax]
 
        avail_env = mkAvailEnv avails'
        imports   = emptyImportAvails {
@@ -728,8 +729,7 @@ check_occs ie occs names
 reportDeprecations :: TcGblEnv -> RnM ()
 reportDeprecations tcg_env
   = ifOptM Opt_WarnDeprecations        $
-    do { hpt <- getHpt
-       ; eps <- getEps
+    do { (eps,hpt) <- getEpsAndHpt
        ; mapM_ (check hpt (eps_PIT eps)) all_gres }
   where
     used_names = findUses (tcg_dus tcg_env) emptyNameSet
@@ -765,7 +765,13 @@ lookupDeprec hpt pit n
   = case lookupIface hpt pit (nameModule n) of
        Just iface -> mi_dep_fn iface n `seqMaybe`      -- Bleat if the thing, *or
                      mi_dep_fn iface (nameParent n)    -- its parent*, is deprec'd
-       Nothing    -> pprPanic "lookupDeprec" (ppr n)   
+       Nothing    
+         | isWiredInName n -> Nothing
+               -- We have not necessarily loaded the .hi file for a 
+               -- wired-in name (yet), although we *could*.
+               -- And we never deprecate them
+
+        | otherwise -> pprPanic "lookupDeprec" (ppr n) 
                -- By now all the interfaces should have been loaded
 
 gre_is_used :: NameSet -> GlobalRdrElt -> Bool
@@ -1005,8 +1011,11 @@ addDupDeclErr (n:ns)
          nest 2 (ptext SLIT("other declarations at:")),
          nest 4 (vcat (map ppr sorted_locs))]
   where
-    sorted_locs = sortLt occ'ed_before (map nameSrcLoc ns)
-    occ'ed_before a b = LT == compare a b
+    sorted_locs = sortLe occ'ed_before (map nameSrcLoc ns)
+    occ'ed_before a b = case compare a b of
+                         LT -> True
+                         EQ -> True
+                         GT -> False
 
 dupExportWarn occ_name ie1 ie2
   = hsep [quotes (ppr occ_name),