Add ASSERTs to all calls of nameModule

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

diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs
index db8c4fb..d9072f8 100644 (file)
--- a/compiler/iface/TcIface.lhs
+++ b/compiler/iface/TcIface.lhs
@@ -6,13 +6,6 @@
 Type checking of type signatures in interface files
 
 \begin{code}
 Type checking of type signatures in interface files
 
 \begin{code}

-{-# OPTIONS -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
-

 module TcIface ( 
        tcImportDecl, checkWiredInTyCon, tcHiBootIface, typecheckIface, 
        tcIfaceDecl, tcIfaceInst, tcIfaceFamInst, tcIfaceRules,
 module TcIface ( 
        tcImportDecl, checkWiredInTyCon, tcHiBootIface, typecheckIface, 
        tcIfaceDecl, tcIfaceInst, tcIfaceFamInst, tcIfaceRules,

@@ -50,15 +43,18 @@ import Name
 import NameEnv
 import OccName
 import Module
 import NameEnv
 import OccName
 import Module

-import UniqFM
+import LazyUniqFM

 import UniqSupply
 import Outputable      
 import ErrUtils
 import Maybes
 import SrcLoc
 import DynFlags
 import UniqSupply
 import Outputable      
 import ErrUtils
 import Maybes
 import SrcLoc
 import DynFlags

-import Control.Monad
+import Util
+import FastString
+import BasicTypes (Arity)

 
 

+import Control.Monad

 import Data.List
 import Data.Maybe
 \end{code}
 import Data.List
 import Data.Maybe
 \end{code}

@@ -72,7 +68,7 @@ This module takes
 An IfaceDecl is populated with RdrNames, and these are not renamed to
 Names before typechecking, because there should be no scope errors etc.
 
 An IfaceDecl is populated with RdrNames, and these are not renamed to
 Names before typechecking, because there should be no scope errors etc.
 

-       -- For (b) consider: f = $(...h....)
+       -- For (b) consider: f = \$(...h....)

        -- where h is imported, and calls f via an hi-boot file.  
        -- This is bad!  But it is not seen as a staging error, because h
        -- is indeed imported.  We don't want the type-checker to black-hole 
        -- where h is imported, and calls f via an hi-boot file.  
        -- This is bad!  But it is not seen as a staging error, because h
        -- is indeed imported.  We don't want the type-checker to black-hole 

@@ -131,7 +127,8 @@ checkWiredInTyCon tc
   = return ()
   | otherwise
   = do { mod <- getModule
   = return ()
   | otherwise
   = do { mod <- getModule

-       ; unless (mod == nameModule tc_name)
+       ; ASSERT( isExternalName tc_name ) 
+         unless (mod == nameModule tc_name)

                 (initIfaceTcRn (loadWiredInHomeIface tc_name))
                -- Don't look for (non-existent) Float.hi when
                -- compiling Float.lhs, which mentions Float of course
                 (initIfaceTcRn (loadWiredInHomeIface tc_name))
                -- Don't look for (non-existent) Float.hi when
                -- compiling Float.lhs, which mentions Float of course

@@ -148,10 +145,11 @@ importDecl name
     do { traceIf nd_doc
 
        -- Load the interface, which should populate the PTE
     do { traceIf nd_doc
 
        -- Load the interface, which should populate the PTE

-       ; mb_iface <- loadInterface nd_doc (nameModule name) ImportBySystem
+       ; mb_iface <- ASSERT2( isExternalName name, ppr name ) 
+                     loadInterface nd_doc (nameModule name) ImportBySystem

        ; case mb_iface of {
                Failed err_msg  -> return (Failed err_msg) ;
        ; case mb_iface of {
                Failed err_msg  -> return (Failed err_msg) ;

-               Succeeded iface -> do
+               Succeeded _ -> do

 
        -- Now look it up again; this time we should find it
        { eps <- getEps 
 
        -- Now look it up again; this time we should find it
        { eps <- getEps 

@@ -160,11 +158,11 @@ importDecl name
            Nothing    -> return (Failed not_found_msg)
     }}}
   where
            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)
                                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}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************

@@ -262,7 +260,7 @@ tcHiBootIface hsc_src mod
                  ; case lookupUFM hpt (moduleName mod) of
                      Just info | mi_boot (hm_iface info) 
                                -> return (hm_details info)
                  ; case lookupUFM hpt (moduleName mod) of
                      Just info | mi_boot (hm_iface info) 
                                -> return (hm_details info)

-                     other -> return emptyModDetails }
+                     _ -> return emptyModDetails }

          else do
 
        -- OK, so we're in one-shot mode.  
          else do
 
        -- OK, so we're in one-shot mode.  

@@ -288,13 +286,13 @@ tcHiBootIface hsc_src mod
                Succeeded (iface, _path) -> typecheckIface iface
     }}}}
   where
                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}
 
                          quotes (ppr mod) <> colon) 4 err
 \end{code}
 

@@ -358,16 +356,15 @@ tcIfaceDecl ignore_prags (IfaceId {ifName = occ_name, ifType = iface_type, ifIdI
   = do { name <- lookupIfaceTop occ_name
        ; ty <- tcIfaceType iface_type
        ; info <- tcIdInfo ignore_prags name ty info
   = do { name <- lookupIfaceTop occ_name
        ; ty <- tcIfaceType iface_type
        ; info <- tcIdInfo ignore_prags name ty info

-       ; return (AnId (mkVanillaGlobal name ty info)) }
-
-tcIfaceDecl ignore_prags 
-           (IfaceData {ifName = occ_name, 
-                       ifTyVars = tv_bndrs, 
-                       ifCtxt = ctxt, ifGadtSyntax = gadt_syn,
-                       ifCons = rdr_cons, 
-                       ifRec = is_rec, 
-                       ifGeneric = want_generic,
-                       ifFamInst = mb_family })
+       ; return (AnId (mkVanillaGlobalWithInfo name ty info)) }
+
+tcIfaceDecl _ (IfaceData {ifName = occ_name, 
+                         ifTyVars = tv_bndrs, 
+                         ifCtxt = ctxt, ifGadtSyntax = gadt_syn,
+                         ifCons = rdr_cons, 
+                         ifRec = is_rec, 
+                         ifGeneric = want_generic,
+                         ifFamInst = mb_family })

   = do { tc_name <- lookupIfaceTop occ_name
        ; bindIfaceTyVars tv_bndrs $ \ tyvars -> do
 
   = do { tc_name <- lookupIfaceTop occ_name
        ; bindIfaceTyVars tv_bndrs $ \ tyvars -> do
 

@@ -389,25 +386,30 @@ tcIfaceDecl ignore_prags
        ; return (ATyCon tycon)
     }}
 
        ; return (ATyCon tycon)
     }}
 

-tcIfaceDecl ignore_prags 
-           (IfaceSyn {ifName = occ_name, ifTyVars = tv_bndrs, 
-                      ifOpenSyn = isOpen, ifSynRhs = rdr_rhs_ty,
-                      ifFamInst = mb_family})
+tcIfaceDecl _ (IfaceSyn {ifName = occ_name, ifTyVars = tv_bndrs, 
+                        ifSynRhs = mb_rhs_ty,
+                        ifSynKind = kind, ifFamInst = mb_family})

    = bindIfaceTyVars tv_bndrs $ \ tyvars -> do
      { tc_name <- lookupIfaceTop occ_name
    = bindIfaceTyVars tv_bndrs $ \ tyvars -> do
      { tc_name <- lookupIfaceTop occ_name

-     ; rhs_tyki <- tcIfaceType rdr_rhs_ty
-     ; let rhs = if isOpen then OpenSynTyCon rhs_tyki Nothing
-                          else SynonymTyCon rhs_tyki
-     ; famInst <- case mb_family of
-                   Nothing         -> return Nothing
-                   Just (fam, tys) -> 
-                     do { famTyCon <- tcIfaceTyCon fam
-                        ; insttys <- mapM tcIfaceType tys
-                        ; return $ Just (famTyCon, insttys)
-                        }
-     ; tycon <- buildSynTyCon tc_name tyvars rhs famInst
+     ; rhs_kind <- tcIfaceType kind    -- Note [Synonym kind loop]
+     ; ~(rhs, fam) <- forkM (mk_doc tc_name) $ 
+                             do { rhs <- tc_syn_rhs rhs_kind mb_rhs_ty
+                        ; fam <- tc_syn_fam mb_family
+                        ; return (rhs, fam) }
+     ; tycon <- buildSynTyCon tc_name tyvars rhs rhs_kind fam

      ; return $ ATyCon tycon
      }
      ; return $ ATyCon tycon
      }

+   where
+     mk_doc n = ptext (sLit "Type syonym") <+> ppr n
+     tc_syn_rhs kind Nothing   = return (OpenSynTyCon kind Nothing)
+     tc_syn_rhs _    (Just ty) = do { rhs_ty <- tcIfaceType ty
+                                   ; return (SynonymTyCon rhs_ty) }
+     tc_syn_fam Nothing 
+       = return Nothing
+     tc_syn_fam (Just (fam, tys)) 
+       = do { famTyCon <- tcIfaceTyCon fam
+           ; insttys <- mapM tcIfaceType tys
+                   ; return $ Just (famTyCon, insttys) }

 
 tcIfaceDecl ignore_prags
            (IfaceClass {ifCtxt = rdr_ctxt, ifName = occ_name, 
 
 tcIfaceDecl ignore_prags
            (IfaceClass {ifCtxt = rdr_ctxt, ifName = occ_name, 

@@ -419,11 +421,11 @@ tcIfaceDecl ignore_prags
   = bindIfaceTyVars tv_bndrs $ \ tyvars -> do
     { cls_name <- lookupIfaceTop occ_name
     ; ctxt <- tcIfaceCtxt rdr_ctxt
   = bindIfaceTyVars tv_bndrs $ \ tyvars -> do
     { cls_name <- lookupIfaceTop occ_name
     ; ctxt <- tcIfaceCtxt rdr_ctxt

-    ; sigs <- mappM tc_sig rdr_sigs
-    ; fds  <- mappM tc_fd rdr_fds
-    ; ats'  <- mappM (tcIfaceDecl ignore_prags) rdr_ats
+    ; sigs <- mapM tc_sig rdr_sigs
+    ; fds  <- mapM tc_fd rdr_fds
+    ; ats' <- mapM (tcIfaceDecl ignore_prags) rdr_ats

     ; let ats = zipWith setTyThingPoss ats' (map ifTyVars 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)
     ; return (AClass cls) }
   where
    tc_sig (IfaceClassOp occ dm rdr_ty)

@@ -434,10 +436,10 @@ tcIfaceDecl ignore_prags
                -- it mentions unless it's necessray to do so
          ; return (op_name, dm, op_ty) }
 
                -- 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' <- mappM tcIfaceTyVar tvs1
-                          ; tvs2' <- mappM tcIfaceTyVar tvs2
+   tc_fd (tvs1, tvs2) = do { tvs1' <- mapM tcIfaceTyVar tvs1
+                          ; tvs2' <- mapM tcIfaceTyVar tvs2

                           ; return (tvs1', tvs2') }
 
    -- For each AT argument compute the position of the corresponding class
                           ; return (tvs1', tvs2') }
 
    -- For each AT argument compute the position of the corresponding class

@@ -453,16 +455,17 @@ tcIfaceDecl ignore_prags
      ATyCon (setTyConArgPoss tycon poss)
    setTyThingPoss _              _ = panic "TcIface.setTyThingPoss"
 
      ATyCon (setTyConArgPoss tycon poss)
    setTyThingPoss _              _ = panic "TcIface.setTyThingPoss"
 

-tcIfaceDecl ignore_prags (IfaceForeign {ifName = rdr_name, ifExtName = ext_name})
+tcIfaceDecl _ (IfaceForeign {ifName = rdr_name, ifExtName = ext_name})

   = do { name <- lookupIfaceTop rdr_name
        ; return (ATyCon (mkForeignTyCon name ext_name 
                                         liftedTypeKind 0)) }
 
   = do { name <- lookupIfaceTop rdr_name
        ; return (ATyCon (mkForeignTyCon name ext_name 
                                         liftedTypeKind 0)) }
 

-tcIfaceDataCons tycon_name tycon tc_tyvars if_cons
+tcIfaceDataCons :: Name -> TyCon -> [TyVar] -> IfaceConDecls -> IfL AlgTyConRhs
+tcIfaceDataCons tycon_name tycon _ if_cons

   = case if_cons of
        IfAbstractTyCon  -> return mkAbstractTyConRhs
        IfOpenDataTyCon  -> return mkOpenDataTyConRhs
   = case if_cons of
        IfAbstractTyCon  -> return mkAbstractTyConRhs
        IfOpenDataTyCon  -> return mkOpenDataTyConRhs

-       IfDataTyCon cons -> do  { data_cons <- mappM tc_con_decl cons
+       IfDataTyCon cons -> do  { data_cons <- mapM tc_con_decl cons

                                ; return (mkDataTyConRhs data_cons) }
        IfNewTyCon con   -> do  { data_con <- tc_con_decl con
                                ; mkNewTyConRhs tycon_name tycon data_con }
                                ; return (mkDataTyConRhs data_cons) }
        IfNewTyCon con   -> do  { data_con <- tc_con_decl con
                                ; mkNewTyConRhs tycon_name tycon data_con }

@@ -488,8 +491,8 @@ tcIfaceDataCons tycon_name tycon tc_tyvars if_cons
 
        -- Read the argument types, but lazily to avoid faulting in
        -- the component types unless they are really needed
 
        -- Read the argument types, but lazily to avoid faulting in
        -- the component types unless they are really needed

-       ; arg_tys <- forkM (mk_doc name) (mappM tcIfaceType args)
-       ; lbl_names <- mappM lookupIfaceTop field_lbls
+       ; arg_tys <- forkM (mk_doc name) (mapM tcIfaceType args)
+       ; lbl_names <- mapM lookupIfaceTop field_lbls

 
        ; buildDataCon name is_infix {- Not infix -}
                       stricts lbl_names
 
        ; buildDataCon name is_infix {- Not infix -}
                       stricts lbl_names

@@ -497,8 +500,9 @@ tcIfaceDataCons tycon_name tycon tc_tyvars if_cons
                        eq_spec theta 
                       arg_tys tycon
        }
                        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 :: [(OccName, IfaceType)] -> IfL [(TyVar, Type)]

 tcIfaceEqSpec spec
   = mapM do_item spec
   where
 tcIfaceEqSpec spec
   = mapM do_item spec
   where

@@ -507,6 +511,23 @@ tcIfaceEqSpec spec
                               ; return (tv,ty) }
 \end{code}
 
                               ; return (tv,ty) }
 \end{code}
 

+Note [Synonym kind loop]
+~~~~~~~~~~~~~~~~~~~~~~~~
+Notice that we eagerly grab the *kind* from the interface file, but
+build a forkM thunk for the *rhs* (and family stuff).  To see why, 
+consider this (Trac #2412)
+
+M.hs:       module M where { import X; data T = MkT S }
+X.hs:       module X where { import {-# SOURCE #-} M; type S = T }
+M.hs-boot:  module M where { data T }
+
+When kind-checking M.hs we need S's kind.  But we do not want to
+find S's kind from (typeKind S-rhs), because we don't want to look at
+S-rhs yet!  Since S is imported from X.hi, S gets just one chance to
+be defined, and we must not do that until we've finished with M.T.
+
+Solution: record S's kind in the interface file; now we can safely
+look at it.

 
 %************************************************************************
 %*                                                                     *
 
 %************************************************************************
 %*                                                                     *

@@ -517,9 +538,8 @@ tcIfaceEqSpec spec
 \begin{code}
 tcIfaceInst :: IfaceInst -> IfL Instance
 tcIfaceInst (IfaceInst { ifDFun = dfun_occ, ifOFlag = oflag,
 \begin{code}
 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) $
+                        ifInstCls = cls, ifInstTys = mb_tcs })
+  = 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) }
                     tcIfaceExtId dfun_occ
         ; let mb_tcs' = map (fmap ifaceTyConName) mb_tcs
        ; return (mkImportedInstance cls mb_tcs' dfun oflag) }

@@ -527,12 +547,12 @@ tcIfaceInst (IfaceInst { ifDFun = dfun_occ, ifOFlag = oflag,
 tcIfaceFamInst :: IfaceFamInst -> IfL FamInst
 tcIfaceFamInst (IfaceFamInst { ifFamInstTyCon = tycon, 
                               ifFamInstFam = fam, ifFamInstTys = mb_tcs })
 tcIfaceFamInst :: IfaceFamInst -> IfL FamInst
 tcIfaceFamInst (IfaceFamInst { ifFamInstTyCon = tycon, 
                               ifFamInstFam = fam, ifFamInstTys = mb_tcs })

---  = do       { 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
-        ; let mb_tcs' = map (fmap ifaceTyConName) mb_tcs
-       ; return (mkImportedFamInst fam mb_tcs' tycon') }
+--     { tycon'  <- forkM (ptext (sLit "Inst tycon") <+> ppr tycon) $
+-- the above line doesn't work, but this below does => CPP in Haskell = evil!
+    = do tycon'  <- forkM (text ("Inst tycon") <+> ppr tycon) $
+                    tcIfaceTyCon tycon
+         let mb_tcs' = map (fmap ifaceTyConName) mb_tcs
+         return (mkImportedFamInst fam mb_tcs' tycon')

 \end{code}
 
 
 \end{code}
 
 

@@ -556,17 +576,16 @@ tcIfaceRules ignore_prags if_rules
 
 tcIfaceRule :: IfaceRule -> IfL CoreRule
 tcIfaceRule (IfaceRule {ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
 
 tcIfaceRule :: IfaceRule -> IfL CoreRule
 tcIfaceRule (IfaceRule {ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,

-                       ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs,
-                       ifRuleOrph = orph })
+                       ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs })

   = do { ~(bndrs', args', rhs') <- 
                -- Typecheck the payload lazily, in the hope it'll never be looked at
   = 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' ->
                bindIfaceBndrs bndrs                      $ \ bndrs' ->

-               do { args' <- mappM tcIfaceExpr args
+               do { args' <- mapM tcIfaceExpr args

                   ; rhs'  <- tcIfaceExpr rhs
                   ; return (bndrs', args', rhs') }
        ; let mb_tcs = map ifTopFreeName args
                   ; rhs'  <- tcIfaceExpr rhs
                   ; return (bndrs', args', rhs') }
        ; let mb_tcs = map ifTopFreeName args

-       ; returnM (Rule { ru_name = name, ru_fn = fn, ru_act = act, 
+       ; return (Rule { ru_name = name, ru_fn = fn, ru_act = act, 

                          ru_bndrs = bndrs', ru_args = args', 
                          ru_rhs = rhs', 
                          ru_rough = mb_tcs,
                          ru_bndrs = bndrs', ru_args = args', 
                          ru_rhs = rhs', 
                          ru_rough = mb_tcs,

@@ -583,9 +602,9 @@ tcIfaceRule (IfaceRule {ifRuleName = name, ifActivation = act, ifRuleBndrs = bnd
        -- to write them out in coreRuleToIfaceRule
     ifTopFreeName :: IfaceExpr -> Maybe Name
     ifTopFreeName (IfaceType (IfaceTyConApp tc _ )) = Just (ifaceTyConName tc)
        -- to write them out in coreRuleToIfaceRule
     ifTopFreeName :: IfaceExpr -> Maybe Name
     ifTopFreeName (IfaceType (IfaceTyConApp tc _ )) = Just (ifaceTyConName tc)

-    ifTopFreeName (IfaceApp f a)                    = ifTopFreeName f
+    ifTopFreeName (IfaceApp f _)                    = ifTopFreeName f

     ifTopFreeName (IfaceExt n)                      = Just n
     ifTopFreeName (IfaceExt n)                      = Just n

-    ifTopFreeName other                             = Nothing
+    ifTopFreeName _                                 = Nothing

 \end{code}
 
 
 \end{code}
 
 

@@ -693,6 +712,7 @@ tcIfaceType (IfaceTyConApp tc ts) = do { tc' <- tcIfaceTyCon tc; ts' <- tcIfaceT
 tcIfaceType (IfaceForAllTy tv t)  = bindIfaceTyVar tv $ \ tv' -> do { t' <- tcIfaceType t; return (ForAllTy tv' t') }
 tcIfaceType (IfacePredTy st)      = do { st' <- tcIfacePredType st; return (PredTy st') }
 
 tcIfaceType (IfaceForAllTy tv t)  = bindIfaceTyVar tv $ \ tv' -> do { t' <- tcIfaceType t; return (ForAllTy tv' t') }
 tcIfaceType (IfacePredTy st)      = do { st' <- tcIfacePredType st; return (PredTy st') }
 

+tcIfaceTypes :: [IfaceType] -> IfL [Type]

 tcIfaceTypes tys = mapM tcIfaceType tys
 
 -----------------------------------------
 tcIfaceTypes tys = mapM tcIfaceType tys
 
 -----------------------------------------

@@ -703,7 +723,7 @@ tcIfacePredType (IfaceEqPred t1 t2)  = do { t1' <- tcIfaceType t1; t2' <- tcIfac
 
 -----------------------------------------
 tcIfaceCtxt :: IfaceContext -> IfL ThetaType
 
 -----------------------------------------
 tcIfaceCtxt :: IfaceContext -> IfL ThetaType

-tcIfaceCtxt sts = mappM tcIfacePredType sts
+tcIfaceCtxt sts = mapM tcIfacePredType sts

 \end{code}
 
 
 \end{code}
 
 

@@ -716,54 +736,45 @@ tcIfaceCtxt sts = mappM tcIfacePredType sts
 \begin{code}
 tcIfaceExpr :: IfaceExpr -> IfL CoreExpr
 tcIfaceExpr (IfaceType ty)
 \begin{code}
 tcIfaceExpr :: IfaceExpr -> IfL CoreExpr
 tcIfaceExpr (IfaceType ty)

-  = tcIfaceType ty             `thenM` \ ty' ->
-    returnM (Type ty')
+  = Type <$> tcIfaceType ty

 
 tcIfaceExpr (IfaceLcl name)
 
 tcIfaceExpr (IfaceLcl name)

-  = tcIfaceLclId name  `thenM` \ id ->
-    returnM (Var id)
+  = Var <$> tcIfaceLclId name

 
 tcIfaceExpr (IfaceTick modName tickNo)
 
 tcIfaceExpr (IfaceTick modName tickNo)

-  = tcIfaceTick modName tickNo `thenM` \ id ->
-    returnM (Var id)
+  = Var <$> tcIfaceTick modName tickNo

 
 tcIfaceExpr (IfaceExt gbl)
 
 tcIfaceExpr (IfaceExt gbl)

-  = tcIfaceExtId gbl   `thenM` \ id ->
-    returnM (Var id)
+  = Var <$> tcIfaceExtId gbl

 
 tcIfaceExpr (IfaceLit lit)
 
 tcIfaceExpr (IfaceLit lit)

-  = returnM (Lit lit)
-
-tcIfaceExpr (IfaceFCall cc ty)
-  = tcIfaceType ty     `thenM` \ ty' ->
-    newUnique          `thenM` \ u ->
-    returnM (Var (mkFCallId u cc ty'))
-
-tcIfaceExpr (IfaceTuple boxity args) 
-  = mappM tcIfaceExpr args     `thenM` \ args' ->
-    let
-       -- Put the missing type arguments back in
-       con_args = map (Type . exprType) args' ++ args'
-    in
-    returnM (mkApps (Var con_id) con_args)
+  = return (Lit lit)
+
+tcIfaceExpr (IfaceFCall cc ty) = do
+    ty' <- tcIfaceType ty
+    u <- newUnique
+    return (Var (mkFCallId u cc ty'))
+
+tcIfaceExpr (IfaceTuple boxity args)  = do
+    args' <- mapM tcIfaceExpr args
+    -- Put the missing type arguments back in
+    let con_args = map (Type . exprType) args' ++ args'
+    return (mkApps (Var con_id) con_args)

   where
     arity = length args
     con_id = dataConWorkId (tupleCon boxity arity)
     
 
 tcIfaceExpr (IfaceLam bndr body)
   where
     arity = length args
     con_id = dataConWorkId (tupleCon boxity arity)
     
 
 tcIfaceExpr (IfaceLam bndr body)

-  = bindIfaceBndr bndr                 $ \ bndr' ->
-    tcIfaceExpr body           `thenM` \ body' ->
-    returnM (Lam bndr' body')
+  = bindIfaceBndr bndr $ \bndr' ->
+    Lam bndr' <$> tcIfaceExpr body

 
 tcIfaceExpr (IfaceApp fun arg)
 
 tcIfaceExpr (IfaceApp fun arg)

-  = tcIfaceExpr fun            `thenM` \ fun' ->
-    tcIfaceExpr arg            `thenM` \ arg' ->
-    returnM (App fun' arg')
+  = App <$> tcIfaceExpr fun <*> tcIfaceExpr arg

 
 

-tcIfaceExpr (IfaceCase scrut case_bndr ty alts) 
-  = tcIfaceExpr scrut          `thenM` \ scrut' ->
-    newIfaceName (mkVarOccFS case_bndr)        `thenM` \ case_bndr_name ->
+tcIfaceExpr (IfaceCase scrut case_bndr ty alts)  = do
+    scrut' <- tcIfaceExpr scrut
+    case_bndr_name <- newIfaceName (mkVarOccFS case_bndr)

     let
        scrut_ty   = exprType scrut'
        case_bndr' = mkLocalId case_bndr_name scrut_ty
     let
        scrut_ty   = exprType scrut'
        case_bndr' = mkLocalId case_bndr_name scrut_ty

@@ -773,66 +784,69 @@ tcIfaceExpr (IfaceCase scrut case_bndr ty alts)
                -- NB: not tcSplitTyConApp; we are looking at Core here
                --     look through non-rec newtypes to find the tycon that
                --     corresponds to the datacon in this case alternative
                -- NB: not tcSplitTyConApp; we are looking at Core here
                --     look through non-rec newtypes to find the tycon that
                --     corresponds to the datacon in this case alternative

-    in
-    extendIfaceIdEnv [case_bndr']      $
-    mappM (tcIfaceAlt scrut' tc_app) alts      `thenM` \ alts' ->
-    tcIfaceType ty                             `thenM` \ ty' ->
-    returnM (Case scrut' case_bndr' ty' alts')

 
 

-tcIfaceExpr (IfaceLet (IfaceNonRec bndr rhs) body)
-  = do { rhs' <- tcIfaceExpr rhs
-       ; id   <- tcIfaceLetBndr bndr
-       ; body' <- extendIfaceIdEnv [id] (tcIfaceExpr body)
-       ; return (Let (NonRec id rhs') body') }
-
-tcIfaceExpr (IfaceLet (IfaceRec pairs) body)
-  = do { ids <- mapM tcIfaceLetBndr bndrs
-       ; extendIfaceIdEnv ids $ do
-       { rhss' <- mapM tcIfaceExpr rhss
-       ; body' <- tcIfaceExpr body
-       ; return (Let (Rec (ids `zip` rhss')) body') } }
+    extendIfaceIdEnv [case_bndr'] $ do
+     alts' <- mapM (tcIfaceAlt scrut' tc_app) alts
+     ty' <- tcIfaceType ty
+     return (Case scrut' case_bndr' ty' alts')
+
+tcIfaceExpr (IfaceLet (IfaceNonRec bndr rhs) body) = do
+    rhs' <- tcIfaceExpr rhs
+    id   <- tcIfaceLetBndr bndr
+    body' <- extendIfaceIdEnv [id] (tcIfaceExpr body)
+    return (Let (NonRec id rhs') body')
+
+tcIfaceExpr (IfaceLet (IfaceRec pairs) body) = do
+    ids <- mapM tcIfaceLetBndr bndrs
+    extendIfaceIdEnv ids $ do
+     rhss' <- mapM tcIfaceExpr rhss
+     body' <- tcIfaceExpr body
+     return (Let (Rec (ids `zip` rhss')) body')

   where
     (bndrs, rhss) = unzip pairs
 
 tcIfaceExpr (IfaceCast expr co) = do
   where
     (bndrs, rhss) = unzip pairs
 
 tcIfaceExpr (IfaceCast expr co) = do

-  expr' <- tcIfaceExpr expr
-  co' <- tcIfaceType co
-  returnM (Cast expr' co')
+    expr' <- tcIfaceExpr expr
+    co' <- tcIfaceType co
+    return (Cast expr' co')

 
 

-tcIfaceExpr (IfaceNote note expr) 
-  = tcIfaceExpr expr           `thenM` \ expr' ->
+tcIfaceExpr (IfaceNote note expr) = do
+    expr' <- tcIfaceExpr expr

     case note of
     case note of

-       IfaceInlineMe     -> returnM (Note InlineMe   expr')
-       IfaceSCC cc       -> returnM (Note (SCC cc)   expr')
-       IfaceCoreNote n   -> returnM (Note (CoreNote n) expr')
+        IfaceInlineMe     -> return (Note InlineMe   expr')
+        IfaceSCC cc       -> return (Note (SCC cc)   expr')
+        IfaceCoreNote n   -> return (Note (CoreNote n) expr')

 
 -------------------------
 
 -------------------------

+tcIfaceAlt :: CoreExpr -> (TyCon, [Type])
+           -> (IfaceConAlt, [FastString], IfaceExpr)
+           -> IfL (AltCon, [TyVar], CoreExpr)

 tcIfaceAlt _ _ (IfaceDefault, names, rhs)
 tcIfaceAlt _ _ (IfaceDefault, names, rhs)

-  = ASSERT( null names )
-    tcIfaceExpr rhs            `thenM` \ rhs' ->
-    returnM (DEFAULT, [], rhs')
+  = ASSERT( null names ) do
+    rhs' <- tcIfaceExpr rhs
+    return (DEFAULT, [], rhs')

   
 tcIfaceAlt _ _ (IfaceLitAlt lit, names, rhs)
   
 tcIfaceAlt _ _ (IfaceLitAlt lit, names, rhs)

-  = ASSERT( null names )
-    tcIfaceExpr rhs            `thenM` \ rhs' ->
-    returnM (LitAlt lit, [], rhs')
+  = ASSERT( null names ) do
+    rhs' <- tcIfaceExpr rhs
+    return (LitAlt lit, [], rhs')

 
 -- A case alternative is made quite a bit more complicated
 -- by the fact that we omit type annotations because we can
 -- 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
 
 -- A case alternative is made quite a bit more complicated
 -- by the fact that we omit type annotations because we can
 -- 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
-       ; ifM (not (con `elem` tyConDataCons tycon))
-             (failIfM (ppr scrut $$ ppr con $$ ppr tycon $$ ppr (tyConDataCons tycon)))
-#endif
+       ; when (debugIsOn && not (con `elem` tyConDataCons tycon))
+              (failIfM (ppr scrut $$ ppr con $$ ppr tycon $$ ppr (tyConDataCons tycon)))

        ; tcIfaceDataAlt con inst_tys arg_strs rhs }
                  
        ; tcIfaceDataAlt con inst_tys arg_strs rhs }
                  

-tcIfaceAlt _ (tycon, inst_tys) (IfaceTupleAlt boxity, arg_occs, rhs)
+tcIfaceAlt _ (tycon, inst_tys) (IfaceTupleAlt _boxity, arg_occs, rhs)

   = ASSERT( isTupleTyCon tycon )
     do { let [data_con] = tyConDataCons tycon
        ; tcIfaceDataAlt data_con inst_tys arg_occs rhs }
 
   = ASSERT( isTupleTyCon tycon )
     do { let [data_con] = tyConDataCons tycon
        ; tcIfaceDataAlt data_con inst_tys arg_occs rhs }
 

+tcIfaceDataAlt :: DataCon -> [Type] -> [FastString] -> IfaceExpr
+               -> IfL (AltCon, [TyVar], CoreExpr)

 tcIfaceDataAlt con inst_tys arg_strs rhs
   = do { us <- newUniqueSupply
        ; let uniqs = uniqsFromSupply us
 tcIfaceDataAlt con inst_tys arg_strs rhs
   = do { us <- newUniqueSupply
        ; let uniqs = uniqsFromSupply us

@@ -861,9 +875,9 @@ do_one (IfaceNonRec bndr rhs) thing_inside
        ; return (NonRec bndr' rhs' : core_binds) }}
 
 do_one (IfaceRec pairs) thing_inside
        ; return (NonRec bndr' rhs' : core_binds) }}
 
 do_one (IfaceRec pairs) thing_inside

-  = do { bndrs' <- mappM newExtCoreBndr bndrs
+  = do { bndrs' <- mapM newExtCoreBndr bndrs

        ; extendIfaceIdEnv bndrs' $ do
        ; extendIfaceIdEnv bndrs' $ do

-       { rhss' <- mappM tcIfaceExpr rhss
+       { rhss' <- mapM tcIfaceExpr rhss

        ; core_binds <- thing_inside
        ; return (Rec (bndrs' `zip` rhss') : core_binds) }}
   where
        ; core_binds <- thing_inside
        ; return (Rec (bndrs' `zip` rhss') : core_binds) }}
   where

@@ -889,26 +903,27 @@ tcIdInfo ignore_prags name ty info
     -- we start; default assumption is that it has CAFs
     init_info = vanillaIdInfo
 
     -- we start; default assumption is that it has CAFs
     init_info = vanillaIdInfo
 

-    tcPrag info HsNoCafRefs         = returnM (info `setCafInfo`   NoCafRefs)
-    tcPrag info (HsArity arity)     = returnM (info `setArityInfo` arity)
-    tcPrag info (HsStrictness str)  = returnM (info `setAllStrictnessInfo` Just str)
+    tcPrag :: IdInfo -> IfaceInfoItem -> IfL IdInfo
+    tcPrag info HsNoCafRefs         = return (info `setCafInfo`   NoCafRefs)
+    tcPrag info (HsArity arity)     = return (info `setArityInfo` arity)
+    tcPrag info (HsStrictness str)  = return (info `setAllStrictnessInfo` Just str)

 
        -- The next two are lazy, so they don't transitively suck stuff in
     tcPrag info (HsWorker nm arity) = tcWorkerInfo ty info nm arity
 
        -- The next two are lazy, so they don't transitively suck stuff in
     tcPrag info (HsWorker nm arity) = tcWorkerInfo ty info nm arity

-    tcPrag info (HsInline inline_prag) = returnM (info `setInlinePragInfo` inline_prag)
-    tcPrag info (HsUnfold expr)
-       = tcPragExpr name expr  `thenM` \ maybe_expr' ->
+    tcPrag info (HsInline inline_prag) = return (info `setInlinePragInfo` inline_prag)
+    tcPrag info (HsUnfold expr) = do
+          maybe_expr' <- tcPragExpr name expr

          let
                -- maybe_expr' doesn't get looked at if the unfolding
                -- is never inspected; so the typecheck doesn't even happen
                unfold_info = case maybe_expr' of
                                Nothing    -> noUnfolding
                                Just expr' -> mkTopUnfolding expr' 
          let
                -- maybe_expr' doesn't get looked at if the unfolding
                -- is never inspected; so the typecheck doesn't even happen
                unfold_info = case maybe_expr' of
                                Nothing    -> noUnfolding
                                Just expr' -> mkTopUnfolding expr' 

-         in
-         returnM (info `setUnfoldingInfoLazily` unfold_info)
+          return (info `setUnfoldingInfoLazily` unfold_info)

 \end{code}
 
 \begin{code}
 \end{code}
 
 \begin{code}

+tcWorkerInfo :: Type -> IdInfo -> Name -> Arity -> IfL IdInfo

 tcWorkerInfo ty info wkr arity
   = do         { mb_wkr_id <- forkM_maybe doc (tcIfaceExtId wkr)
 
 tcWorkerInfo ty info wkr arity
   = do         { mb_wkr_id <- forkM_maybe doc (tcIfaceExtId wkr)
 

@@ -919,7 +934,7 @@ tcWorkerInfo ty info wkr arity
        -- over the unfolding until it's actually used does seem worth while.)
        ; us <- newUniqueSupply
 
        -- over the unfolding until it's actually used does seem worth while.)
        ; us <- newUniqueSupply
 

-       ; returnM (case mb_wkr_id of
+       ; return (case mb_wkr_id of

                     Nothing     -> info
                     Just wkr_id -> add_wkr_info us wkr_id info) }
   where
                     Nothing     -> info
                     Just wkr_id -> add_wkr_info us wkr_id info) }
   where

@@ -943,18 +958,17 @@ an unfolding that isn't going to be looked at.
 \begin{code}
 tcPragExpr :: Name -> IfaceExpr -> IfL (Maybe CoreExpr)
 tcPragExpr name expr
 \begin{code}
 tcPragExpr :: Name -> IfaceExpr -> IfL (Maybe CoreExpr)
 tcPragExpr name expr

-  = forkM_maybe doc $
-    tcIfaceExpr expr           `thenM` \ core_expr' ->
-
-               -- Check for type consistency in the unfolding
-    ifOptM Opt_DoCoreLinting (
-       get_in_scope_ids                        `thenM` \ in_scope -> 
-       case lintUnfolding noSrcLoc in_scope core_expr' of
-         Nothing       -> returnM ()
-         Just fail_msg -> pprPanic "Iface Lint failure" (hang doc 2 fail_msg)
-    )                          `thenM_`
-
-   returnM core_expr'  
+  = forkM_maybe doc $ do
+    core_expr' <- tcIfaceExpr expr
+
+                -- Check for type consistency in the unfolding
+    ifOptM Opt_DoCoreLinting $ do
+        in_scope <- get_in_scope_ids
+        case lintUnfolding noSrcLoc in_scope core_expr' of
+          Nothing       -> return ()
+          Just fail_msg -> pprPanic "Iface Lint failure" (hang doc 2 fail_msg)
+
+    return core_expr'

   where
     doc = text "Unfolding of" <+> ppr name
     get_in_scope_ids   -- Urgh; but just for linting
   where
     doc = text "Unfolding of" <+> ppr name
     get_in_scope_ids   -- Urgh; but just for linting

@@ -990,14 +1004,14 @@ tcIfaceGlobal name
                { type_env <- setLclEnv () get_type_env         -- yuk
                ; case lookupNameEnv type_env name of
                        Just thing -> return thing
                { type_env <- setLclEnv () get_type_env         -- yuk
                ; case lookupNameEnv type_env name of
                        Just thing -> return thing

-                       Nothing    -> pprPanic "tcIfaceGlobal (local): not found:"  
+                       Nothing   -> pprPanic "tcIfaceGlobal (local): not found:"  

                                                (ppr name $$ ppr type_env) }
 
                                                (ppr name $$ ppr type_env) }
 

-         ; other -> do
+         ; _ -> do

 
 

-       { (eps,hpt) <- getEpsAndHpt
-       ; dflags <- getDOpts
-       ; case lookupType dflags hpt (eps_PTE eps) name of {
+       { hsc_env <- getTopEnv
+        ; mb_thing <- liftIO (lookupTypeHscEnv hsc_env name)
+       ; case mb_thing of {

            Just thing -> return thing ;
            Nothing    -> do
 
            Just thing -> return thing ;
            Nothing    -> do
 

@@ -1035,7 +1049,8 @@ ifCheckWiredInThing name
                -- we may typecheck GHC.Base.hi. At that point, GHC.Base is not in
                -- the HPT, so without the test we'll demand-load it into the PIT!
                -- C.f. the same test in checkWiredInTyCon above
                -- we may typecheck GHC.Base.hi. At that point, GHC.Base is not in
                -- the HPT, so without the test we'll demand-load it into the PIT!
                -- C.f. the same test in checkWiredInTyCon above

-       ; unless (mod == nameModule name)
+       ; ASSERT2( isExternalName name, ppr name ) 
+         unless (mod == nameModule name)

                 (loadWiredInHomeIface name) }
 
 tcIfaceTyCon :: IfaceTyCon -> IfL TyCon
                 (loadWiredInHomeIface name) }
 
 tcIfaceTyCon :: IfaceTyCon -> IfL TyCon

@@ -1048,13 +1063,11 @@ tcIfaceTyCon (IfaceTupTc bx ar) = tcWiredInTyCon (tupleTyCon bx ar)
 tcIfaceTyCon (IfaceTc name)     = do { thing <- tcIfaceGlobal name 
                                     ; return (check_tc (tyThingTyCon thing)) }
   where
 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
+                   _         -> 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
 -- we should be okay just returning Kind constructors without extra loading
 tcIfaceTyCon IfaceLiftedTypeKindTc   = return liftedTypeKindTyCon
 tcIfaceTyCon IfaceOpenTypeKindTc     = return openTypeKindTyCon

@@ -1077,13 +1090,13 @@ tcIfaceDataCon :: Name -> IfL DataCon
 tcIfaceDataCon name = do { thing <- tcIfaceGlobal name
                         ; case thing of
                                ADataCon dc -> return dc
 tcIfaceDataCon name = do { thing <- tcIfaceGlobal name
                         ; case thing of
                                ADataCon dc -> return dc

-                               other   -> pprPanic "tcIfaceExtDC" (ppr name$$ ppr thing) }
+                               _       -> pprPanic "tcIfaceExtDC" (ppr name$$ ppr thing) }

 
 tcIfaceExtId :: Name -> IfL Id
 tcIfaceExtId name = do { thing <- tcIfaceGlobal name
                       ; case thing of
                          AnId id -> return id
 
 tcIfaceExtId :: Name -> IfL Id
 tcIfaceExtId name = do { thing <- tcIfaceGlobal name
                       ; case thing of
                          AnId id -> return id

-                         other   -> pprPanic "tcIfaceExtId" (ppr name$$ ppr thing) }
+                         _       -> pprPanic "tcIfaceExtId" (ppr name$$ ppr thing) }

 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************

@@ -1110,6 +1123,7 @@ bindIfaceBndrs (b:bs) thing_inside
     thing_inside (b':bs')
 
 -----------------------
     thing_inside (b':bs')
 
 -----------------------

+tcIfaceLetBndr :: IfaceLetBndr -> IfL Id

 tcIfaceLetBndr (IfLetBndr fs ty info)
   = do { name <- newIfaceName (mkVarOccFS fs)
        ; ty' <- tcIfaceType ty
 tcIfaceLetBndr (IfLetBndr fs ty info)
   = do { name <- newIfaceName (mkVarOccFS fs)
        ; ty' <- tcIfaceType ty

@@ -1127,7 +1141,7 @@ tcIfaceLetBndr (IfLetBndr fs ty info)
 
 -----------------------
 newExtCoreBndr :: IfaceLetBndr -> IfL Id
 
 -----------------------
 newExtCoreBndr :: IfaceLetBndr -> IfL Id

-newExtCoreBndr (IfLetBndr var ty _)    -- Ignoring IdInfo for now
+newExtCoreBndr (IfLetBndr var ty _)    -- Ignoring IdInfo for now

   = do { mod <- getIfModule
        ; name <- newGlobalBinder mod (mkVarOccFS var) noSrcSpan
        ; ty' <- tcIfaceType ty
   = do { mod <- getIfModule
        ; name <- newGlobalBinder mod (mkVarOccFS var) noSrcSpan
        ; ty' <- tcIfaceType ty

@@ -1136,14 +1150,14 @@ newExtCoreBndr (IfLetBndr var ty _)     -- Ignoring IdInfo for now
 -----------------------
 bindIfaceTyVar :: IfaceTvBndr -> (TyVar -> IfL a) -> IfL a
 bindIfaceTyVar (occ,kind) thing_inside
 -----------------------
 bindIfaceTyVar :: IfaceTvBndr -> (TyVar -> IfL a) -> IfL a
 bindIfaceTyVar (occ,kind) thing_inside

-  = do { name <- newIfaceName (mkTyVarOcc occ)
+  = do { name <- newIfaceName (mkTyVarOccFS occ)

        ; tyvar <- mk_iface_tyvar name kind
        ; extendIfaceTyVarEnv [tyvar] (thing_inside tyvar) }
 
 bindIfaceTyVars :: [IfaceTvBndr] -> ([TyVar] -> IfL a) -> IfL a
 bindIfaceTyVars bndrs thing_inside
        ; tyvar <- mk_iface_tyvar name kind
        ; extendIfaceTyVarEnv [tyvar] (thing_inside tyvar) }
 
 bindIfaceTyVars :: [IfaceTvBndr] -> ([TyVar] -> IfL a) -> IfL a
 bindIfaceTyVars bndrs thing_inside

-  = do { names <- newIfaceNames (map mkTyVarOcc occs)
-       ; tyvars <- TcRnMonad.zipWithM mk_iface_tyvar names kinds
+  = do { names <- newIfaceNames (map mkTyVarOccFS occs)
+       ; tyvars <- zipWithM mk_iface_tyvar names kinds

        ; extendIfaceTyVarEnv tyvars (thing_inside tyvars) }
   where
     (occs,kinds) = unzip bndrs
        ; extendIfaceTyVarEnv tyvars (thing_inside tyvars) }
   where
     (occs,kinds) = unzip bndrs