X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Frename%2FRnMonad.lhs;h=6a6acbb343936011dc008ece537d583aa3132a4d;hb=e7b69c553c58133ddbdc756bec03a43d35b0be5e;hp=22badd8ffe434105c25ea6ff3bed148c5989adb5;hpb=51a571c0f5b0201ea53bec60fcaafb78c01c017e;p=ghc-hetmet.git

diff --git a/ghc/compiler/rename/RnMonad.lhs b/ghc/compiler/rename/RnMonad.lhs
index 22badd8..6a6acbb 100644
--- 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