[project @ 2001-03-08 12:07:38 by simonpj]
[ghc-hetmet.git] / ghc / compiler / rename / RnMonad.lhs
index 51319d1..22badd8 100644 (file)
@@ -37,12 +37,12 @@ import HsSyn
 import RdrHsSyn
 import RnHsSyn         ( RenamedFixitySig )
 import HscTypes                ( AvailEnv, lookupType,
-                         OrigNameEnv(..), OrigNameNameEnv, OrigNameIParamEnv,
-                         WhetherHasOrphans, ImportVersion, 
-                         PersistentRenamerState(..), IsBootInterface, Avails,
+                         NameSupply(..), 
+                         ImportedModuleInfo, WhetherHasOrphans, ImportVersion, 
+                         PersistentRenamerState(..), Avails,
                          DeclsMap, IfaceInsts, IfaceRules, 
                          HomeSymbolTable, TyThing,
-                         PersistentCompilerState(..), GlobalRdrEnv,
+                         PersistentCompilerState(..), GlobalRdrEnv, LocalRdrEnv,
                          HomeIfaceTable, PackageIfaceTable,
                          RdrAvailInfo )
 import BasicTypes      ( Version, defaultFixity )
@@ -58,13 +58,13 @@ import Name         ( Name, OccName, NamedThing(..),
                          nameOccName,
                          decode, mkLocalName, mkKnownKeyGlobal
                        )
-import Name            ( NameEnv, lookupNameEnv, emptyNameEnv, unitNameEnv, extendNameEnvList )
+import NameEnv         ( NameEnv, lookupNameEnv, emptyNameEnv, unitNameEnv, extendNameEnvList )
 import Module          ( Module, ModuleName, ModuleSet, emptyModuleSet )
 import NameSet         
 import CmdLineOpts     ( DynFlags, DynFlag(..), dopt )
 import SrcLoc          ( SrcLoc, generatedSrcLoc, noSrcLoc )
 import Unique          ( Unique )
-import FiniteMap       ( FiniteMap, emptyFM )
+import FiniteMap       ( FiniteMap )
 import Bag             ( Bag, emptyBag, isEmptyBag, snocBag )
 import UniqSupply
 import Outputable
@@ -141,9 +141,7 @@ data RnDown
                        -- so it has a Module, so it can be looked up
 
        rn_errs    :: IORef Messages,
-
-       -- The second and third components are a flattened-out OrigNameEnv
-       rn_ns      :: IORef (UniqSupply, OrigNameNameEnv, OrigNameIParamEnv),
+       rn_ns      :: IORef NameSupply,
        rn_ifaces  :: IORef Ifaces
     }
 
@@ -168,8 +166,12 @@ data SDown = SDown {
                        -- with RnIfaces.lookupLocalFixity
                }
 
-data RnMode    = SourceMode                    -- Renaming source code
-               | InterfaceMode                 -- Renaming interface declarations.  
+data RnMode    = SourceMode            -- Renaming source code
+               | InterfaceMode         -- Renaming interface declarations.  
+               | CmdLineMode           -- Renaming a command-line expression
+
+isInterfaceMode InterfaceMode = True
+isInterfaceMode _ = False
 \end{code}
 
 %===================================================
@@ -178,7 +180,6 @@ data RnMode = SourceMode                    -- Renaming source code
 
 \begin{code}
 --------------------------------
-type LocalRdrEnv    = RdrNameEnv Name
 type LocalFixityEnv = NameEnv RenamedFixitySig
        -- We keep the whole fixity sig so that we
        -- can report line-number info when there is a duplicate
@@ -253,6 +254,11 @@ data Ifaces = Ifaces {
                -- package symbol table, and the renamer incrementally adds
                -- to it.
 
+       iImpModInfo :: ImportedModuleInfo,
+                       -- Modules that we know something about, because they are mentioned
+                       -- in interface files, BUT which we have not loaded yet.  
+                       -- No module is both in here and in the PIT
+
        iDecls :: DeclsMap,     
                -- A single, global map of Names to unslurped decls
 
@@ -267,11 +273,6 @@ data Ifaces = Ifaces {
 
     -- EPHEMERAL FIELDS
     -- These fields persist during the compilation of a single module only
-       iImpModInfo :: ImportedModuleInfo,
-                       -- Modules that we know something about, because they are mentioned
-                       -- in interface files, BUT which we have not loaded yet.  
-                       -- No module is both in here and in the PIT
-
        iSlurp :: NameSet,
                -- All the names (whether "big" or "small", whether wired-in or not,
                -- whether locally defined or not) that have been slurped in so far.
@@ -284,16 +285,13 @@ data Ifaces = Ifaces {
                -- 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)
-       -- Contains info ONLY about modules that have not yet
-       --- been loaded into the iPIT
 \end{code}
 
 
@@ -326,17 +324,14 @@ initRn dflags hit hst pcs mod do_rn
                              iInsts = prsInsts prs,
                              iRules = prsRules prs,
 
-                             iImpModInfo = emptyFM,
+                             iImpModInfo = prsImpMods prs,
                              iSlurp      = unitNameSet (mkUnboundName dummyRdrVarName),
                                -- 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 = (emptyModuleSet, emptyNameSet)
                      }
-        let uniqs = prsNS prs
-
-       names_var <- newIORef (uniqs, origNames (prsOrig prs), 
-                                     origIParam (prsOrig prs))
+       names_var <- newIORef (prsOrig prs)
        errs_var  <- newIORef (emptyBag,emptyBag)
        iface_var <- newIORef ifaces
        let rn_down = RnDown { rn_mod = mod,
@@ -355,35 +350,34 @@ initRn dflags hit hst pcs mod do_rn
        res <- do_rn rn_down ()
        
        -- Grab state and record it
-       (warns, errs)                   <- readIORef errs_var
-       new_ifaces                      <- readIORef iface_var
-       (new_NS, new_origN, new_origIP) <- readIORef names_var
-       let new_orig = Orig { origNames = new_origN, origIParam = new_origIP }
-       let new_prs = prs { prsOrig = new_orig,
-                           prsDecls = iDecls new_ifaces,
-                           prsInsts = iInsts new_ifaces,
-                           prsRules = iRules new_ifaces,
-                           prsNS    = new_NS }
+       (warns, errs)   <- readIORef errs_var
+       new_ifaces      <- readIORef iface_var
+       new_orig        <- readIORef names_var
+       let new_prs = prs { prsOrig    = new_orig,
+                           prsImpMods = iImpModInfo new_ifaces,
+                           prsDecls   = iDecls new_ifaces,
+                           prsInsts   = iInsts new_ifaces,
+                           prsRules   = iRules new_ifaces }
        let new_pcs = pcs { pcs_PIT = iPIT new_ifaces, 
                            pcs_PRS = new_prs }
        
        return (new_pcs, (warns, errs), res)
 
-initRnMS :: GlobalRdrEnv -> LocalFixityEnv -> RnMode
+initRnMS :: GlobalRdrEnv -> LocalRdrEnv -> LocalFixityEnv -> RnMode
         -> RnMS a -> RnM d a
 
-initRnMS rn_env fixity_env mode thing_inside rn_down g_down
+initRnMS rn_env local_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, 
+       s_down = SDown { rn_genv = rn_env, rn_lenv = local_env, 
                         rn_fixenv = fixity_env, rn_mode = mode }
     in
     thing_inside rn_down s_down
 
 initIfaceRnMS :: Module -> RnMS r -> RnM d r
 initIfaceRnMS mod thing_inside 
-  = initRnMS emptyRdrEnv emptyLocalFixityEnv InterfaceMode $
+  = initRnMS emptyRdrEnv emptyRdrEnv emptyLocalFixityEnv InterfaceMode $
     setModuleRn mod thing_inside
 \end{code}
 
@@ -409,8 +403,7 @@ renameDerivedCode dflags mod prs thing_inside
        -- and that doesn't happen in pragmas etc
 
     do { us <- mkSplitUniqSupply 'r'
-       ; names_var <- newIORef (us, origNames (prsOrig prs), 
-                                origIParam (prsOrig prs))
+       ; names_var <- newIORef ((prsOrig prs) { nsUniqs = us })
        ; errs_var <- newIORef (emptyBag,emptyBag)
 
        ; let rn_down = RnDown { rn_dflags = dflags,
@@ -613,21 +606,21 @@ getTypeEnvRn down l_down = return (rn_done down)
 %=====================
 
 \begin{code}
-getNameSupplyRn :: RnM d (UniqSupply, OrigNameNameEnv, OrigNameIParamEnv)
+getNameSupplyRn :: RnM d NameSupply
 getNameSupplyRn rn_down l_down
   = readIORef (rn_ns rn_down)
 
-setNameSupplyRn :: (UniqSupply, OrigNameNameEnv, OrigNameIParamEnv) -> RnM d ()
+setNameSupplyRn :: NameSupply -> RnM d ()
 setNameSupplyRn names' (RnDown {rn_ns = names_var}) l_down
   = writeIORef names_var names'
 
 getUniqRn :: RnM d Unique
 getUniqRn (RnDown {rn_ns = names_var}) l_down
- = readIORef names_var >>= \ (us, cache, ipcache) ->
+ = readIORef names_var >>= \ ns ->
    let
-     (us1,us') = splitUniqSupply us
+     (us1,us') = splitUniqSupply (nsUniqs ns)
    in
-   writeIORef names_var (us', cache, ipcache)  >>
+   writeIORef names_var (ns {nsUniqs = us'})   >>
    return (uniqFromSupply us1)
 \end{code}