Rejig error reporting in the unifier slightly

[ghc-hetmet.git] / compiler / iface / TcIface.lhs

diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs
index 1e8d1ca..e1a6d2b 100644 (file)
--- a/compiler/iface/TcIface.lhs
+++ b/compiler/iface/TcIface.lhs
@@ -50,15 +50,17 @@ import Name
 import NameEnv
 import OccName
 import Module
-import UniqFM
+import LazyUniqFM
 import UniqSupply
 import Outputable      
 import ErrUtils
 import Maybes
 import SrcLoc
 import DynFlags
-import Control.Monad
+import Util
+import FastString
 
+import Control.Monad
 import Data.List
 import Data.Maybe
 \end{code}
@@ -423,7 +425,7 @@ tcIfaceDecl ignore_prags
     ; fds  <- mapM tc_fd rdr_fds
     ; ats' <- mapM (tcIfaceDecl ignore_prags) rdr_ats
     ; let ats = zipWith setTyThingPoss ats' (map ifTyVars rdr_ats)
-    ; cls  <- buildClass cls_name tyvars ctxt fds ats sigs tc_isrec
+    ; cls  <- buildClass ignore_prags cls_name tyvars ctxt fds ats sigs tc_isrec
     ; return (AClass cls) }
   where
    tc_sig (IfaceClassOp occ dm rdr_ty)
@@ -813,10 +815,8 @@ tcIfaceAlt _ _ (IfaceLitAlt lit, names, rhs)
 -- work them out.  True enough, but its not that easy!
 tcIfaceAlt scrut (tycon, inst_tys) (IfaceDataAlt data_occ, arg_strs, rhs)
   = do { con <- tcIfaceDataCon data_occ
-#ifdef DEBUG
-       ; when (not (con `elem` tyConDataCons tycon))
+       ; when (debugIsOn && not (con `elem` tyConDataCons tycon))
               (failIfM (ppr scrut $$ ppr con $$ ppr tycon $$ ppr (tyConDataCons tycon)))
-#endif
        ; tcIfaceDataAlt con inst_tys arg_strs rhs }
                  
 tcIfaceAlt _ (tycon, inst_tys) (IfaceTupleAlt boxity, arg_occs, rhs)
@@ -1037,13 +1037,11 @@ tcIfaceTyCon (IfaceTupTc bx ar) = tcWiredInTyCon (tupleTyCon bx ar)
 tcIfaceTyCon (IfaceTc name)     = do { thing <- tcIfaceGlobal name 
                                     ; return (check_tc (tyThingTyCon thing)) }
   where
-#ifdef DEBUG
-    check_tc tc = case toIfaceTyCon tc of
-                  IfaceTc _ -> tc
-                  other     -> pprTrace "check_tc" (ppr tc) tc
-#else
-    check_tc tc = tc
-#endif
+    check_tc tc
+     | debugIsOn = case toIfaceTyCon tc of
+                   IfaceTc _ -> tc
+                   other     -> pprTrace "check_tc" (ppr tc) tc
+     | otherwise = tc
 -- we should be okay just returning Kind constructors without extra loading
 tcIfaceTyCon IfaceLiftedTypeKindTc   = return liftedTypeKindTyCon
 tcIfaceTyCon IfaceOpenTypeKindTc     = return openTypeKindTyCon