[project @ 2001-04-30 10:51:18 by simonpj]

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

diff --git a/ghc/compiler/rename/RnMonad.lhs b/ghc/compiler/rename/RnMonad.lhs
index 22badd8..6a6acbb 100644 (file)
--- a/ghc/compiler/rename/RnMonad.lhs
+++ b/ghc/compiler/rename/RnMonad.lhs
@@ -58,7 +58,7 @@ import Name           ( Name, OccName, NamedThing(..),
                          nameOccName,
                          decode, mkLocalName, mkKnownKeyGlobal
                        )
-import NameEnv         ( 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_`
@@ -276,6 +272,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
@@ -569,6 +571,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