View patterns, record wildcards, and record puns

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

diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs
index 33c6aec..396805f 100644 (file)
--- a/compiler/typecheck/TcRnMonad.lhs
+++ b/compiler/typecheck/TcRnMonad.lhs
@@ -44,6 +44,7 @@ import Bag
 import Outputable
 import UniqSupply
 import Unique
+import UniqFM
 import DynFlags
 import StaticFlags
 import FastString
@@ -369,7 +370,8 @@ traceOptTcRn flag doc = ifOptM flag $ do
 
 dumpTcRn :: SDoc -> TcRn ()
 dumpTcRn doc = do { rdr_env <- getGlobalRdrEnv ;
-                   ioToTcRn (printForUser stderr (mkPrintUnqualified rdr_env) doc) }
+                    dflags <- getDOpts ;
+                   ioToTcRn (printForUser stderr (mkPrintUnqualified dflags rdr_env) doc) }
 
 dumpOptTcRn :: DynFlag -> SDoc -> TcRn ()
 dumpOptTcRn flag doc = ifOptM flag (dumpTcRn doc)
@@ -475,7 +477,8 @@ addLongErrAt loc msg extra
   = do { traceTc (ptext SLIT("Adding error:") <+> (mkLocMessage loc (msg $$ extra))) ; 
         errs_var <- getErrsVar ;
         rdr_env <- getGlobalRdrEnv ;
-        let { err = mkLongErrMsg loc (mkPrintUnqualified rdr_env) msg extra } ;
+         dflags <- getDOpts ;
+        let { err = mkLongErrMsg loc (mkPrintUnqualified dflags rdr_env) msg extra } ;
         (warns, errs) <- readMutVar errs_var ;
         writeMutVar errs_var (warns, errs `snocBag` err) }
 
@@ -491,7 +494,8 @@ addReportAt :: SrcSpan -> Message -> TcRn ()
 addReportAt loc msg
   = do { errs_var <- getErrsVar ;
         rdr_env <- getGlobalRdrEnv ;
-        let { warn = mkWarnMsg loc (mkPrintUnqualified rdr_env) msg } ;
+         dflags <- getDOpts ;
+        let { warn = mkWarnMsg loc (mkPrintUnqualified dflags rdr_env) msg } ;
         (warns, errs) <- readMutVar errs_var ;
         writeMutVar errs_var (warns `snocBag` warn, errs) }
 
@@ -913,8 +917,8 @@ setLocalRdrEnv rdr_env thing_inside
 mkIfLclEnv :: Module -> SDoc -> IfLclEnv
 mkIfLclEnv mod loc = IfLclEnv { if_mod     = mod,
                                if_loc     = loc,
-                               if_tv_env  = emptyOccEnv,
-                               if_id_env  = emptyOccEnv }
+                               if_tv_env  = emptyUFM,
+                               if_id_env  = emptyUFM }
 
 initIfaceTcRn :: IfG a -> TcRn a
 initIfaceTcRn thing_inside