Refactor TcRnDriver, and check exports on hi-boot files
[ghc-hetmet.git] / compiler / rename / RnNames.lhs
index d85089f..6c35ef1 100644 (file)
@@ -8,7 +8,7 @@ module RnNames (
        rnImports, importsFromLocalDecls,
        rnExports,
        getLocalDeclBinders, extendRdrEnvRn,
-       reportUnusedNames, reportDeprecations
+       reportUnusedNames, finishDeprecations
     ) where
 
 #include "HsVersions.h"
@@ -143,7 +143,7 @@ rnImportDecl this_mod (L loc (ImportDecl loc_imp_mod_name want_boot
     let
        imp_mod    = mi_module iface
        deprecs    = mi_deprecs iface
-       is_orph    = mi_orphan iface 
+       orph_iface = mi_orphan iface 
        has_finsts = mi_finsts iface 
        deps       = mi_deps iface
 
@@ -186,9 +186,9 @@ rnImportDecl this_mod (L loc (ImportDecl loc_imp_mod_name want_boot
     let
        -- Compute new transitive dependencies
 
-       orphans | is_orph   = ASSERT( not (imp_mod `elem` dep_orphs deps) )
-                             imp_mod : dep_orphs deps
-               | otherwise = dep_orphs deps
+       orphans | orph_iface = ASSERT( not (imp_mod `elem` dep_orphs deps) )
+                              imp_mod : dep_orphs deps
+               | otherwise  = dep_orphs deps
 
        finsts | has_finsts = ASSERT( not (imp_mod `elem` dep_finsts deps) )
                              imp_mod : dep_finsts deps
@@ -688,41 +688,44 @@ type ExportOccMap = OccEnv (Name, IE RdrName)
        --   it came from.  It's illegal to export two distinct things
        --   that have the same occurrence name
 
-rnExports :: Bool    -- False => no 'module M(..) where' header at all
+rnExports :: Bool      -- False => no 'module M(..) where' header at all
           -> Maybe [LIE RdrName]        -- Nothing => no explicit export list
-          -> RnM (Maybe [LIE Name], [AvailInfo])
+         -> TcGblEnv
+          -> RnM TcGblEnv
 
        -- Complains if two distinct exports have same OccName
         -- Warns about identical exports.
        -- Complains about exports items not in scope
 
-rnExports explicit_mod exports
- = do TcGblEnv { tcg_mod     = this_mod,
-                 tcg_rdr_env = rdr_env, 
-                 tcg_imports = imports } <- getGblEnv
-
+rnExports explicit_mod exports 
+         tcg_env@(TcGblEnv { tcg_mod     = this_mod,
+                             tcg_rdr_env = rdr_env, 
+                             tcg_imports = imports })
+ = do  {  
        -- If the module header is omitted altogether, then behave
        -- as if the user had written "module Main(main) where..."
        -- EXCEPT in interactive mode, when we behave as if he had
        -- written "module Main where ..."
        -- Reason: don't want to complain about 'main' not in scope
        --         in interactive mode
-      ghc_mode <- getGhcMode
-      real_exports <- 
-          case () of
-            () | explicit_mod
-                   -> return exports
-               | ghc_mode == Interactive
-                   -> return Nothing
-               | otherwise
-                   -> do mainName <- lookupGlobalOccRn main_RDR_Unqual
-                         return (Just ([noLoc (IEVar main_RDR_Unqual)]))
-               -- ToDo: the 'noLoc' here is unhelpful if 'main' turns
-               -- out to be out of scope
-
-      (exp_spec, avails) <- exports_from_avail real_exports rdr_env imports this_mod
-
-      return (exp_spec, nubAvails avails)     -- Combine families
+       ; ghc_mode <- getGhcMode
+       ; let real_exports 
+                | explicit_mod            = exports
+                | ghc_mode == Interactive = Nothing
+                | otherwise = Just ([noLoc (IEVar main_RDR_Unqual)])
+                       -- ToDo: the 'noLoc' here is unhelpful if 'main' 
+                       --       turns out to be out of scope
+
+       ; (rn_exports, avails) <- exports_from_avail real_exports rdr_env imports this_mod
+       ; let final_avails = nubAvails avails        -- Combine families
+       
+       ; return (tcg_env { tcg_exports    = final_avails,
+                            tcg_rn_exports = case tcg_rn_exports tcg_env of
+                                               Nothing -> Nothing
+                                               Just _  -> rn_exports,
+                           tcg_dus = tcg_dus tcg_env `plusDU` 
+                                     usesOnly (availsToNameSet final_avails) }) }
+
 
 exports_from_avail :: Maybe [LIE RdrName]
                          -- Nothing => no explicit export list
@@ -904,13 +907,23 @@ check_occs ie occs names
 %*********************************************************
 
 \begin{code}
-reportDeprecations :: DynFlags -> TcGblEnv -> RnM ()
-reportDeprecations dflags tcg_env
-  = ifOptM Opt_WarnDeprecations        $
-    do { (eps,hpt) <- getEpsAndHpt
+finishDeprecations :: DynFlags -> Maybe DeprecTxt 
+                  -> TcGblEnv -> RnM TcGblEnv
+-- (a) Report usasge of deprecated imports
+-- (b) If the whole module is deprecated, update tcg_deprecs
+--             All this happens only once per module
+finishDeprecations dflags mod_deprec tcg_env
+  = do { (eps,hpt) <- getEpsAndHpt
+       ; ifOptM Opt_WarnDeprecations   $
+         mapM_ (check hpt (eps_PIT eps)) all_gres
                -- By this time, typechecking is complete, 
                -- so the PIT is fully populated
-       ; mapM_ (check hpt (eps_PIT eps)) all_gres }
+
+       -- Deal with a module deprecation; it overrides all existing deprecs
+       ; let new_deprecs = case mod_deprec of
+                               Just txt -> DeprecAll txt
+                               Nothing  -> tcg_deprecs tcg_env
+       ; return (tcg_env { tcg_deprecs = new_deprecs }) }
   where
     used_names = allUses (tcg_dus tcg_env) 
        -- Report on all deprecated uses; hence allUses
@@ -949,18 +962,34 @@ lookupImpDeprec dflags hpt pit gre
                      case gre_par gre of       
                        ParentIs p -> mi_dep_fn iface p -- its parent*, is deprec'd
                        NoParent   -> Nothing
-       Nothing    
-         | isWiredInName name -> 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 name)      
-               -- By now all the interfaces should have been loaded
+
+       Nothing -> Nothing      -- See Note [Used names with interface not loaded]
   where
        name = gre_name gre
 \end{code}
 
+Note [Used names with interface not loaded]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+By now all the interfaces should have been loaded,
+because reportDeprecations happens after typechecking.
+However, it's still (just) possible to to find a used 
+Name whose interface hasn't been loaded:
+
+a) It might be a WiredInName; in that case we may not load 
+   its interface (although we could).
+
+b) It might be GHC.Real.fromRational, or GHC.Num.fromInteger
+   These are seen as "used" by the renamer (if -fno-implicit-prelude) 
+   is on), but the typechecker may discard their uses 
+   if in fact the in-scope fromRational is GHC.Read.fromRational,
+   (see tcPat.tcOverloadedLit), and the typechecker sees that the type 
+   is fixed, say, to GHC.Base.Float (see Inst.lookupSimpleInst).
+   In that obscure case it won't force the interface in.
+
+In both cases we simply don't permit deprecations; 
+this is, after all, wired-in stuff.
+
+
 %*********************************************************
 %*                                                      *
                Unused names