projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Whitespace only (TcInstDcls)
[ghc-hetmet.git]
/
compiler
/
typecheck
/
TcRnMonad.lhs
diff --git
a/compiler/typecheck/TcRnMonad.lhs
b/compiler/typecheck/TcRnMonad.lhs
index
d7988e8
..
a7c930d
100644
(file)
--- a/
compiler/typecheck/TcRnMonad.lhs
+++ b/
compiler/typecheck/TcRnMonad.lhs
@@
-16,8
+16,6
@@
module TcRnMonad(
module IOEnv
) where
module IOEnv
) where
-#include "HsVersions.h"
-
import TcRnTypes -- Re-export all
import IOEnv -- Re-export all
import TcRnTypes -- Re-export all
import IOEnv -- Re-export all
@@
-44,11
+42,12
@@
import Bag
import Outputable
import UniqSupply
import Unique
import Outputable
import UniqSupply
import Unique
-import UniqFM
+import LazyUniqFM
import DynFlags
import StaticFlags
import FastString
import Panic
import DynFlags
import StaticFlags
import FastString
import Panic
+import Util
import System.IO
import Data.IORef
import System.IO
import Data.IORef
@@
-65,11
+64,6
@@
import Control.Monad
%************************************************************************
\begin{code}
%************************************************************************
\begin{code}
-ioToTcRn :: IO r -> TcRn r
-ioToTcRn = liftIO
-\end{code}
-
-\begin{code}
initTc :: HscEnv
-> HscSource
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,
} ;
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,
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 ;
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)
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
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 ;
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 ()
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 :: 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)
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
= do { (msgs, mb_res) <- tryTcLIE main
; addMessages msgs
; case mb_res of
- Nothing -> failM
+ Nothing -> failM
Just val -> return val
}
Just val -> return val
}
@@
-765,7
+759,7
@@
addWarnTcM :: (TidyEnv, Message) -> TcM ()
addWarnTcM (env0, msg)
= do { ctxt <- getErrCtxt ;
ctxt_msgs <- do_ctxt env0 ctxt ;
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
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 ()
\begin{code}
debugTc :: TcM () -> TcM ()
-#ifdef DEBUG
-debugTc thing = thing
-#else
-debugTc thing = return ()
-#endif
+debugTc thing
+ | debugIsOn = thing
+ | otherwise = return ()
\end{code}
%************************************************************************
\end{code}
%************************************************************************
@@
-951,7
+943,7
@@
initIfaceExtCore :: IfL a -> TcRn a
initIfaceExtCore thing_inside
= do { tcg_env <- getGblEnv
; let { mod = tcg_mod tcg_env
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
; 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
}
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
initIfaceRules :: HscEnv -> ModGuts -> IfG a -> IO a
-- Used when sucking in new Rules in SimplCore