TysWiredIn is now warning-free

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

diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs
index 339eb60..156a1aa 100644 (file)
--- a/compiler/iface/TcIface.lhs
+++ b/compiler/iface/TcIface.lhs
@@ -57,8 +57,10 @@ 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}
@@ -160,11 +162,11 @@ importDecl name
            Nothing    -> return (Failed not_found_msg)
     }}}
   where
-    nd_doc = ptext SLIT("Need decl for") <+> ppr name
-    not_found_msg = hang (ptext SLIT("Can't find interface-file declaration for") <+>
+    nd_doc = ptext (sLit "Need decl for") <+> ppr name
+    not_found_msg = hang (ptext (sLit "Can't find interface-file declaration for") <+>
                                pprNameSpace (occNameSpace (nameOccName name)) <+> ppr name)
-                      2 (vcat [ptext SLIT("Probable cause: bug in .hi-boot file, or inconsistent .hi file"),
-                               ptext SLIT("Use -ddump-if-trace to get an idea of which file caused the error")])
+                      2 (vcat [ptext (sLit "Probable cause: bug in .hi-boot file, or inconsistent .hi file"),
+                               ptext (sLit "Use -ddump-if-trace to get an idea of which file caused the error")])
 \end{code}
 
 %************************************************************************
@@ -288,13 +290,13 @@ tcHiBootIface hsc_src mod
                Succeeded (iface, _path) -> typecheckIface iface
     }}}}
   where
-    need = ptext SLIT("Need the hi-boot interface for") <+> ppr mod
-                <+> ptext SLIT("to compare against the Real Thing")
+    need = ptext (sLit "Need the hi-boot interface for") <+> ppr mod
+                <+> ptext (sLit "to compare against the Real Thing")
 
-    moduleLoop = ptext SLIT("Circular imports: module") <+> quotes (ppr mod) 
-                    <+> ptext SLIT("depends on itself")
+    moduleLoop = ptext (sLit "Circular imports: module") <+> quotes (ppr mod) 
+                    <+> ptext (sLit "depends on itself")
 
-    elaborate err = hang (ptext SLIT("Could not find hi-boot interface for") <+> 
+    elaborate err = hang (ptext (sLit "Could not find hi-boot interface for") <+> 
                          quotes (ppr mod) <> colon) 4 err
 \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)
@@ -434,7 +436,7 @@ tcIfaceDecl ignore_prags
                -- it mentions unless it's necessray to do so
          ; return (op_name, dm, op_ty) }
 
-   mk_doc op_name op_ty = ptext SLIT("Class op") <+> sep [ppr op_name, ppr op_ty]
+   mk_doc op_name op_ty = ptext (sLit "Class op") <+> sep [ppr op_name, ppr op_ty]
 
    tc_fd (tvs1, tvs2) = do { tvs1' <- mapM tcIfaceTyVar tvs1
                           ; tvs2' <- mapM tcIfaceTyVar tvs2
@@ -497,7 +499,7 @@ tcIfaceDataCons tycon_name tycon tc_tyvars if_cons
                        eq_spec theta 
                       arg_tys tycon
        }
-    mk_doc con_name = ptext SLIT("Constructor") <+> ppr con_name
+    mk_doc con_name = ptext (sLit "Constructor") <+> ppr con_name
 
 tcIfaceEqSpec spec
   = mapM do_item spec
@@ -519,7 +521,7 @@ tcIfaceInst :: IfaceInst -> IfL Instance
 tcIfaceInst (IfaceInst { ifDFun = dfun_occ, ifOFlag = oflag,
                         ifInstCls = cls, ifInstTys = mb_tcs,
                         ifInstOrph = orph })
-  = do { dfun    <- forkM (ptext SLIT("Dict fun") <+> ppr dfun_occ) $
+  = do { dfun    <- forkM (ptext (sLit "Dict fun") <+> ppr dfun_occ) $
                     tcIfaceExtId dfun_occ
         ; let mb_tcs' = map (fmap ifaceTyConName) mb_tcs
        ; return (mkImportedInstance cls mb_tcs' dfun oflag) }
@@ -527,7 +529,7 @@ tcIfaceInst (IfaceInst { ifDFun = dfun_occ, ifOFlag = oflag,
 tcIfaceFamInst :: IfaceFamInst -> IfL FamInst
 tcIfaceFamInst (IfaceFamInst { ifFamInstTyCon = tycon, 
                               ifFamInstFam = fam, ifFamInstTys = mb_tcs })
---     { tycon'  <- forkM (ptext SLIT("Inst tycon") <+> ppr tycon) $
+--     { tycon'  <- forkM (ptext (sLit "Inst tycon") <+> ppr tycon) $
 -- ^^^this line doesn't work, but vvv this does => CPP in Haskell = evil!
     = do tycon'  <- forkM (text ("Inst tycon") <+> ppr tycon) $
                     tcIfaceTyCon tycon
@@ -560,7 +562,7 @@ tcIfaceRule (IfaceRule {ifRuleName = name, ifActivation = act, ifRuleBndrs = bnd
                        ifRuleOrph = orph })
   = do { ~(bndrs', args', rhs') <- 
                -- Typecheck the payload lazily, in the hope it'll never be looked at
-               forkM (ptext SLIT("Rule") <+> ftext name) $
+               forkM (ptext (sLit "Rule") <+> ftext name) $
                bindIfaceBndrs bndrs                      $ \ bndrs' ->
                do { args' <- mapM tcIfaceExpr args
                   ; rhs'  <- tcIfaceExpr rhs
@@ -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