TcIface.hs 59.2 KB
Newer Older
Austin Seipp's avatar
Austin Seipp committed
1 2 3 4
{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998

Simon Marlow's avatar
Simon Marlow committed
5 6

Type checking of type signatures in interface files
Austin Seipp's avatar
Austin Seipp committed
7
-}
8

9 10
{-# LANGUAGE CPP #-}

Simon Peyton Jones's avatar
Simon Peyton Jones committed
11 12 13
module TcIface (
        tcLookupImported_maybe,
        importDecl, checkWiredInTyCon, tcHiBootIface, typecheckIface,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
14
        tcIfaceDecl, tcIfaceInst, tcIfaceFamInst, tcIfaceRules,
Simon Peyton Jones's avatar
Simon Peyton Jones committed
15
        tcIfaceVectInfo, tcIfaceAnnotations,
16
        tcIfaceExpr,    -- Desired by HERMIT (Trac #7683)
17
        tcIfaceGlobal
18
 ) where
19

20 21
#include "HsVersions.h"

22
import TcTypeNats(typeNatCoAxiomRules)
23
import IfaceSyn
Simon Marlow's avatar
Simon Marlow committed
24 25 26
import LoadIface
import IfaceEnv
import BuildTyCl
27
import TcRnMonad
28
import TcType
Simon Marlow's avatar
Simon Marlow committed
29
import Type
30
import Coercion hiding (substTy)
Simon Marlow's avatar
Simon Marlow committed
31 32
import TypeRep
import HscTypes
33
import Annotations
Simon Marlow's avatar
Simon Marlow committed
34 35
import InstEnv
import FamInstEnv
36
import CoreSyn
Simon Marlow's avatar
Simon Marlow committed
37
import CoreUtils
38
import CoreUnfold
Simon Marlow's avatar
Simon Marlow committed
39
import CoreLint
40
import MkCore
Simon Marlow's avatar
Simon Marlow committed
41 42 43 44 45
import Id
import MkId
import IdInfo
import Class
import TyCon
46
import CoAxiom
Gergő Érdi's avatar
Gergő Érdi committed
47
import ConLike
Simon Marlow's avatar
Simon Marlow committed
48
import DataCon
49
import PrelNames
Simon Marlow's avatar
Simon Marlow committed
50
import TysWiredIn
51
import TysPrim          ( superKindTyConName )
52
import BasicTypes       ( strongLoopBreaker )
53
import Literal
Simon Marlow's avatar
Simon Marlow committed
54
import qualified Var
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
55
import VarEnv
56
import VarSet
Simon Marlow's avatar
Simon Marlow committed
57
import Name
58
import NameEnv
59 60
import NameSet
import OccurAnal        ( occurAnalyseExpr )
61
import Demand
Simon Marlow's avatar
Simon Marlow committed
62
import Module
63
import UniqFM
Simon Marlow's avatar
Simon Marlow committed
64
import UniqSupply
Simon Peyton Jones's avatar
Simon Peyton Jones committed
65
import Outputable
Simon Marlow's avatar
Simon Marlow committed
66 67 68
import Maybes
import SrcLoc
import DynFlags
Ian Lynagh's avatar
Ian Lynagh committed
69
import Util
70
import FastString
Simon Marlow's avatar
Simon Marlow committed
71

72
import Control.Monad
73
import qualified Data.Map as Map
74
#if __GLASGOW_HASKELL__ < 709
75
import Data.Traversable ( traverse )
76
#endif
77

Austin Seipp's avatar
Austin Seipp committed
78
{-
79 80
This module takes

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
81 82 83
        IfaceDecl -> TyThing
        IfaceType -> Type
        etc
84 85 86 87

An IfaceDecl is populated with RdrNames, and these are not renamed to
Names before typechecking, because there should be no scope errors etc.

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
88
        -- For (b) consider: f = \$(...h....)
Simon Peyton Jones's avatar
Simon Peyton Jones committed
89
        -- where h is imported, and calls f via an hi-boot file.
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
90
        -- This is bad!  But it is not seen as a staging error, because h
Simon Peyton Jones's avatar
Simon Peyton Jones committed
91
        -- is indeed imported.  We don't want the type-checker to black-hole
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
92 93 94 95 96
        -- when simplifying and compiling the splice!
        --
        -- Simple solution: discard any unfolding that mentions a variable
        -- bound in this module (and hence not yet processed).
        -- The discarding happens when forkM finds a type error.
97

98

Austin Seipp's avatar
Austin Seipp committed
99 100
************************************************************************
*                                                                      *
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
101
                Type-checking a complete interface
Austin Seipp's avatar
Austin Seipp committed
102 103
*                                                                      *
************************************************************************
104

105 106 107 108 109 110 111
Suppose we discover we don't need to recompile.  Then we must type
check the old interface file.  This is a bit different to the
incremental type checking we do as we suck in interface files.  Instead
we do things similarly as when we are typechecking source decls: we
bring into scope the type envt for the interface all at once, using a
knot.  Remember, the decls aren't necessarily in dependency order --
and even if they were, the type decls might be mutually recursive.
Austin Seipp's avatar
Austin Seipp committed
112
-}
113

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
114 115
typecheckIface :: ModIface      -- Get the decls from here
               -> TcRnIf gbl lcl ModDetails
116 117
typecheckIface iface
  = initIfaceTc iface $ \ tc_env_var -> do
Simon Peyton Jones's avatar
Simon Peyton Jones committed
118
        -- The tc_env_var is freshly allocated, private to
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
119 120 121 122
        -- type-checking this particular interface
        {       -- Get the right set of decls and rules.  If we are compiling without -O
                -- we discard pragmas before typechecking, so that we don't "see"
                -- information that we shouldn't.  From a versioning point of view
Simon Peyton Jones's avatar
Simon Peyton Jones committed
123
                -- It's not actually *wrong* to do so, but in fact GHCi is unable
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
124
                -- to handle unboxed tuples, so it must not see unfoldings.
ian@well-typed.com's avatar
ian@well-typed.com committed
125
          ignore_prags <- goptM Opt_IgnoreInterfacePragmas
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
126 127 128 129 130 131 132 133 134 135 136 137 138 139

                -- Typecheck the decls.  This is done lazily, so that the knot-tying
                -- within this single module work out right.  In the If monad there is
                -- no global envt for the current interface; instead, the knot is tied
                -- through the if_rec_types field of IfGblEnv
        ; names_w_things <- loadDecls ignore_prags (mi_decls iface)
        ; let type_env = mkNameEnv names_w_things
        ; writeMutVar tc_env_var type_env

                -- Now do those rules, instances and annotations
        ; insts     <- mapM tcIfaceInst (mi_insts iface)
        ; fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface)
        ; rules     <- tcIfaceRules ignore_prags (mi_rules iface)
        ; anns      <- tcIfaceAnnotations (mi_anns iface)
140

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
141
                -- Vectorisation information
142
        ; vect_info <- tcIfaceVectInfo (mi_module iface) type_env (mi_vect_info iface)
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
143

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
144 145 146 147 148 149 150 151 152 153 154
                -- Exports
        ; exports <- ifaceExportNames (mi_exports iface)

                -- Finished
        ; traceIf (vcat [text "Finished typechecking interface for" <+> ppr (mi_module iface),
                         text "Type envt:" <+> ppr type_env])
        ; return $ ModDetails { md_types     = type_env
                              , md_insts     = insts
                              , md_fam_insts = fam_insts
                              , md_rules     = rules
                              , md_anns      = anns
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
155
                              , md_vect_info = vect_info
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
156 157
                              , md_exports   = exports
                              }
158
    }
159

Austin Seipp's avatar
Austin Seipp committed
160 161 162
{-
************************************************************************
*                                                                      *
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
163
                Type and class declarations
Austin Seipp's avatar
Austin Seipp committed
164 165 166
*                                                                      *
************************************************************************
-}
167

168
tcHiBootIface :: HscSource -> Module -> TcRn ModDetails
169 170 171
-- Load the hi-boot iface for the module being compiled,
-- if it indeed exists in the transitive closure of imports
-- Return the ModDetails, empty if no hi-boot iface
172
tcHiBootIface hsc_src mod
173
  | HsBootFile <- hsc_src            -- Already compiling a hs-boot file
174 175
  = return emptyModDetails
  | otherwise
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
176 177 178 179 180 181
  = do  { traceIf (text "loadHiBootInterface" <+> ppr mod)

        ; mode <- getGhcMode
        ; if not (isOneShot mode)
                -- In --make and interactive mode, if this module has an hs-boot file
                -- we'll have compiled it already, and it'll be in the HPT
Simon Peyton Jones's avatar
Simon Peyton Jones committed
182
                --
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
183 184
                -- We check wheher the interface is a *boot* interface.
                -- It can happen (when using GHC from Visual Studio) that we
Simon Peyton Jones's avatar
Simon Peyton Jones committed
185
                -- compile a module in TypecheckOnly mode, with a stable,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
186 187
                -- fully-populated HPT.  In that case the boot interface isn't there
                -- (it's been replaced by the mother module) so we can't check it.
Simon Peyton Jones's avatar
Simon Peyton Jones committed
188
                -- And that's fine, because if M's ModInfo is in the HPT, then
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
189 190 191
                -- it's been compiled once, and we don't need to check the boot iface
          then do { hpt <- getHpt
                  ; case lookupUFM hpt (moduleName mod) of
Simon Peyton Jones's avatar
Simon Peyton Jones committed
192
                      Just info | mi_boot (hm_iface info)
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
193 194 195 196
                                -> return (hm_details info)
                      _ -> return emptyModDetails }
          else do

Simon Peyton Jones's avatar
Simon Peyton Jones committed
197
        -- OK, so we're in one-shot mode.
198 199 200 201 202 203
        -- Re #9245, we always check if there is an hi-boot interface
        -- to check consistency against, rather than just when we notice
        -- that an hi-boot is necessary due to a circular import.
        { read_result <- findAndReadIface
                                need mod
                                True    -- Hi-boot file
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
204

205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220
        ; case read_result of {
                Succeeded (iface, _path) -> typecheckIface iface ;
                Failed err               ->

        -- There was no hi-boot file. But if there is circularity in
        -- the module graph, there really should have been one.
        -- Since we've read all the direct imports by now,
        -- eps_is_boot will record if any of our imports mention the
        -- current module, which either means a module loop (not
        -- a SOURCE import) or that our hi-boot file has mysteriously
        -- disappeared.
    do  { eps <- getEps
        ; case lookupUFM (eps_is_boot eps) (moduleName mod) of
            Nothing -> return emptyModDetails -- The typical case

            Just (_, False) -> failWithTc moduleLoop
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
221 222
                -- Someone below us imported us!
                -- This is a loop with no hi-boot in the way
Simon Peyton Jones's avatar
Simon Peyton Jones committed
223

224 225
            Just (_mod, True) -> failWithTc (elaborate err)
                -- The hi-boot file has mysteriously disappeared.
226
    }}}}
227
  where
Ian Lynagh's avatar
Ian Lynagh committed
228
    need = ptext (sLit "Need the hi-boot interface for") <+> ppr mod
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
229
                 <+> ptext (sLit "to compare against the Real Thing")
230

Simon Peyton Jones's avatar
Simon Peyton Jones committed
231
    moduleLoop = ptext (sLit "Circular imports: module") <+> quotes (ppr mod)
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
232
                     <+> ptext (sLit "depends on itself")
233

Simon Peyton Jones's avatar
Simon Peyton Jones committed
234
    elaborate err = hang (ptext (sLit "Could not find hi-boot interface for") <+>
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
235
                          quotes (ppr mod) <> colon) 4 err
236

Austin Seipp's avatar
Austin Seipp committed
237 238 239
{-
************************************************************************
*                                                                      *
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
240
                Type and class declarations
Austin Seipp's avatar
Austin Seipp committed
241 242
*                                                                      *
************************************************************************
243 244 245 246 247 248

When typechecking a data type decl, we *lazily* (via forkM) typecheck
the constructor argument types.  This is in the hope that we may never
poke on those argument types, and hence may never need to load the
interface files for types mentioned in the arg types.

Simon Peyton Jones's avatar
Simon Peyton Jones committed
249
E.g.
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
250
        data Foo.S = MkS Baz.T
251 252 253
Mabye we can get away without even loading the interface for Baz!

This is not just a performance thing.  Suppose we have
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
254 255
        data Foo.S = MkS Baz.T
        data Baz.T = MkT Foo.S
256
(in different interface files, of course).
Simon Peyton Jones's avatar
Simon Peyton Jones committed
257
Now, first we load and typecheck Foo.S, and add it to the type envt.
258
If we do explore MkS's argument, we'll load and typecheck Baz.T.
Simon Peyton Jones's avatar
Simon Peyton Jones committed
259
If we explore MkT's argument we'll find Foo.S already in the envt.
260 261 262 263 264 265 266 267 268 269 270

If we typechecked constructor args eagerly, when loading Foo.S we'd try to
typecheck the type Baz.T.  So we'd fault in Baz.T... and then need Foo.S...
which isn't done yet.

All very cunning. However, there is a rather subtle gotcha which bit
me when developing this stuff.  When we typecheck the decl for S, we
extend the type envt with S, MkS, and all its implicit Ids.  Suppose
(a bug, but it happened) that the list of implicit Ids depended in
turn on the constructor arg types.  Then the following sequence of
events takes place:
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
271 272 273
        * we build a thunk <t> for the constructor arg tys
        * we build a thunk for the extended type environment (depends on <t>)
        * we write the extended type envt into the global EPS mutvar
Simon Peyton Jones's avatar
Simon Peyton Jones committed
274

275
Now we look something up in the type envt
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
276 277 278
        * that pulls on <t>
        * which reads the global type envt out of the global EPS mutvar
        * but that depends in turn on <t>
279

Simon Peyton Jones's avatar
Simon Peyton Jones committed
280
It's subtle, because, it'd work fine if we typechecked the constructor args
281 282 283 284 285
eagerly -- they don't need the extended type envt.  They just get the extended
type envt by accident, because they look at it later.

What this means is that the implicitTyThings MUST NOT DEPEND on any of
the forkM stuff.
Austin Seipp's avatar
Austin Seipp committed
286
-}
287

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
288 289 290
tcIfaceDecl :: Bool     -- True <=> discard IdInfo on IfaceId bindings
            -> IfaceDecl
            -> IfL TyThing
291 292
tcIfaceDecl = tc_iface_decl NoParentTyCon

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
293 294 295 296
tc_iface_decl :: TyConParent    -- For nested declarations
              -> Bool   -- True <=> discard IdInfo on IfaceId bindings
              -> IfaceDecl
              -> IfL TyThing
Simon Peyton Jones's avatar
Simon Peyton Jones committed
297
tc_iface_decl _ ignore_prags (IfaceId {ifName = occ_name, ifType = iface_type,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
298 299 300 301 302 303
                                       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)) }
304

Simon Peyton Jones's avatar
Simon Peyton Jones committed
305 306
tc_iface_decl parent _ (IfaceData {ifName = occ_name,
                          ifCType = cType,
307 308
                          ifTyVars = tv_bndrs,
                          ifRoles = roles,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
309
                          ifCtxt = ctxt, ifGadtSyntax = gadt_syn,
Simon Peyton Jones's avatar
Simon Peyton Jones committed
310 311
                          ifCons = rdr_cons,
                          ifRec = is_rec, ifPromotable = is_prom,
312
                          ifParent = mb_parent })
313 314
  = bindIfaceTyVars_AT tv_bndrs $ \ tyvars -> do
    { tc_name <- lookupIfaceTop occ_name
315
    ; tycon <- fixM $ \ tycon -> do
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
316
            { stupid_theta <- tcIfaceCtxt ctxt
317
            ; parent' <- tc_parent mb_parent
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
318
            ; cons <- tcIfaceDataCons tc_name tycon tyvars rdr_cons
Simon Peyton Jones's avatar
Simon Peyton Jones committed
319
            ; return (buildAlgTyCon tc_name tyvars roles cType stupid_theta
320
                                    cons is_rec is_prom gadt_syn parent') }
321 322
    ; traceIf (text "tcIfaceDecl4" <+> ppr tycon)
    ; return (ATyCon tycon) }
323
  where
324 325 326
    tc_parent :: IfaceTyConParent -> IfL TyConParent
    tc_parent IfNoParent = return parent
    tc_parent (IfDataInstance ax_name _ arg_tys)
327 328
      = ASSERT( isNoParent parent )
        do { ax <- tcIfaceCoAxiom ax_name
329
           ; let fam_tc  = coAxiomTyCon ax
330
                 ax_unbr = toUnbranchedAxiom ax
331
           ; lhs_tys <- tcIfaceTcArgs arg_tys
332
           ; return (FamInstTyCon ax_unbr fam_tc lhs_tys) }
333

334 335 336 337
tc_iface_decl _ _ (IfaceSynonym {ifName = occ_name, ifTyVars = tv_bndrs,
                                      ifRoles = roles,
                                      ifSynRhs = rhs_ty,
                                      ifSynKind = kind })
338
   = bindIfaceTyVars_AT tv_bndrs $ \ tyvars -> do
339
     { tc_name  <- lookupIfaceTop occ_name
340
     ; rhs_kind <- tcIfaceKind kind     -- Note [Synonym kind loop]
Simon Peyton Jones's avatar
Simon Peyton Jones committed
341
     ; rhs      <- forkM (mk_doc tc_name) $
342 343
                   tcIfaceType rhs_ty
     ; tycon    <- buildSynonymTyCon tc_name tyvars roles rhs rhs_kind
344
     ; return (ATyCon tycon) }
345
   where
346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361
     mk_doc n = ptext (sLit "Type synonym") <+> ppr n

tc_iface_decl parent _ (IfaceFamily {ifName = occ_name, ifTyVars = tv_bndrs,
                                     ifFamFlav = fam_flav,
                                     ifFamKind = kind })
   = bindIfaceTyVars_AT tv_bndrs $ \ tyvars -> do
     { tc_name  <- lookupIfaceTop occ_name
     ; rhs_kind <- tcIfaceKind kind     -- Note [Synonym kind loop]
     ; rhs      <- forkM (mk_doc tc_name) $
                   tc_fam_flav fam_flav
     ; tycon    <- buildFamilyTyCon tc_name tyvars rhs rhs_kind parent
     ; return (ATyCon tycon) }
   where
     mk_doc n = ptext (sLit "Type synonym") <+> ppr n
     tc_fam_flav IfaceOpenSynFamilyTyCon   = return OpenSynFamilyTyCon
     tc_fam_flav (IfaceClosedSynFamilyTyCon ax_name _)
362 363
       = do { ax <- tcIfaceCoAxiom ax_name
            ; return (ClosedSynFamilyTyCon ax) }
364 365 366 367 368
     tc_fam_flav IfaceAbstractClosedSynFamilyTyCon
         = return AbstractClosedSynFamilyTyCon
     tc_fam_flav IfaceBuiltInSynFamTyCon
         = pprPanic "tc_iface_decl"
                    (text "IfaceBuiltInSynFamTyCon in interface file")
369

370
tc_iface_decl _parent ignore_prags
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
371
            (IfaceClass {ifCtxt = rdr_ctxt, ifName = tc_occ,
Simon Peyton Jones's avatar
Simon Peyton Jones committed
372 373
                         ifTyVars = tv_bndrs, ifRoles = roles, ifFDs = rdr_fds,
                         ifATs = rdr_ats, ifSigs = rdr_sigs,
374
                         ifMinDef = mindef_occ, ifRec = tc_isrec })
375
-- ToDo: in hs-boot files we should really treat abstract classes specially,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
376
--       as we do abstract tycons
377
  = bindIfaceTyVars tv_bndrs $ \ tyvars -> do
batterseapower's avatar
batterseapower committed
378
    { tc_name <- lookupIfaceTop tc_occ
379 380 381
    ; traceIf (text "tc-iface-class1" <+> ppr tc_occ)
    ; ctxt <- mapM tc_sc rdr_ctxt
    ; traceIf (text "tc-iface-class2" <+> ppr tc_occ)
382 383
    ; sigs <- mapM tc_sig rdr_sigs
    ; fds  <- mapM tc_fd rdr_fds
384
    ; traceIf (text "tc-iface-class3" <+> ppr tc_occ)
385
    ; mindef <- traverse (lookupIfaceTop . mkVarOccFS) mindef_occ
386
    ; cls  <- fixM $ \ cls -> do
387
              { ats  <- mapM (tc_at cls) rdr_ats
388
              ; traceIf (text "tc-iface-class4" <+> ppr tc_occ)
389
              ; buildClass tc_name tyvars roles ctxt fds ats sigs mindef tc_isrec }
batterseapower's avatar
batterseapower committed
390
    ; return (ATyCon (classTyCon cls)) }
391
  where
392 393 394 395 396 397 398 399 400
   tc_sc pred = forkM (mk_sc_doc pred) (tcIfaceType pred)
        -- The *length* of the superclasses is used by buildClass, and hence must
        -- not be inside the thunk.  But the *content* maybe recursive and hence
        -- must be lazy (via forkM).  Example:
        --     class C (T a) => D a where
        --       data T a
        -- Here the associated type T is knot-tied with the class, and
        -- so we must not pull on T too eagerly.  See Trac #5970

401 402
   tc_sig (IfaceClassOp occ dm rdr_ty)
     = do { op_name <- lookupIfaceTop occ
403
          ; op_ty   <- forkM (mk_op_doc op_name rdr_ty) (tcIfaceType rdr_ty)
Simon Peyton Jones's avatar
Simon Peyton Jones committed
404
                -- Must be done lazily for just the same reason as the
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
405
                -- type of a data con; to avoid sucking in types that
406
                -- it mentions unless it's necessary to do so
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
407
          ; return (op_name, dm, op_ty) }
408

409
   tc_at cls (IfaceAT tc_decl if_def)
410
     = do ATyCon tc <- tc_iface_decl (AssocFamilyTyCon cls) ignore_prags tc_decl
411 412 413 414 415 416
          mb_def <- case if_def of
                      Nothing  -> return Nothing
                      Just def -> forkM (mk_at_doc tc)                 $
                                  extendIfaceTyVarEnv (tyConTyVars tc) $
                                  do { tc_def <- tcIfaceType def
                                     ; return (Just tc_def) }
417 418 419
                  -- Must be done lazily in case the RHS of the defaults mention
                  -- the type constructor being defined here
                  -- e.g.   type AT a; type AT b = AT [b]   Trac #8002
420
          return (ATI tc mb_def)
421

422 423
   mk_sc_doc pred = ptext (sLit "Superclass") <+> ppr pred
   mk_at_doc tc = ptext (sLit "Associated type") <+> ppr tc
424
   mk_op_doc op_name op_ty = ptext (sLit "Class op") <+> sep [ppr op_name, ppr op_ty]
425

426
   tc_fd (tvs1, tvs2) = do { tvs1' <- mapM tcIfaceTyVar tvs1
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
427 428
                           ; tvs2' <- mapM tcIfaceTyVar tvs2
                           ; return (tvs1', tvs2') }
429

430 431
tc_iface_decl _ _ (IfaceAxiom { ifName = ax_occ, ifTyCon = tc
                              , ifAxBranches = branches, ifRole = role })
432 433
  = do { tc_name     <- lookupIfaceTop ax_occ
       ; tc_tycon    <- tcIfaceTyCon tc
434
       ; tc_branches <- tc_ax_branches branches
435
       ; let axiom = CoAxiom { co_ax_unique   = nameUnique tc_name
436 437
                             , co_ax_name     = tc_name
                             , co_ax_tc       = tc_tycon
438
                             , co_ax_role     = role
439 440 441
                             , co_ax_branches = toBranchList tc_branches
                             , co_ax_implicit = False }
       ; return (ACoAxiom axiom) }
442

Gergő Érdi's avatar
Gergő Érdi committed
443
tc_iface_decl _ _ (IfacePatSyn{ ifName = occ_name
444 445
                              , ifPatMatcher = if_matcher
                              , ifPatBuilder = if_builder
Gergő Érdi's avatar
Gergő Érdi committed
446 447 448 449 450 451 452 453 454
                              , ifPatIsInfix = is_infix
                              , ifPatUnivTvs = univ_tvs
                              , ifPatExTvs = ex_tvs
                              , ifPatProvCtxt = prov_ctxt
                              , ifPatReqCtxt = req_ctxt
                              , ifPatArgs = args
                              , ifPatTy = pat_ty })
  = do { name <- lookupIfaceTop occ_name
       ; traceIf (ptext (sLit "tc_iface_decl") <+> ppr name)
455 456
       ; matcher <- tc_pr if_matcher
       ; builder <- fmapMaybeM tc_pr if_builder
Gergő Érdi's avatar
Gergő Érdi committed
457 458
       ; bindIfaceTyVars univ_tvs $ \univ_tvs -> do
       { bindIfaceTyVars ex_tvs $ \ex_tvs -> do
459
       { patsyn <- forkM (mk_doc name) $
Gergő Érdi's avatar
Gergő Érdi committed
460 461 462
             do { prov_theta <- tcIfaceCtxt prov_ctxt
                ; req_theta  <- tcIfaceCtxt req_ctxt
                ; pat_ty     <- tcIfaceType pat_ty
463
                ; arg_tys    <- mapM tcIfaceType args
464
                ; return $ buildPatSyn name is_infix matcher builder
465 466
                                       (univ_tvs, req_theta) (ex_tvs, prov_theta)
                                       arg_tys pat_ty }
467
       ; return $ AConLike . PatSynCon $ patsyn }}}
Gergő Érdi's avatar
Gergő Érdi committed
468 469
  where
     mk_doc n = ptext (sLit "Pattern synonym") <+> ppr n
470 471 472
     tc_pr :: (IfExtName, Bool) -> IfL (Id, Bool)
     tc_pr (nm, b) = do { id <- forkM (ppr nm) (tcIfaceExtId nm)
                        ; return (id, b) }
Gergő Érdi's avatar
Gergő Érdi committed
473

474 475
tc_ax_branches :: [IfaceAxBranch] -> IfL [CoAxBranch]
tc_ax_branches if_branches = foldlM tc_ax_branch [] if_branches
476

477 478
tc_ax_branch :: [CoAxBranch] -> IfaceAxBranch -> IfL [CoAxBranch]
tc_ax_branch prev_branches
479 480
             (IfaceAxBranch { ifaxbTyVars = tv_bndrs, ifaxbLHS = lhs, ifaxbRHS = rhs
                            , ifaxbRoles = roles, ifaxbIncomps = incomps })
481 482
  = bindIfaceTyVars_AT tv_bndrs $ \ tvs -> do
         -- The _AT variant is needed here; see Note [CoAxBranch type variables] in CoAxiom
483
    { tc_lhs <- tcIfaceTcArgs lhs   -- See Note [Checking IfaceTypes vs IfaceKinds]
484
    ; tc_rhs <- tcIfaceType rhs
485 486 487 488 489
    ; let br = CoAxBranch { cab_loc     = noSrcSpan
                          , cab_tvs     = tvs
                          , cab_lhs     = tc_lhs
                          , cab_roles   = roles
                          , cab_rhs     = tc_rhs
490 491
                          , cab_incomps = map (prev_branches !!) incomps }
    ; return (prev_branches ++ [br]) }
492

Ian Lynagh's avatar
Ian Lynagh committed
493
tcIfaceDataCons :: Name -> TyCon -> [TyVar] -> IfaceConDecls -> IfL AlgTyConRhs
494
tcIfaceDataCons tycon_name tycon tc_tyvars if_cons
495
  = case if_cons of
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
496
        IfAbstractTyCon dis -> return (AbstractTyCon dis)
497
        IfDataFamTyCon  -> return DataFamilyTyCon
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
498 499 500 501
        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 }
502
  where
Simon Peyton Jones's avatar
Simon Peyton Jones committed
503
    tc_con_decl (IfCon { ifConInfix = is_infix,
504
                         ifConExTvs = ex_tvs,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
505 506
                         ifConOcc = occ, ifConCtxt = ctxt, ifConEqSpec = spec,
                         ifConArgTys = args, ifConFields = field_lbls,
507
                         ifConStricts = if_stricts})
508
     = -- Universally-quantified tyvars are shared with
509
       -- parent TyCon, and are alrady in scope
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
510
       bindIfaceTyVars ex_tvs    $ \ ex_tyvars -> do
511 512
        { traceIf (text "Start interface-file tc_con_decl" <+> ppr occ)
        ; name  <- lookupIfaceTop occ
513 514

        -- Read the context and argument types, but lazily for two reasons
Simon Peyton Jones's avatar
Simon Peyton Jones committed
515
        -- (a) to avoid looking tugging on a recursive use of
516
        --     the type itself, which is knot-tied
Simon Peyton Jones's avatar
Simon Peyton Jones committed
517
        -- (b) to avoid faulting in the component types unless
518
        --     they are really needed
519
        ; ~(eq_spec, theta, arg_tys, stricts) <- forkM (mk_doc name) $
520 521 522
             do { eq_spec <- tcIfaceEqSpec spec
                ; theta   <- tcIfaceCtxt ctxt
                ; arg_tys <- mapM tcIfaceType args
Simon Peyton Jones's avatar
Simon Peyton Jones committed
523 524
                ; stricts <- mapM tc_strict if_stricts
                        -- The IfBang field can mention
525 526
                        -- the type itself; hence inside forkM
                ; return (eq_spec, theta, arg_tys, stricts) }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
527 528 529
        ; lbl_names <- mapM lookupIfaceTop field_lbls

        -- Remember, tycon is the representation tycon
Simon Peyton Jones's avatar
Simon Peyton Jones committed
530
        ; let orig_res_ty = mkFamilyTyConApp tycon
531
                                (substTyVars (mkTopTvSubst eq_spec) tc_tyvars)
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
532

533
        ; con <- buildDataCon (pprPanic "tcIfaceDataCons: FamInstEnvs" (ppr name))
534
                       name is_infix
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
535
                       stricts lbl_names
536
                       tc_tyvars ex_tyvars
Simon Peyton Jones's avatar
Simon Peyton Jones committed
537
                       eq_spec theta
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
538
                       arg_tys orig_res_ty tycon
539
        ; traceIf (text "Done interface-file tc_con_decl" <+> ppr name)
Simon Peyton Jones's avatar
Simon Peyton Jones committed
540
        ; return con }
Ian Lynagh's avatar
Ian Lynagh committed
541
    mk_doc con_name = ptext (sLit "Constructor") <+> ppr con_name
542

543 544 545 546 547 548
    tc_strict IfNoBang = return HsNoBang
    tc_strict IfStrict = return HsStrict
    tc_strict IfUnpack = return (HsUnpack Nothing)
    tc_strict (IfUnpackCo if_co) = do { co <- tcIfaceCo if_co
                                      ; return (HsUnpack (Just co)) }

549
tcIfaceEqSpec :: IfaceEqSpec -> IfL [(TyVar, Type)]
550 551 552
tcIfaceEqSpec spec
  = mapM do_item spec
  where
553
    do_item (occ, if_ty) = do { tv <- tcIfaceTyVar occ
554 555
                              ; ty <- tcIfaceType if_ty
                              ; return (tv,ty) }
556

Austin Seipp's avatar
Austin Seipp committed
557
{-
558 559 560
Note [Synonym kind loop]
~~~~~~~~~~~~~~~~~~~~~~~~
Notice that we eagerly grab the *kind* from the interface file, but
Simon Peyton Jones's avatar
Simon Peyton Jones committed
561
build a forkM thunk for the *rhs* (and family stuff).  To see why,
562 563 564 565 566 567 568 569 570 571 572 573 574
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.
575

Austin Seipp's avatar
Austin Seipp committed
576 577
************************************************************************
*                                                                      *
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
578
                Instances
Austin Seipp's avatar
Austin Seipp committed
579 580 581
*                                                                      *
************************************************************************
-}
582

583
tcIfaceInst :: IfaceClsInst -> IfL ClsInst
584
tcIfaceInst (IfaceClsInst { ifDFun = dfun_occ, ifOFlag = oflag
585 586
                          , ifInstCls = cls, ifInstTys = mb_tcs
                          , ifInstOrph = orph })
587 588
  = do { dfun <- forkM (ptext (sLit "Dict fun") <+> ppr dfun_occ) $
                 tcIfaceExtId dfun_occ
589
       ; let mb_tcs' = map (fmap ifaceTyConName) mb_tcs
590
       ; return (mkImportedInstance cls mb_tcs' dfun oflag orph) }
591

592 593 594
tcIfaceFamInst :: IfaceFamInst -> IfL FamInst
tcIfaceFamInst (IfaceFamInst { ifFamInstFam = fam, ifFamInstTys = mb_tcs
                             , ifFamInstAxiom = axiom_name } )
595 596
    = do { axiom' <- forkM (ptext (sLit "Axiom") <+> ppr axiom_name) $
                     tcIfaceCoAxiom axiom_name
597 598 599 600
             -- will panic if branched, but that's OK
         ; let axiom'' = toUnbranchedAxiom axiom'
               mb_tcs' = map (fmap ifaceTyConName) mb_tcs
         ; return (mkImportedFamInst fam mb_tcs' axiom'') }
601

Austin Seipp's avatar
Austin Seipp committed
602 603 604
{-
************************************************************************
*                                                                      *
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
605
                Rules
Austin Seipp's avatar
Austin Seipp committed
606 607
*                                                                      *
************************************************************************
608 609

We move a IfaceRule from eps_rules to eps_rule_base when all its LHS free vars
Simon Peyton Jones's avatar
Simon Peyton Jones committed
610
are in the type environment.  However, remember that typechecking a Rule may
611
(as a side effect) augment the type envt, and so we may need to iterate the process.
Austin Seipp's avatar
Austin Seipp committed
612
-}
613

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
614 615 616
tcIfaceRules :: Bool            -- True <=> ignore rules
             -> [IfaceRule]
             -> IfL [CoreRule]
617 618 619 620
tcIfaceRules ignore_prags if_rules
  | ignore_prags = return []
  | otherwise    = mapM tcIfaceRule if_rules

621 622
tcIfaceRule :: IfaceRule -> IfL CoreRule
tcIfaceRule (IfaceRule {ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
623
                        ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs,
624
                        ifRuleAuto = auto })
Simon Peyton Jones's avatar
Simon Peyton Jones committed
625
  = do  { ~(bndrs', args', rhs') <-
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
626 627 628 629 630 631 632
                -- Typecheck the payload lazily, in the hope it'll never be looked at
                forkM (ptext (sLit "Rule") <+> ftext name) $
                bindIfaceBndrs bndrs                      $ \ bndrs' ->
                do { args' <- mapM tcIfaceExpr args
                   ; rhs'  <- tcIfaceExpr rhs
                   ; return (bndrs', args', rhs') }
        ; let mb_tcs = map ifTopFreeName args
Simon Peyton Jones's avatar
Simon Peyton Jones committed
633 634 635
        ; return (Rule { ru_name = name, ru_fn = fn, ru_act = act,
                          ru_bndrs = bndrs', ru_args = args',
                          ru_rhs = occurAnalyseExpr rhs',
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
636
                          ru_rough = mb_tcs,
637
                          ru_auto = auto,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
638 639 640
                          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
641
  where
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
642 643 644 645 646 647 648
        -- This function *must* mirror exactly what Rules.topFreeName does
        -- We could have stored the ru_rough field in the iface file
        -- but that would be redundant, I think.
        -- The only wrinkle is that we must not be deceived by
        -- type syononyms at the top of a type arg.  Since
        -- we can't tell at this point, we are careful not
        -- to write them out in coreRuleToIfaceRule
649 650
    ifTopFreeName :: IfaceExpr -> Maybe Name
    ifTopFreeName (IfaceType (IfaceTyConApp tc _ )) = Just (ifaceTyConName tc)
Ian Lynagh's avatar
Ian Lynagh committed
651
    ifTopFreeName (IfaceApp f _)                    = ifTopFreeName f
652
    ifTopFreeName (IfaceExt n)                      = Just n
Ian Lynagh's avatar
Ian Lynagh committed
653
    ifTopFreeName _                                 = Nothing
654

Austin Seipp's avatar
Austin Seipp committed
655 656 657
{-
************************************************************************
*                                                                      *
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
658
                Annotations
Austin Seipp's avatar
Austin Seipp committed
659 660 661
*                                                                      *
************************************************************************
-}
662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680

tcIfaceAnnotations :: [IfaceAnnotation] -> IfL [Annotation]
tcIfaceAnnotations = mapM tcIfaceAnnotation

tcIfaceAnnotation :: IfaceAnnotation -> IfL Annotation
tcIfaceAnnotation (IfaceAnnotation target serialized) = do
    target' <- tcIfaceAnnTarget target
    return $ Annotation {
        ann_target = target',
        ann_value = serialized
    }

tcIfaceAnnTarget :: IfaceAnnTarget -> IfL (AnnTarget Name)
tcIfaceAnnTarget (NamedTarget occ) = do
    name <- lookupIfaceTop occ
    return $ NamedTarget name
tcIfaceAnnTarget (ModuleTarget mod) = do
    return $ ModuleTarget mod

Austin Seipp's avatar
Austin Seipp committed
681 682 683
{-
************************************************************************
*                                                                      *
684
                Vectorisation information
Austin Seipp's avatar
Austin Seipp committed
685 686 687
*                                                                      *
************************************************************************
-}
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
688

689
-- We need access to the type environment as we need to look up information about type constructors
690 691 692 693 694
-- (i.e., their data constructors and whether they are class type constructors).  If a vectorised
-- type constructor or class is defined in the same module as where it is vectorised, we cannot
-- look that information up from the type constructor that we obtained via a 'forkM'ed
-- 'tcIfaceTyCon' without recursively loading the interface that we are already type checking again
-- and again and again...
695 696
--
tcIfaceVectInfo :: Module -> TypeEnv -> IfaceVectInfo -> IfL VectInfo
Simon Peyton Jones's avatar
Simon Peyton Jones committed
697
tcIfaceVectInfo mod typeEnv (IfaceVectInfo
698 699 700 701 702
                             { ifaceVectInfoVar            = vars
                             , ifaceVectInfoTyCon          = tycons
                             , ifaceVectInfoTyConReuse     = tyconsReuse
                             , ifaceVectInfoParallelVars   = parallelVars
                             , ifaceVectInfoParallelTyCons = parallelTyCons
703
                             })
704 705
  = do { let parallelTyConsSet = mkNameSet parallelTyCons
       ; vVars         <- mapM vectVarMapping                  vars
706
       ; let varsSet = mkVarSet (map fst vVars)
707 708 709
       ; tyConRes1     <- mapM (vectTyConVectMapping varsSet)  tycons
       ; tyConRes2     <- mapM (vectTyConReuseMapping varsSet) tyconsReuse
       ; vParallelVars <- mapM vectVar                         parallelVars
710
       ; let (vTyCons, vDataCons, vScSels) = unzip3 (tyConRes1 ++ tyConRes2)
Simon Peyton Jones's avatar
Simon Peyton Jones committed
711
       ; return $ VectInfo
712 713 714 715 716
                  { vectInfoVar            = mkVarEnv  vVars `extendVarEnvList` concat vScSels
                  , vectInfoTyCon          = mkNameEnv vTyCons
                  , vectInfoDataCon        = mkNameEnv (concat vDataCons)
                  , vectInfoParallelVars   = mkVarSet  vParallelVars
                  , vectInfoParallelTyCons = parallelTyConsSet
717
                  }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
718 719
       }
  where
Simon Peyton Jones's avatar
Simon Peyton Jones committed
720
    vectVarMapping name
721
      = do { vName <- lookupOrig mod (mkLocalisedOccName mod mkVectOcc name)
722 723
           ; var   <- forkM (ptext (sLit "vect var")  <+> ppr name)  $
                        tcIfaceExtId name
Simon Peyton Jones's avatar
Simon Peyton Jones committed
724 725
           ; vVar  <- forkM (ptext (sLit "vect vVar [mod =") <+>
                             ppr mod <> ptext (sLit "; nameModule =") <+>
726 727
                             ppr (nameModule name) <> ptext (sLit "]") <+> ppr vName) $
                       tcIfaceExtId vName
728
           ; return (var, (var, vVar))
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
729
           }
730 731 732 733 734 735 736 737 738 739 740
      -- where
      --   lookupLocalOrExternalId name
      --     = do { let mb_id = lookupTypeEnv typeEnv name
      --          ; case mb_id of
      --                -- id is local
      --              Just (AnId id) -> return id
      --                -- name is not an Id => internal inconsistency
      --              Just _         -> notAnIdErr
      --                -- Id is external
      --              Nothing        -> tcIfaceExtId name
      --          }
Simon Peyton Jones's avatar
Simon Peyton Jones committed
741
      --
742
      --   notAnIdErr = pprPanic "TcIface.tcIfaceVectInfo: not an id" (ppr name)
743

Simon Peyton Jones's avatar
Simon Peyton Jones committed
744
    vectVar name
745 746 747
      = forkM (ptext (sLit "vect scalar var")  <+> ppr name)  $
          tcIfaceExtId name

748
    vectTyConVectMapping vars name
749
      = do { vName  <- lookupOrig mod (mkLocalisedOccName mod mkVectTyConOcc name)
750 751 752 753 754 755 756
           ; vectTyConMapping vars name vName
           }

    vectTyConReuseMapping vars name
      = vectTyConMapping vars name name

    vectTyConMapping vars name vName
757
      = do { tycon  <- lookupLocalOrExternalTyCon name
Simon Peyton Jones's avatar
Simon Peyton Jones committed
758
           ; vTycon <- forkM (ptext (sLit "vTycon of") <+> ppr vName) $
759
                         lookupLocalOrExternalTyCon vName
760

761
               -- Map the data constructors of the original type constructor to those of the
762 763
               -- vectorised type constructor /unless/ the type constructor was vectorised
               -- abstractly; if it was vectorised abstractly, the workers of its data constructors
764 765 766 767
               -- do not appear in the set of vectorised variables.
               --
               -- NB: This is lazy!  We don't pull at the type constructors before we actually use
               --     the data constructor mapping.
768
           ; let isAbstract | isClassTyCon tycon = False
Simon Peyton Jones's avatar
Simon Peyton Jones committed
769
                            | datacon:_ <- tyConDataCons tycon
770 771 772 773 774 775 776
                                                 = not $ dataConWrapId datacon `elemVarSet` vars
                            | otherwise          = True
                 vDataCons  | isAbstract = []
                            | otherwise  = [ (dataConName datacon, (datacon, vDatacon))
                                           | (datacon, vDatacon) <- zip (tyConDataCons tycon)
                                                                        (tyConDataCons vTycon)
                                           ]
777

778 779 780
                   -- Map the (implicit) superclass and methods selectors as they don't occur in
                   -- the var map.
                 vScSels    | Just cls  <- tyConClass_maybe tycon
Simon Peyton Jones's avatar
Simon Peyton Jones committed
781
                            , Just vCls <- tyConClass_maybe vTycon
782 783 784 785 786 787
                            = [ (sel, (sel, vSel))
                              | (sel, vSel) <- zip (classAllSelIds cls) (classAllSelIds vCls)
                              ]
                            | otherwise
                            = []

788 789
           ; return ( (name, (tycon, vTycon))          -- (T, T_v)
                    , vDataCons                        -- list of (Ci, Ci_v)