[project @ 2000-10-31 12:07:43 by simonpj]
[ghc-hetmet.git] / ghc / compiler / rename / RnMonad.lhs
index bb8c295..a1b9d77 100644 (file)
@@ -35,12 +35,12 @@ import IOExts               ( IORef, newIORef, readIORef, writeIORef, unsafePerformIO )
 import HsSyn           
 import RdrHsSyn
 import RnHsSyn         ( RenamedFixitySig )
-import HscTypes                ( AvailEnv, lookupTypeEnv,
+import HscTypes                ( AvailEnv, lookupType,
                          OrigNameEnv(..), OrigNameNameEnv, OrigNameIParamEnv,
                          WhetherHasOrphans, ImportVersion, 
                          PersistentRenamerState(..), IsBootInterface, Avails,
                          DeclsMap, IfaceInsts, IfaceRules, 
-                         HomeSymbolTable, PackageSymbolTable,
+                         HomeSymbolTable, PackageTypeEnv,
                          PersistentCompilerState(..), GlobalRdrEnv,
                          HomeIfaceTable, PackageIfaceTable,
                          RdrAvailInfo )
@@ -53,12 +53,11 @@ import RdrName              ( RdrName, dummyRdrVarName, rdrNameModule, rdrNameOcc,
                          addListToRdrEnv, rdrEnvToList, rdrEnvElts
                        )
 import Name            ( Name, OccName, NamedThing(..), getSrcLoc,
-                         isLocallyDefinedName, nameOccName,
-                         decode, mkLocalName, mkKnownKeyGlobal,
-                         NameEnv, lookupNameEnv, emptyNameEnv, unitNameEnv, 
-                         extendNameEnvList
+                         nameOccName,
+                         decode, mkLocalName, mkKnownKeyGlobal
                        )
-import Module          ( Module, ModuleName )
+import Name            ( NameEnv, lookupNameEnv, emptyNameEnv, unitNameEnv, extendNameEnvList )
+import Module          ( Module, ModuleName, ModuleSet, emptyModuleSet )
 import NameSet         
 import CmdLineOpts     ( DynFlags, DynFlag(..), dopt )
 import SrcLoc          ( SrcLoc, generatedSrcLoc, noSrcLoc )
@@ -68,7 +67,7 @@ import Bag            ( Bag, emptyBag, isEmptyBag, snocBag )
 import UniqSupply
 import Outputable
 import PrelNames       ( mkUnboundName )
-import Maybes          ( maybeToBool, seqMaybe )
+import Maybes          ( maybeToBool )
 import ErrUtils                ( printErrorsAndWarnings )
 
 infixr 9 `thenRn`, `thenRn_`
@@ -86,6 +85,12 @@ ioToRnM :: IO r -> RnM d (Either IOError r)
 ioToRnM io rn_down g_down = (io >>= \ ok -> return (Right ok)) 
                            `catch` 
                            (\ err -> return (Left err))
+
+ioToRnM_no_fail :: IO r -> RnM d r
+ioToRnM_no_fail io rn_down g_down 
+   = (io >>= \ ok -> return ok) 
+     `catch` 
+     (\ err -> panic "ioToRnM_no_fail: the I/O operation failed!")
            
 traceRn :: SDoc -> RnM d ()
 traceRn msg
@@ -139,7 +144,7 @@ data RnDown
 data SDown = SDown {
                  rn_mode :: RnMode,
 
-                 rn_genv :: GlobalRdrEnv,      -- Global envt
+                 rn_genv :: GlobalRdrEnv,      -- Top level environment
 
                  rn_lenv :: LocalRdrEnv,       -- Local name envt
                        --   Does *not* include global name envt; may shadow it
@@ -149,9 +154,10 @@ data SDown = SDown {
                        -- We still need the unsullied global name env so that
                        --   we can look up record field names
 
-                 rn_fixenv :: LocalFixityEnv   -- Local fixities
+                 rn_fixenv :: LocalFixityEnv   -- Local fixities (for non-top-level
+                                               -- declarations)
                        -- The global fixities are held in the
-                       -- rn_ifaces field.  Why?  See the comments
+                       -- HIT or PIT.  Why?  See the comments
                        -- with RnIfaces.lookupLocalFixity
                }
 
@@ -261,19 +267,24 @@ data Ifaces = Ifaces {
                -- All the names (whether "big" or "small", whether wired-in or not,
                -- whether locally defined or not) that have been slurped in so far.
 
-       iVSlurp :: [Name]
-               -- All the (a) non-wired-in (b) "big" (c) non-locally-defined 
+       iVSlurp :: (ModuleSet, NameSet)
+               -- The Names are all the (a) non-wired-in
+               --                       (b) "big"
+               --                       (c) non-locally-defined
+               --                       (d) home-package
                -- names that have been slurped in so far, with their versions.
                -- This is used to generate the "usage" information for this module.
                -- Subset of the previous field.
+               -- The module set is the non-home-package modules from which we have
+               -- slurped at least one name.
                -- It's worth keeping separately, because there's no very easy 
                -- way to distinguish the "big" names from the "non-big" ones.
                -- But this is a decision we might want to revisit.
     }
 
-type ImportedModuleInfo = FiniteMap ModuleName 
-                                   (WhetherHasOrphans, IsBootInterface, IsLoaded)
-type IsLoaded = Bool
+type ImportedModuleInfo = FiniteMap ModuleName (WhetherHasOrphans, IsBootInterface)
+       -- Contains info ONLY about modules that have not yet
+       --- been loaded into the iPIT
 \end{code}
 
 
@@ -295,7 +306,7 @@ initRn :: DynFlags
 initRn dflags hit hst pcs mod do_rn
   = do 
        let prs = pcs_PRS pcs
-       let pst = pcs_PST pcs
+       let pte = pcs_PTE pcs
        let ifaces = Ifaces { iPIT   = pcs_PIT pcs,
                              iDecls = prsDecls prs,
                              iInsts = prsInsts prs,
@@ -306,7 +317,7 @@ initRn dflags hit hst pcs mod do_rn
                                -- Pretend that the dummy unbound name has already been
                                -- slurped.  This is what's returned for an out-of-scope name,
                                -- and we don't want thereby to try to suck it in!
-                             iVSlurp = []
+                             iVSlurp = (emptyModuleSet, emptyNameSet)
                      }
         let uniqs = prsNS prs
 
@@ -319,7 +330,7 @@ initRn dflags hit hst pcs mod do_rn
        
                               rn_dflags = dflags,
                               rn_hit    = hit,
-                              rn_done   = is_done hst pst,
+                              rn_done   = is_done hst pte,
                                             
                               rn_ns     = names_var, 
                               rn_errs   = errs_var, 
@@ -347,11 +358,14 @@ initRn dflags hit hst pcs mod do_rn
 
        return (new_pcs, not (isEmptyBag errs), res)
 
-is_done :: HomeSymbolTable -> PackageSymbolTable -> Name -> Bool
+is_done :: HomeSymbolTable -> PackageTypeEnv -> Name -> Bool
 -- Returns True iff the name is in either symbol table
-is_done hst pst n = maybeToBool (lookupTypeEnv pst n `seqMaybe` lookupTypeEnv hst n)
+-- The name is a Global, so it has a Module
+is_done hst pte n = maybeToBool (lookupType hst pte n)
 
 initRnMS rn_env fixity_env mode thing_inside rn_down g_down
+       -- The fixity_env appears in both the rn_fixenv field
+       -- and in the HIT.  See comments with RnHiFiles.lookupFixityRn
   = let
        s_down = SDown { rn_genv = rn_env, rn_lenv = emptyRdrEnv, 
                         rn_fixenv = fixity_env, rn_mode = mode }
@@ -362,7 +376,6 @@ initIfaceRnMS :: Module -> RnMS r -> RnM d r
 initIfaceRnMS mod thing_inside 
   = initRnMS emptyRdrEnv emptyNameEnv InterfaceMode $
     setModuleRn mod thing_inside
-
 \end{code}
 
 @renameSourceCode@ is used to rename stuff ``out-of-line'';
@@ -577,6 +590,7 @@ getHomeIfaceTableRn :: RnM d HomeIfaceTable
 getHomeIfaceTableRn down l_down = return (rn_hit down)
 
 checkAlreadyAvailable :: Name -> RnM d Bool
+       -- Name is a Global name
 checkAlreadyAvailable name down l_down = return (rn_done down name)
 \end{code}