merge GHC HEAD
[ghc-hetmet.git] / compiler / iface / TcIface.lhs
index 7d0d02e..f29bf85 100644 (file)
@@ -21,6 +21,7 @@ import BuildTyCl
 import TcRnMonad
 import TcType
 import Type
+import Coercion
 import TypeRep
 import HscTypes
 import Annotations
@@ -39,8 +40,7 @@ import TyCon
 import DataCon
 import TysWiredIn
 import TysPrim         ( anyTyConOfKind )
-import Var              ( TyVar )
-import BasicTypes      ( nonRuleLoopBreaker )
+import BasicTypes      ( Arity, nonRuleLoopBreaker )
 import qualified Var
 import VarEnv
 import Name
@@ -48,7 +48,7 @@ import NameEnv
 import OccurAnal       ( occurAnalyseExpr )
 import Demand          ( isBottomingSig )
 import Module
-import LazyUniqFM
+import UniqFM
 import UniqSupply
 import Outputable      
 import ErrUtils
@@ -144,7 +144,7 @@ importDecl name
   where
     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 (nameOccName 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")])
 \end{code}
@@ -414,54 +414,57 @@ the forkM stuff.
 tcIfaceDecl :: Bool    -- True <=> discard IdInfo on IfaceId bindings
            -> IfaceDecl
            -> IfL TyThing
-
-tcIfaceDecl ignore_prags (IfaceId {ifName = occ_name, ifType = iface_type, 
-                                  ifIdDetails = details, ifIdInfo = info})
+tcIfaceDecl = tc_iface_decl NoParentTyCon
+
+tc_iface_decl :: TyConParent   -- For nested declarations
+              -> Bool  -- True <=> discard IdInfo on IfaceId bindings
+             -> IfaceDecl
+             -> IfL TyThing
+tc_iface_decl _ ignore_prags (IfaceId {ifName = occ_name, ifType = iface_type, 
+                                      ifIdDetails = details, ifIdInfo = info})
   = do { name <- lookupIfaceTop occ_name
        ; ty <- tcIfaceType iface_type
        ; details <- tcIdDetails ty details
        ; info <- tcIdInfo ignore_prags name ty info
        ; return (AnId (mkGlobalId details name ty info)) }
 
-tcIfaceDecl _ (IfaceData {ifName = occ_name, 
+tc_iface_decl parent _ (IfaceData {ifName = occ_name, 
                          ifTyVars = tv_bndrs, 
                          ifCtxt = ctxt, ifGadtSyntax = gadt_syn,
                          ifCons = rdr_cons, 
                          ifRec = is_rec, 
-                         ifGeneric = want_generic,
                          ifFamInst = mb_family })
   = bindIfaceTyVars_AT tv_bndrs $ \ tyvars -> do
     { tc_name <- lookupIfaceTop occ_name
     ; tycon <- fixM ( \ tycon -> do
            { stupid_theta <- tcIfaceCtxt ctxt
-           ; mb_fam_inst  <- tcFamInst mb_family
            ; cons <- tcIfaceDataCons tc_name tycon tyvars rdr_cons
-           ; buildAlgTyCon tc_name tyvars stupid_theta
-                           cons is_rec want_generic gadt_syn mb_fam_inst
+           ; mb_fam_inst  <- tcFamInst mb_family
+           ; buildAlgTyCon tc_name tyvars stupid_theta cons is_rec
+                           gadt_syn parent mb_fam_inst
            })
     ; traceIf (text "tcIfaceDecl4" <+> ppr tycon)
     ; return (ATyCon tycon) }
 
-tcIfaceDecl _ (IfaceSyn {ifName = occ_name, ifTyVars = tv_bndrs, 
-                        ifSynRhs = mb_rhs_ty,
-                        ifSynKind = kind, ifFamInst = mb_family})
+tc_iface_decl parent _ (IfaceSyn {ifName = occ_name, ifTyVars = tv_bndrs, 
+                                 ifSynRhs = mb_rhs_ty,
+                                 ifSynKind = kind, ifFamInst = mb_family})
    = bindIfaceTyVars_AT tv_bndrs $ \ tyvars -> do
-     { tc_name <- lookupIfaceTop occ_name
+     { tc_name  <- lookupIfaceTop occ_name
      ; 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 <- tcFamInst mb_family
-                        ; return (rhs, fam) }
-     ; tycon <- buildSynTyCon tc_name tyvars rhs rhs_kind fam
-     ; return $ ATyCon tycon
+     ; rhs      <- forkM (mk_doc tc_name) $ 
+                          tc_syn_rhs mb_rhs_ty
+     ; fam_info <- tcFamInst mb_family
+     ; tycon <- buildSynTyCon tc_name tyvars rhs rhs_kind parent fam_info
+     ; 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_rhs Nothing   = return SynFamilyTyCon
+     tc_syn_rhs (Just ty) = do { rhs_ty <- tcIfaceType ty
+                              ; return (SynonymTyCon rhs_ty) }
 
-tcIfaceDecl ignore_prags
+tc_iface_decl _parent ignore_prags
            (IfaceClass {ifCtxt = rdr_ctxt, ifName = occ_name, 
                         ifTyVars = tv_bndrs, ifFDs = rdr_fds, 
                         ifATs = rdr_ats, ifSigs = rdr_sigs, 
@@ -473,9 +476,9 @@ tcIfaceDecl ignore_prags
     ; ctxt <- tcIfaceCtxt rdr_ctxt
     ; sigs <- mapM tc_sig rdr_sigs
     ; fds  <- mapM tc_fd rdr_fds
-    ; ats' <- mapM (tcIfaceDecl ignore_prags) rdr_ats
-    ; let ats = map (setAssocFamilyPermutation tyvars) ats'
-    ; cls  <- buildClass ignore_prags cls_name tyvars ctxt fds ats sigs tc_isrec
+    ; cls  <- fixM $ \ cls -> do
+              { ats  <- mapM (tc_iface_decl (AssocFamilyTyCon cls) ignore_prags) rdr_ats
+              ; buildClass ignore_prags cls_name tyvars ctxt fds ats sigs tc_isrec }
     ; return (AClass cls) }
   where
    tc_sig (IfaceClassOp occ dm rdr_ty)
@@ -492,7 +495,7 @@ tcIfaceDecl ignore_prags
                           ; tvs2' <- mapM tcIfaceTyVar tvs2
                           ; return (tvs1', tvs2') }
 
-tcIfaceDecl _ (IfaceForeign {ifName = rdr_name, ifExtName = ext_name})
+tc_iface_decl _ _ (IfaceForeign {ifName = rdr_name, ifExtName = ext_name})
   = do { name <- lookupIfaceTop rdr_name
        ; return (ATyCon (mkForeignTyCon name ext_name 
                                         liftedTypeKind 0)) }
@@ -507,7 +510,7 @@ tcIfaceDataCons :: Name -> TyCon -> [TyVar] -> IfaceConDecls -> IfL AlgTyConRhs
 tcIfaceDataCons tycon_name tycon _ if_cons
   = case if_cons of
        IfAbstractTyCon  -> return mkAbstractTyConRhs
-       IfOpenDataTyCon  -> return mkOpenDataTyConRhs
+       IfOpenDataTyCon  -> return DataFamilyTyCon
        IfDataTyCon cons -> do  { data_cons <- mapM tc_con_decl cons
                                ; return (mkDataTyConRhs data_cons) }
        IfNewTyCon con   -> do  { data_con <- tc_con_decl con
@@ -623,7 +626,8 @@ tcIfaceRules ignore_prags if_rules
 
 tcIfaceRule :: IfaceRule -> IfL CoreRule
 tcIfaceRule (IfaceRule {ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
-                       ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs })
+                       ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs,
+                        ifRuleAuto = auto })
   = do { ~(bndrs', args', rhs') <- 
                -- Typecheck the payload lazily, in the hope it'll never be looked at
                forkM (ptext (sLit "Rule") <+> ftext name) $
@@ -636,6 +640,7 @@ tcIfaceRule (IfaceRule {ifRuleName = name, ifActivation = act, ifRuleBndrs = bnd
                          ru_bndrs = bndrs', ru_args = args', 
                          ru_rhs = occurAnalyseExpr rhs', 
                          ru_rough = mb_tcs,
+                          ru_auto = auto,
                          ru_local = False }) } -- An imported RULE is never for a local Id
                                                -- or, even if it is (module loop, perhaps)
                                                -- we'll just leave it in the non-local set
@@ -785,20 +790,56 @@ tcIfaceType (IfaceAppTy t1 t2)    = do { t1' <- tcIfaceType t1; t2' <- tcIfaceTy
 tcIfaceType (IfaceFunTy t1 t2)    = do { t1' <- tcIfaceType t1; t2' <- tcIfaceType t2; return (FunTy t1' t2') }
 tcIfaceType (IfaceTyConApp tc ts) = do { tc' <- tcIfaceTyCon tc; ts' <- tcIfaceTypes ts; return (mkTyConApp tc' ts') }
 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 (IfacePredTy st)      = do { st' <- tcIfacePred tcIfaceType st; return (PredTy st') }
+tcIfaceType t@(IfaceCoConApp {})  = pprPanic "tcIfaceType" (ppr t)
 
 tcIfaceTypes :: [IfaceType] -> IfL [Type]
 tcIfaceTypes tys = mapM tcIfaceType tys
 
 -----------------------------------------
-tcIfacePredType :: IfacePredType -> IfL PredType
-tcIfacePredType (IfaceClassP cls ts) = do { cls' <- tcIfaceClass cls; ts' <- tcIfaceTypes ts; return (ClassP cls' ts') }
-tcIfacePredType (IfaceIParam ip t)   = do { ip' <- newIPName ip; t' <- tcIfaceType t; return (IParam ip' t') }
-tcIfacePredType (IfaceEqPred t1 t2)  = do { t1' <- tcIfaceType t1; t2' <- tcIfaceType t2; return (EqPred t1' t2') }
+tcIfacePred :: (IfaceType -> IfL a) -> IfacePredType -> IfL (Pred a)
+tcIfacePred tc (IfaceClassP cls ts)
+  = do { cls' <- tcIfaceClass cls; ts' <- mapM tc ts; return (ClassP cls' ts') }
+tcIfacePred tc (IfaceIParam ip t)
+  = do { ip' <- newIPName ip; t' <- tc t; return (IParam ip' t') }
+tcIfacePred tc (IfaceEqPred t1 t2)
+  = do { t1' <- tc t1; t2' <- tc t2; return (EqPred t1' t2') }
 
 -----------------------------------------
 tcIfaceCtxt :: IfaceContext -> IfL ThetaType
-tcIfaceCtxt sts = mapM tcIfacePredType sts
+tcIfaceCtxt sts = mapM (tcIfacePred tcIfaceType) sts
+\end{code}
+
+%************************************************************************
+%*                                                                     *
+                       Coercions
+%*                                                                     *
+%************************************************************************
+
+\begin{code}
+tcIfaceCo :: IfaceType -> IfL Coercion
+tcIfaceCo (IfaceTyVar n)        = mkCoVarCo <$> tcIfaceCoVar n
+tcIfaceCo (IfaceAppTy t1 t2)    = mkAppCo <$> tcIfaceCo t1 <*> tcIfaceCo t2
+tcIfaceCo (IfaceFunTy t1 t2)    = mkFunCo <$> tcIfaceCo t1 <*> tcIfaceCo t2
+tcIfaceCo (IfaceTyConApp tc ts) = mkTyConAppCo <$> tcIfaceTyCon tc <*> mapM tcIfaceCo ts
+tcIfaceCo (IfaceCoConApp tc ts) = tcIfaceCoApp tc ts
+tcIfaceCo (IfaceForAllTy tv t)  = bindIfaceTyVar tv $ \ tv' ->
+                                  mkForAllCo tv' <$> tcIfaceCo t
+-- tcIfaceCo (IfacePredTy co)      = mkPredCo <$> tcIfacePred tcIfaceCo co
+tcIfaceCo (IfacePredTy _)      = panic "tcIfaceCo"
+
+tcIfaceCoApp :: IfaceCoCon -> [IfaceType] -> IfL Coercion
+tcIfaceCoApp IfaceReflCo    [t]     = Refl         <$> tcIfaceType t
+tcIfaceCoApp (IfaceCoAx n)  ts      = AxiomInstCo  <$> tcIfaceCoAxiom n <*> mapM tcIfaceCo ts
+tcIfaceCoApp IfaceUnsafeCo  [t1,t2] = UnsafeCo     <$> tcIfaceType t1 <*> tcIfaceType t2
+tcIfaceCoApp IfaceSymCo     [t]     = SymCo        <$> tcIfaceCo t
+tcIfaceCoApp IfaceTransCo   [t1,t2] = TransCo      <$> tcIfaceCo t1 <*> tcIfaceCo t2
+tcIfaceCoApp IfaceInstCo    [t1,t2] = InstCo       <$> tcIfaceCo t1 <*> tcIfaceType t2
+tcIfaceCoApp (IfaceNthCo d) [t]     = NthCo d      <$> tcIfaceCo t
+tcIfaceCoApp cc ts = pprPanic "toIfaceCoApp" (ppr cc <+> ppr ts)
+
+tcIfaceCoVar :: FastString -> IfL CoVar
+tcIfaceCoVar = tcIfaceLclId
 \end{code}
 
 
@@ -813,6 +854,12 @@ tcIfaceExpr :: IfaceExpr -> IfL CoreExpr
 tcIfaceExpr (IfaceType ty)
   = Type <$> tcIfaceType ty
 
+tcIfaceExpr (IfaceCo co)
+  = Coercion <$> tcIfaceCo co
+
+tcIfaceExpr (IfaceCast expr co)
+  = Cast <$> tcIfaceExpr expr <*> tcIfaceCo co
+
 tcIfaceExpr (IfaceLcl name)
   = Var <$> tcIfaceLclId name
 
@@ -847,7 +894,7 @@ tcIfaceExpr (IfaceLam bndr body)
 tcIfaceExpr (IfaceApp fun arg)
   = App <$> tcIfaceExpr fun <*> tcIfaceExpr arg
 
-tcIfaceExpr (IfaceCase scrut case_bndr ty alts)  = do
+tcIfaceExpr (IfaceCase scrut case_bndr alts)  = do
     scrut' <- tcIfaceExpr scrut
     case_bndr_name <- newIfaceName (mkVarOccFS case_bndr)
     let
@@ -862,28 +909,34 @@ tcIfaceExpr (IfaceCase scrut case_bndr ty alts)  = do
 
     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
-    expr' <- tcIfaceExpr expr
-    co' <- tcIfaceType co
-    return (Cast expr' co')
+     return (Case scrut' case_bndr' (coreAltsType alts') alts')
+
+tcIfaceExpr (IfaceLet (IfaceNonRec (IfLetBndr fs ty info) rhs) body)
+  = do { name    <- newIfaceName (mkVarOccFS fs)
+       ; ty'     <- tcIfaceType ty
+        ; id_info <- tcIdInfo False {- Don't ignore prags; we are inside one! -}
+                              name ty' info
+       ; let id = mkLocalIdWithInfo name ty' id_info
+        ; rhs' <- tcIfaceExpr rhs
+        ; body' <- extendIfaceIdEnv [id] (tcIfaceExpr body)
+        ; return (Let (NonRec id rhs') body') }
+
+tcIfaceExpr (IfaceLet (IfaceRec pairs) body)
+  = do { ids <- mapM tc_rec_bndr (map fst pairs)
+       ; extendIfaceIdEnv ids $ do
+       { pairs' <- zipWithM tc_pair pairs ids
+       ; body' <- tcIfaceExpr body
+       ; return (Let (Rec pairs') body') } }
+ where
+   tc_rec_bndr (IfLetBndr fs ty _) 
+     = do { name <- newIfaceName (mkVarOccFS fs)  
+          ; ty'  <- tcIfaceType ty
+          ; return (mkLocalId name ty') }
+   tc_pair (IfLetBndr _ _ info, rhs) id
+     = do { rhs' <- tcIfaceExpr rhs
+          ; id_info <- tcIdInfo False {- Don't ignore prags; we are inside one! -}
+                                (idName id) (idType id) info
+          ; return (setIdInfo id id_info, rhs') }
 
 tcIfaceExpr (IfaceNote note expr) = do
     expr' <- tcIfaceExpr expr
@@ -915,7 +968,7 @@ tcIfaceAlt scrut (tycon, inst_tys) (IfaceDataAlt data_occ, arg_strs, rhs)
        ; tcIfaceDataAlt con inst_tys arg_strs rhs }
                  
 tcIfaceAlt _ (tycon, inst_tys) (IfaceTupleAlt _boxity, arg_occs, rhs)
-  = ASSERT( isTupleTyCon tycon )
+  = ASSERT2( isTupleTyCon tycon, ppr tycon )
     do { let [data_con] = tyConDataCons tycon
        ; tcIfaceDataAlt data_con inst_tys arg_occs rhs }
 
@@ -924,14 +977,13 @@ tcIfaceDataAlt :: DataCon -> [Type] -> [FastString] -> IfaceExpr
 tcIfaceDataAlt con inst_tys arg_strs rhs
   = do { us <- newUniqueSupply
        ; let uniqs = uniqsFromSupply us
-       ; let (ex_tvs, co_tvs, arg_ids)
+       ; let (ex_tvs, arg_ids)
                      = dataConRepFSInstPat arg_strs uniqs con inst_tys
-              all_tvs = ex_tvs ++ co_tvs
 
-       ; rhs' <- extendIfaceTyVarEnv all_tvs   $
+       ; rhs' <- extendIfaceTyVarEnv ex_tvs    $
                  extendIfaceIdEnv arg_ids      $
                  tcIfaceExpr rhs
-       ; return (DataAlt con, all_tvs ++ arg_ids, rhs') }
+       ; return (DataAlt con, ex_tvs ++ arg_ids, rhs') }
 \end{code}
 
 
@@ -968,10 +1020,10 @@ do_one (IfaceRec pairs) thing_inside
 \begin{code}
 tcIdDetails :: Type -> IfaceIdDetails -> IfL IdDetails
 tcIdDetails _  IfVanillaId = return VanillaId
-tcIdDetails ty IfDFunId
-  = return (DFunId (isNewTyCon (classTyCon cls)))
+tcIdDetails ty (IfDFunId ns)
+  = return (DFunId ns (isNewTyCon (classTyCon cls)))
   where
-    (_, cls, _) = tcSplitDFunTy ty
+    (_, _, cls, _) = tcSplitDFunTy ty
 
 tcIdDetails _ (IfRecSelId tc naughty)
   = do { tc' <- tcIfaceTyCon tc
@@ -1004,11 +1056,14 @@ tcIdInfo ignore_prags name ty info
 
 \begin{code}
 tcUnfolding :: Name -> Type -> IdInfo -> IfaceUnfolding -> IfL Unfolding
-tcUnfolding name _ info (IfCoreUnfold if_expr)
+tcUnfolding name _ info (IfCoreUnfold stable if_expr)
   = do         { mb_expr <- tcPragExpr name if_expr
+        ; let unf_src = if stable then InlineStable else InlineRhs
        ; return (case mb_expr of
-                   Nothing -> NoUnfolding
-                   Just expr -> mkTopUnfolding is_bottoming expr) }
+                   Nothing   -> NoUnfolding
+                   Just expr -> mkUnfolding unf_src
+                                             True {- Top level -} 
+                                             is_bottoming expr) }
   where
      -- Strictness should occur before unfolding!
     is_bottoming = case strictnessInfo info of
@@ -1025,12 +1080,30 @@ tcUnfolding name _ _ (IfInlineRule arity unsat_ok boring_ok if_expr)
   = do         { mb_expr <- tcPragExpr name if_expr
        ; return (case mb_expr of
                    Nothing   -> NoUnfolding
-                   Just expr -> mkCoreUnfolding True InlineRule expr arity 
+                   Just expr -> mkCoreUnfolding InlineStable True expr arity 
                                                  (UnfWhen unsat_ok boring_ok))
     }
 
-tcUnfolding name ty info (IfWrapper arity wkr)
-  = do         { mb_wkr_id <- forkM_maybe doc (tcIfaceExtId wkr)
+tcUnfolding name dfun_ty _ (IfDFunUnfold ops)
+  = do { mb_ops1 <- forkM_maybe doc $ mapM tc_arg ops
+       ; return (case mb_ops1 of
+                           Nothing   -> noUnfolding
+                    Just ops1 -> mkDFunUnfolding dfun_ty ops1) }
+  where
+    doc = text "Class ops for dfun" <+> ppr name
+    tc_arg (DFunPolyArg  e) = do { e' <- tcIfaceExpr e; return (DFunPolyArg e') }
+    tc_arg (DFunConstArg e) = do { e' <- tcIfaceExpr e; return (DFunConstArg e') }
+    tc_arg (DFunLamArg i)   = return (DFunLamArg i)
+
+tcUnfolding name ty info (IfExtWrapper arity wkr)
+  = tcIfaceWrapper name ty info arity (tcIfaceExtId wkr)
+tcUnfolding name ty info (IfLclWrapper arity wkr)
+  = tcIfaceWrapper name ty info arity (tcIfaceLclId wkr)
+
+-------------
+tcIfaceWrapper :: Name -> Type -> IdInfo -> Arity -> IfL Id -> IfL Unfolding
+tcIfaceWrapper name ty info arity get_worker
+  = do         { mb_wkr_id <- forkM_maybe doc get_worker
        ; us <- newUniqueSupply
        ; return (case mb_wkr_id of
                     Nothing     -> noUnfolding
@@ -1047,17 +1120,7 @@ tcUnfolding name ty info (IfWrapper arity wkr)
        -- before unfolding
     strict_sig = case strictnessInfo info of
                   Just sig -> sig
-                  Nothing  -> pprPanic "Worker info but no strictness for" (ppr wkr)
-
-tcUnfolding name dfun_ty _ (IfDFunUnfold ops)
-  = do { mb_ops1 <- forkM_maybe doc $ mapM tcIfaceExpr ops
-       ; return (case mb_ops1 of
-                           Nothing   -> noUnfolding
-                    Just ops1 -> DFunUnfolding data_con ops1) }
-  where
-    doc = text "Class ops for dfun" <+> ppr name
-    (_, cls, _) = tcSplitDFunTy dfun_ty
-    data_con = classDataCon cls
+                  Nothing  -> pprPanic "Worker info but no strictness for" (ppr name)
 \end{code}
 
 For unfoldings we try to do the job lazily, so that we never type check
@@ -1070,23 +1133,31 @@ tcPragExpr name expr
     core_expr' <- tcIfaceExpr expr
 
                 -- Check for type consistency in the unfolding
-    ifOptM Opt_DoCoreLinting $ do
-        in_scope <- get_in_scope_ids
+    ifDOptM Opt_DoCoreLinting $ do
+        in_scope <- get_in_scope
         case lintUnfolding noSrcLoc in_scope core_expr' of
           Nothing       -> return ()
-          Just fail_msg -> pprPanic "Iface Lint failure" (hang doc 2 fail_msg)
-
+          Just fail_msg -> do { mod <- getIfModule 
+                              ; pprPanic "Iface Lint failure" 
+                                  (vcat [ ptext (sLit "In interface for") <+> ppr mod
+                                        , hang doc 2 fail_msg
+                                        , ppr name <+> equals <+> ppr core_expr'
+                                        , ptext (sLit "Iface expr =") <+> ppr expr ]) }
     return core_expr'
   where
     doc = text "Unfolding of" <+> ppr name
-    get_in_scope_ids   -- Urgh; but just for linting
-       = setLclEnv () $ 
-         do    { env <- getGblEnv 
-               ; case if_rec_types env of {
-                         Nothing -> return [] ;
-                         Just (_, get_env) -> do
-               { type_env <- get_env
-               ; return (typeEnvIds type_env) }}}
+
+    get_in_scope :: IfL [Var] -- Totally disgusting; but just for linting
+    get_in_scope       
+       = do { (gbl_env, lcl_env) <- getEnvs
+             ; rec_ids <- case if_rec_types gbl_env of
+                            Nothing -> return []
+                            Just (_, get_env) -> do
+                               { type_env <- setLclEnv () get_env
+                               ; return (typeEnvIds type_env) }
+             ; return (varEnvElts (if_tv_env lcl_env) ++
+                       varEnvElts (if_id_env lcl_env) ++
+                       rec_ids) }
 \end{code}
 
 
@@ -1180,6 +1251,10 @@ tcIfaceClass :: Name -> IfL Class
 tcIfaceClass name = do { thing <- tcIfaceGlobal name
                       ; return (tyThingClass thing) }
 
+tcIfaceCoAxiom :: Name -> IfL CoAxiom
+tcIfaceCoAxiom name = do { thing <- tcIfaceGlobal name
+                        ; return (tyThingCoAxiom thing) }
+
 tcIfaceDataCon :: Name -> IfL DataCon
 tcIfaceDataCon name = do { thing <- tcIfaceGlobal name
                         ; case thing of
@@ -1216,24 +1291,6 @@ bindIfaceBndrs (b:bs) thing_inside
     bindIfaceBndrs bs  $ \ bs' ->
     thing_inside (b':bs')
 
-
------------------------
-tcIfaceLetBndr :: IfaceLetBndr -> IfL Id
-tcIfaceLetBndr (IfLetBndr fs ty info)
-  = do { name <- newIfaceName (mkVarOccFS fs)
-       ; ty' <- tcIfaceType ty
-       ; case info of
-               NoInfo    -> return (mkLocalId name ty')
-               HasInfo i -> return (mkLocalIdWithInfo name ty' (tc_info i)) } 
-  where
-       -- Similar to tcIdInfo, but much simpler
-    tc_info [] = vanillaIdInfo
-    tc_info (HsInline p     : i) = tc_info i `setInlinePragInfo` p 
-    tc_info (HsArity a      : i) = tc_info i `setArityInfo` a 
-    tc_info (HsStrictness s : i) = tc_info i `setStrictnessInfo` Just s 
-    tc_info (other          : i) = pprTrace "tcIfaceLetBndr: discarding unexpected IdInfo" 
-                                           (ppr other) (tc_info i)
-
 -----------------------
 newExtCoreBndr :: IfaceLetBndr -> IfL Id
 newExtCoreBndr (IfLetBndr var ty _)    -- Ignoring IdInfo for now