X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcRnMonad.lhs;h=a7c930d33f233969f028882d4d0639a230da0b2a;hb=79011516105291b58324ce71a87f6bb26a131090;hp=d7988e8d7b49c6fb5ddf48224e4bc5550799c1ec;hpb=62c2f621075d07e043503c8d8e357bbb90158431;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs
index d7988e8..a7c930d 100644
--- a/compiler/typecheck/TcRnMonad.lhs
+++ b/compiler/typecheck/TcRnMonad.lhs
@@ -16,8 +16,6 @@ module TcRnMonad(
 	module IOEnv
   ) where
 
-#include "HsVersions.h"
-
 import TcRnTypes	-- Re-export all
 import IOEnv		-- Re-export all
 
@@ -44,11 +42,12 @@ import Bag
 import Outputable
 import UniqSupply
 import Unique
-import UniqFM
+import LazyUniqFM
 import DynFlags
 import StaticFlags
 import FastString
 import Panic
+import Util
  
 import System.IO
 import Data.IORef
@@ -65,11 +64,6 @@ import Control.Monad
 %************************************************************************
 
 \begin{code}
-ioToTcRn :: IO r -> TcRn r
-ioToTcRn = liftIO
-\end{code}
-
-\begin{code}
 
 initTc :: HscEnv
        -> HscSource
@@ -128,7 +122,7 @@ initTc hsc_env hsc_src keep_rn_syntax mod do_this
 	     } ;
 	     lcl_env = TcLclEnv {
 		tcl_errs       = errs_var,
-		tcl_loc	       = mkGeneralSrcSpan FSLIT("Top level"),
+		tcl_loc	       = mkGeneralSrcSpan (fsLit "Top level"),
 		tcl_ctxt       = [],
 		tcl_rdr	       = emptyLocalRdrEnv,
 		tcl_th_ctxt    = topStage,
@@ -373,7 +367,7 @@ traceOptTcRn flag doc = ifOptM flag $ do
 dumpTcRn :: SDoc -> TcRn ()
 dumpTcRn doc = do { rdr_env <- getGlobalRdrEnv ;
                     dflags <- getDOpts ;
-		    ioToTcRn (printForUser stderr (mkPrintUnqualified dflags rdr_env) doc) }
+		    liftIO (printForUser stderr (mkPrintUnqualified dflags rdr_env) doc) }
 
 dumpOptTcRn :: DynFlag -> SDoc -> TcRn ()
 dumpOptTcRn flag doc = ifOptM flag (dumpTcRn doc)
@@ -479,7 +473,7 @@ addErrAt loc msg = addLongErrAt loc msg empty
 
 addLongErrAt :: SrcSpan -> Message -> Message -> TcRn ()
 addLongErrAt loc msg extra
-  = do { traceTc (ptext SLIT("Adding error:") <+> (mkLocMessage loc (msg $$ extra))) ;	
+  = do { traceTc (ptext (sLit "Adding error:") <+> (mkLocMessage loc (msg $$ extra))) ;	
 	 errs_var <- getErrsVar ;
 	 rdr_env <- getGlobalRdrEnv ;
          dflags <- getDOpts ;
@@ -505,10 +499,10 @@ addReportAt loc msg
   	 writeMutVar errs_var (warns `snocBag` warn, errs) }
 
 addWarn :: Message -> TcRn ()
-addWarn msg = addReport (ptext SLIT("Warning:") <+> msg)
+addWarn msg = addReport (ptext (sLit "Warning:") <+> msg)
 
 addWarnAt :: SrcSpan -> Message -> TcRn ()
-addWarnAt loc msg = addReportAt loc (ptext SLIT("Warning:") <+> msg)
+addWarnAt loc msg = addReportAt loc (ptext (sLit "Warning:") <+> msg)
 
 addLocWarn :: Located e -> (e -> Message) -> TcRn ()
 addLocWarn (L loc e) fn = addReportAt loc (fn e)
@@ -651,7 +645,7 @@ checkNoErrs main
   = do	{ (msgs, mb_res) <- tryTcLIE main
 	; addMessages msgs
 	; case mb_res of
-	    Nothing   -> failM
+	    Nothing  -> failM
 	    Just val -> return val
 	} 
 
@@ -765,7 +759,7 @@ addWarnTcM :: (TidyEnv, Message) -> TcM ()
 addWarnTcM (env0, msg)
  = do { ctxt <- getErrCtxt ;
 	ctxt_msgs <- do_ctxt env0 ctxt ;
-	addReport (vcat (ptext SLIT("Warning:") <+> msg : ctxt_to_use ctxt_msgs)) }
+	addReport (vcat (ptext (sLit "Warning:") <+> msg : ctxt_to_use ctxt_msgs)) }
 
 warnTc :: Bool -> Message -> TcM ()
 warnTc warn_if_true warn_msg
@@ -820,11 +814,9 @@ debugTc is useful for monadic debugging code
 
 \begin{code}
 debugTc :: TcM () -> TcM ()
-#ifdef DEBUG
-debugTc thing = thing
-#else
-debugTc thing = return ()
-#endif
+debugTc thing
+ | debugIsOn = thing
+ | otherwise = return ()
 \end{code}
 
  %************************************************************************
@@ -951,7 +943,7 @@ initIfaceExtCore :: IfL a -> TcRn a
 initIfaceExtCore thing_inside
   = do  { tcg_env <- getGblEnv 
 	; let { mod = tcg_mod tcg_env
-	      ; doc = ptext SLIT("External Core file for") <+> quotes (ppr mod)
+	      ; doc = ptext (sLit "External Core file for") <+> quotes (ppr mod)
 	      ; if_env = IfGblEnv { 
 			if_rec_types = Just (mod, return (tcg_type_env tcg_env)) }
 	      ; if_lenv = mkIfLclEnv mod doc
@@ -979,7 +971,7 @@ initIfaceTc iface do_this
     }
   where
     mod = mi_module iface
-    doc = ptext SLIT("The interface for") <+> quotes (ppr mod)
+    doc = ptext (sLit "The interface for") <+> quotes (ppr mod)
 
 initIfaceRules :: HscEnv -> ModGuts -> IfG a -> IO a
 -- Used when sucking in new Rules in SimplCore