Remove an #ifdef DEBUG

[ghc-hetmet.git] / compiler / typecheck / TcRnMonad.lhs

diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs
index 68db3a2..dcba808 100644 (file)
--- a/compiler/typecheck/TcRnMonad.lhs
+++ b/compiler/typecheck/TcRnMonad.lhs
@@ -44,15 +44,17 @@ 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
 import Control.Exception
+import Control.Monad
 \end{code}
 
 
@@ -64,11 +66,6 @@ import Control.Exception
 %************************************************************************
 
 \begin{code}
-ioToTcRn :: IO r -> TcRn r
-ioToTcRn = ioToIOEnv
-\end{code}
-
-\begin{code}
 
 initTc :: HscEnv
        -> HscSource
@@ -247,7 +244,8 @@ unsetOptM :: DynFlag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
 unsetOptM flag = updEnv (\ env@(Env { env_top = top }) ->
                         env { env_top = top { hsc_dflags = dopt_unset (hsc_dflags top) flag}} )
 
-ifOptM :: DynFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()    -- Do it flag is true
+-- | Do it flag is true
+ifOptM :: DynFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
 ifOptM flag thing_inside = do { b <- doptM flag; 
                                if b then thing_inside else return () }
 
@@ -357,7 +355,7 @@ traceHiDiffs = traceOptIf Opt_D_dump_hi_diffs
 
 traceOptIf :: DynFlag -> SDoc -> TcRnIf m n ()  -- No RdrEnv available, so qualify everything
 traceOptIf flag doc = ifOptM flag $
-                    ioToIOEnv (printForUser stderr alwaysQualify doc)
+                     liftIO (printForUser stderr alwaysQualify doc)
 
 traceOptTcRn :: DynFlag -> SDoc -> TcRn ()
 traceOptTcRn flag doc = ifOptM flag $ do
@@ -371,7 +369,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)
@@ -397,6 +395,9 @@ tcIsHsBoot = do { env <- getGblEnv; return (isHsBoot (tcg_src env)) }
 getGlobalRdrEnv :: TcRn GlobalRdrEnv
 getGlobalRdrEnv = do { env <- getGblEnv; return (tcg_rdr_env env) }
 
+getRdrEnvs :: TcRn (GlobalRdrEnv, LocalRdrEnv)
+getRdrEnvs = do { (gbl,lcl) <- getEnvs; return (tcg_rdr_env gbl, tcl_rdr lcl) }
+
 getImports :: TcRn ImportAvails
 getImports = do { env <- getGblEnv; return (tcg_imports env) }
 
@@ -483,7 +484,7 @@ addLongErrAt loc msg extra
         writeMutVar errs_var (warns, errs `snocBag` err) }
 
 addErrs :: [(SrcSpan,Message)] -> TcRn ()
-addErrs msgs = mappM_ add msgs
+addErrs msgs = mapM_ add msgs
             where
               add (loc,msg) = addErrAt loc msg
 
@@ -510,7 +511,7 @@ addLocWarn (L loc e) fn = addReportAt loc (fn e)
 
 checkErr :: Bool -> Message -> TcRn ()
 -- Add the error if the bool is False
-checkErr ok msg = checkM ok (addErr msg)
+checkErr ok msg = unless ok (addErr msg)
 
 warnIf :: Bool -> Message -> TcRn ()
 warnIf True  msg = addWarn msg
@@ -559,7 +560,7 @@ recoverM recover thing
   = do { mb_res <- try_m thing ;
         case mb_res of
           Left exn  -> recover
-          Right res -> returnM res }
+          Right res -> return res }
 
 
 -----------------------
@@ -646,7 +647,7 @@ checkNoErrs main
   = do { (msgs, mb_res) <- tryTcLIE main
        ; addMessages msgs
        ; case mb_res of
-           Nothing   -> failM
+           Nothing  -> failM
            Just val -> return val
        } 
 
@@ -684,7 +685,7 @@ setErrCtxt :: ErrCtxt -> TcM a -> TcM a
 setErrCtxt ctxt = updLclEnv (\ env -> env { tcl_ctxt = ctxt })
 
 addErrCtxt :: Message -> TcM a -> TcM a
-addErrCtxt msg = addErrCtxtM (\env -> returnM (env, msg))
+addErrCtxt msg = addErrCtxtM (\env -> return (env, msg))
 
 addErrCtxtM :: (TidyEnv -> TcM (TidyEnv, Message)) -> TcM a -> TcM a
 addErrCtxtM msg = updCtxt (\ msgs -> msg : msgs)
@@ -724,7 +725,7 @@ addErrTc err_msg = do { env0 <- tcInitTidyEnv
                      ; addErrTcM (env0, err_msg) }
 
 addErrsTc :: [Message] -> TcM ()
-addErrsTc err_msgs = mappM_ addErrTc err_msgs
+addErrsTc err_msgs = mapM_ addErrTc err_msgs
 
 addErrTcM :: (TidyEnv, Message) -> TcM ()
 addErrTcM (tidy_env, err_msg)
@@ -745,7 +746,7 @@ failWithTcM local_and_msg
   = addErrTcM local_and_msg >> failM
 
 checkTc :: Bool -> Message -> TcM ()        -- Check that the boolean is true
-checkTc True  err = returnM ()
+checkTc True  err = return ()
 checkTc False err = failWithTc err
 \end{code}
 
@@ -815,11 +816,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}
 
  %************************************************************************
@@ -859,7 +858,7 @@ extendLIE inst
 
 extendLIEs :: [Inst] -> TcM ()
 extendLIEs [] 
-  = returnM ()
+  = return ()
 extendLIEs insts
   = do { lie_var <- getLIEVar ;
         lie <- readMutVar lie_var ;
@@ -1004,7 +1003,7 @@ failIfM :: Message -> IfL a
 failIfM msg
   = do         { env <- getLclEnv
        ; let full_msg = (if_loc env <> colon) $$ nest 2 msg
-       ; ioToIOEnv (printErrs (full_msg defaultErrStyle))
+       ; liftIO (printErrs (full_msg defaultErrStyle))
        ; failM }
 
 --------------------
@@ -1039,7 +1038,7 @@ forkM_maybe doc thing_inside
                    ; return Nothing }
        }}
   where
-    print_errs sdoc = ioToIOEnv (printErrs (sdoc defaultErrStyle))
+    print_errs sdoc = liftIO (printErrs (sdoc defaultErrStyle))
 
 forkM :: SDoc -> IfL a -> IfL a
 forkM doc thing_inside