Remove GADT refinements, part 3

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

diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs
index efe58a1..43b9d38 100644 (file)
--- a/compiler/typecheck/TcRnDriver.lhs
+++ b/compiler/typecheck/TcRnDriver.lhs
@@ -69,7 +69,7 @@ import ErrUtils
 import Id
 import Var
 import Module
-import UniqFM
+import LazyUniqFM
 import Name
 import NameEnv
 import NameSet
@@ -85,7 +85,6 @@ import DataCon
 import TcHsType
 import TcMType
 import TcMatches
-import TcGadt
 import RnTypes
 import RnExpr
 import IfaceEnv
@@ -102,7 +101,7 @@ import Maybes
 import Util
 import Bag
 
-import Control.Monad    ( unless )
+import Control.Monad
 import Data.Maybe      ( isJust )
 
 \end{code}
@@ -896,7 +895,7 @@ tcRnStmt hsc_env ictxt rdr_stmt
     
        -- None of the Ids should be of unboxed type, because we
        -- cast them all to HValues in the end!
-    mappM bad_unboxed (filter (isUnLiftedType . idType) zonked_ids) ;
+    mapM bad_unboxed (filter (isUnLiftedType . idType) zonked_ids) ;
 
     traceTc (text "tcs 1") ;
     let { global_ids = map globaliseAndTidy zonked_ids } ;
@@ -924,7 +923,7 @@ tcRnStmt hsc_env ictxt rdr_stmt
        (vcat [text "Bound Ids" <+> pprWithCommas ppr global_ids,
               text "Typechecked expr" <+> ppr zonked_expr]) ;
 
-    returnM (global_ids, zonked_expr)
+    return (global_ids, zonked_expr)
     }
   where
     bad_unboxed id = addErr (sep [ptext SLIT("GHCi can't bind a variable of unlifted type:"),
@@ -1012,7 +1011,7 @@ mkPlan (L loc (ExprStmt expr _ _))        -- An expression typed at the prompt
        ; runPlans [    -- Plan A
                    do { stuff@([it_id], _) <- tcGhciStmts [bind_stmt, print_it]
                       ; it_ty <- zonkTcType (idType it_id)
-                      ; ifM (isUnitTy it_ty) failM
+                      ; when (isUnitTy it_ty) failM
                       ; return stuff },
 
                        -- Plan B; a naked bind statment
@@ -1037,7 +1036,7 @@ mkPlan stmt@(L loc (BindStmt {}))
        ; let print_plan = do
                  { stuff@([v_id], _) <- tcGhciStmts [stmt, print_v]
                  ; v_ty <- zonkTcType (idType v_id)
-                 ; ifM (isUnitTy v_ty || not (isTauTy v_ty)) failM
+                 ; when (isUnitTy v_ty || not (isTauTy v_ty)) failM
                  ; return stuff }
 
        -- The plans are:
@@ -1056,11 +1055,9 @@ tcGhciStmts stmts
  = do { ioTyCon <- tcLookupTyCon ioTyConName ;
        ret_id  <- tcLookupId returnIOName ;            -- return @ IO
        let {
-           io_ty     = mkTyConApp ioTyCon [] ;
            ret_ty    = mkListTy unitTy ;
            io_ret_ty = mkTyConApp ioTyCon [ret_ty] ;
-           tc_io_stmts stmts = tcStmts DoExpr (tcDoStmt io_ty) stmts 
-                                       (emptyRefinement, io_ret_ty) ;
+           tc_io_stmts stmts = tcStmts DoExpr tcDoStmt stmts io_ret_ty ;
 
            names = map unLoc (collectLStmtsBinders stmts) ;
 
@@ -1084,7 +1081,7 @@ tcGhciStmts stmts
        -- OK, we're ready to typecheck the stmts
        traceTc (text "TcRnDriver.tcGhciStmts: tc stmts") ;
        ((tc_stmts, ids), lie) <- getLIE $ tc_io_stmts stmts $ \ _ ->
-                                          mappM tcLookupId names ;
+                                          mapM tcLookupId names ;
                                        -- Look up the names right in the middle,
                                        -- where they will all be in scope
 
@@ -1329,8 +1326,8 @@ tcDump env
  = do { dflags <- getDOpts ;
 
        -- Dump short output if -ddump-types or -ddump-tc
-       ifM (dopt Opt_D_dump_types dflags || dopt Opt_D_dump_tc dflags)
-           (dumpTcRn short_dump) ;
+       when (dopt Opt_D_dump_types dflags || dopt Opt_D_dump_tc dflags)
+            (dumpTcRn short_dump) ;
 
        -- Dump bindings if -ddump-tc
        dumpOptTcRn Opt_D_dump_tc (mkDumpDoc "Typechecker" full_dump)
@@ -1343,8 +1340,8 @@ tcDump env
 
 tcCoreDump mod_guts
  = do { dflags <- getDOpts ;
-       ifM (dopt Opt_D_dump_types dflags || dopt Opt_D_dump_tc dflags)
-           (dumpTcRn (pprModGuts mod_guts)) ;
+       when (dopt Opt_D_dump_types dflags || dopt Opt_D_dump_tc dflags)
+            (dumpTcRn (pprModGuts mod_guts)) ;
 
        -- Dump bindings if -ddump-tc
        dumpOptTcRn Opt_D_dump_tc (mkDumpDoc "Typechecker" full_dump) }