[project @ 2000-10-31 12:07:43 by simonpj]
[ghc-hetmet.git] / ghc / compiler / typecheck / TcMonad.lhs
index c365b94..4d38539 100644 (file)
@@ -51,7 +51,6 @@ import RnHsSyn                ( RenamedPat, RenamedArithSeqInfo, RenamedHsExpr, RenamedHsOverL
 import Type            ( Type, Kind, PredType, ThetaType, RhoType, TauType,
                        )
 import ErrUtils                ( addShortErrLocLine, addShortWarnLocLine, ErrMsg, Message, WarnMsg )
-import CmdLineOpts      ( DynFlags, opt_PprStyle_Debug )
 
 import Bag             ( Bag, emptyBag, isEmptyBag,
                          foldBag, unitBag, unionBags, snocBag )
@@ -65,11 +64,10 @@ import UniqSupply   ( UniqSupply, uniqFromSupply, uniqsFromSupply,
                          UniqSM, initUs_ )
 import SrcLoc          ( SrcLoc, noSrcLoc )
 import FiniteMap       ( FiniteMap, lookupFM, addToFM, emptyFM )
-import UniqFM          ( UniqFM, emptyUFM )
+import UniqFM          ( emptyUFM )
 import Unique          ( Unique )
-import BasicTypes      ( Unused )
+import CmdLineOpts
 import Outputable
-import FastString      ( FastString )
 
 import IOExts          ( IORef, newIORef, readIORef, writeIORef,
                          unsafeInterleaveIO, fixIO
@@ -126,11 +124,10 @@ type TcRef a = IORef a
 
 initTc :: DynFlags 
        -> TcEnv
-       -> SrcLoc
        -> TcM r
-       -> IO (Maybe r, (Bag ErrMsg, Bag WarnMsg))
+       -> IO (Maybe r, (Bag WarnMsg, Bag ErrMsg))
 
-initTc dflags tc_env src_loc do_this
+initTc dflags tc_env do_this
   = do {
       us       <- mkSplitUniqSupply 'a' ;
       us_var   <- newIORef us ;
@@ -140,7 +137,7 @@ initTc dflags tc_env src_loc do_this
 
       let
           init_down = TcDown dflags [] us_var dfun_var
-                            src_loc
+                            noSrcLoc
                             [] errs_var
       ;
 
@@ -636,9 +633,9 @@ getErrCtxt (TcDown{tc_ctxt=ctxt}) = ctxt
 setErrCtxt down msg = down{tc_ctxt=[msg]}
 addErrCtxt down msg = down{tc_ctxt = msg : tc_ctxt down}
 
-doptsTc :: (DynFlags -> Bool) -> TcM Bool
-doptsTc dopt (TcDown{tc_dflags=dflags}) env_down
-   = return (dopt dflags)
+doptsTc :: DynFlag -> TcM Bool
+doptsTc dflag (TcDown{tc_dflags=dflags}) env_down
+   = return (dopt dflag dflags)
 
 getDOptsTc :: TcM DynFlags
 getDOptsTc (TcDown{tc_dflags=dflags}) env_down