[project @ 2001-06-22 13:30:18 by rrt]

[ghc-hetmet.git] / ghc / compiler / rename / RnMonad.lhs

diff --git a/ghc/compiler/rename/RnMonad.lhs b/ghc/compiler/rename/RnMonad.lhs
index 2a795e5..7e8c679 100644 (file)
--- a/ghc/compiler/rename/RnMonad.lhs
+++ b/ghc/compiler/rename/RnMonad.lhs
@@ -42,7 +42,7 @@ import HscTypes               ( AvailEnv, lookupType,
                          PersistentRenamerState(..), Avails,
                          DeclsMap, IfaceInsts, IfaceRules, 
                          HomeSymbolTable, TyThing,
-                         PersistentCompilerState(..), GlobalRdrEnv,
+                         PersistentCompilerState(..), GlobalRdrEnv, LocalRdrEnv,
                          HomeIfaceTable, PackageIfaceTable,
                          RdrAvailInfo )
 import BasicTypes      ( Version, defaultFixity )
@@ -58,7 +58,7 @@ import Name           ( Name, OccName, NamedThing(..),
                          nameOccName,
                          decode, mkLocalName, mkKnownKeyGlobal
                        )
-import Name            ( NameEnv, lookupNameEnv, emptyNameEnv, unitNameEnv, extendNameEnvList )
+import NameEnv         ( NameEnv, lookupNameEnv, emptyNameEnv, extendNameEnvList )
 import Module          ( Module, ModuleName, ModuleSet, emptyModuleSet )
 import NameSet         
 import CmdLineOpts     ( DynFlags, DynFlag(..), dopt )
@@ -93,14 +93,10 @@ ioToRnM_no_fail io rn_down g_down
      (\ err -> panic "ioToRnM_no_fail: the I/O operation failed!")
            
 traceRn :: SDoc -> RnM d ()
-traceRn msg
-   = doptRn Opt_D_dump_rn_trace `thenRn` \b ->
-     if b then putDocRn msg else returnRn ()
+traceRn msg = ifOptRn Opt_D_dump_rn_trace (putDocRn msg)
 
 traceHiDiffsRn :: SDoc -> RnM d ()
-traceHiDiffsRn msg
-   = doptRn Opt_D_dump_hi_diffs `thenRn` \b ->
-     if b then putDocRn msg else returnRn ()
+traceHiDiffsRn msg = ifOptRn Opt_D_dump_hi_diffs (putDocRn msg)
 
 putDocRn :: SDoc -> RnM d ()
 putDocRn msg = ioToRnM (printErrs alwaysQualify msg)   `thenRn_`
@@ -166,8 +162,15 @@ 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
+
+isCmdLineMode CmdLineMode = True
+isCmdLineMode _ = False
 \end{code}
 
 %===================================================
@@ -176,7 +179,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
@@ -273,6 +275,12 @@ data Ifaces = Ifaces {
        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.
+               --
+               -- It's used for two things:
+               --      a) To record what we've already slurped, so
+               --         we can no-op if we try to slurp it again
+               --      b) As the 'gates' for importing rules.  We import a rule
+               --         if all its LHS free vars have been slurped
 
        iVSlurp :: (ModuleSet, NameSet)
                -- The Names are all the (a) non-wired-in
@@ -360,21 +368,21 @@ initRn dflags hit hst pcs mod do_rn
        
        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}
 
@@ -566,6 +574,11 @@ doptRn :: DynFlag -> RnM d Bool
 doptRn dflag (RnDown { rn_dflags = dflags}) l_down
    = return (dopt dflag dflags)
 
+ifOptRn :: DynFlag -> RnM d a -> RnM d ()
+ifOptRn dflag thing_inside down@(RnDown { rn_dflags = dflags}) l_down
+  | dopt dflag dflags = thing_inside down l_down >> return ()
+  | otherwise        = return ()
+
 getDOptsRn :: RnM d DynFlags
 getDOptsRn (RnDown { rn_dflags = dflags}) l_down
    = return dflags