TcIface.hs 62.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
{-# LANGUAGE CPP #-}
10

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 31 32
import Coercion
import CoAxiom
import TyCoRep    -- needs to build types & coercions in a knot
Simon Marlow's avatar
Simon Marlow committed
33
import HscTypes
34
import Annotations
Simon Marlow's avatar
Simon Marlow committed
35 36
import InstEnv
import FamInstEnv
37
import CoreSyn
Simon Marlow's avatar
Simon Marlow committed
38
import CoreUtils
39
import CoreUnfold
Simon Marlow's avatar
Simon Marlow committed
40
import CoreLint
41
import MkCore
Simon Marlow's avatar
Simon Marlow committed
42 43 44 45 46
import Id
import MkId
import IdInfo
import Class
import TyCon
cactus's avatar
cactus 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 Literal
Simon Marlow's avatar
Simon Marlow committed
52
import qualified Var
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
53
import VarEnv
54
import VarSet
Simon Marlow's avatar
Simon Marlow committed
55
import Name
56
import NameEnv
57 58
import NameSet
import OccurAnal        ( occurAnalyseExpr )
59
import Demand
Simon Marlow's avatar
Simon Marlow committed
60
import Module
61
import UniqFM
Simon Marlow's avatar
Simon Marlow committed
62
import UniqSupply
Simon Peyton Jones's avatar
Simon Peyton Jones committed
63
import Outputable
Simon Marlow's avatar
Simon Marlow committed
64 65 66
import Maybes
import SrcLoc
import DynFlags
Ian Lynagh's avatar
Ian Lynagh committed
67
import Util
68
import FastString
69 70
import BasicTypes hiding ( SuccessFlag(..) )
import ListSetOps
Simon Marlow's avatar
Simon Marlow committed
71

Adam Gundry's avatar
Adam Gundry committed
72
import Data.List
73
import Control.Monad
74
import qualified Data.Map as Map
75

Austin Seipp's avatar
Austin Seipp committed
76
{-
77 78
This module takes

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

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
86
        -- For (b) consider: f = \$(...h....)
Simon Peyton Jones's avatar
Simon Peyton Jones committed
87
        -- 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
88
        -- This is bad!  But it is not seen as a staging error, because h
Simon Peyton Jones's avatar
Simon Peyton Jones committed
89
        -- 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
90 91 92 93 94
        -- 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.
95

96

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

103 104 105 106 107 108 109
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
110
-}
111

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
112 113
typecheckIface :: ModIface      -- Get the decls from here
               -> TcRnIf gbl lcl ModDetails
114 115
typecheckIface iface
  = initIfaceTc iface $ \ tc_env_var -> do
Simon Peyton Jones's avatar
Simon Peyton Jones committed
116
        -- The tc_env_var is freshly allocated, private to
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
117 118 119 120
        -- 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
121
                -- 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
122
                -- to handle unboxed tuples, so it must not see unfoldings.
ian@well-typed.com's avatar
ian@well-typed.com committed
123
          ignore_prags <- goptM Opt_IgnoreInterfacePragmas
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
124 125 126 127 128 129 130 131 132 133 134 135 136 137

                -- 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)
138

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
139
                -- Vectorisation information
140
        ; 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
141

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
142 143 144 145 146 147 148 149 150 151 152
                -- 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
153
                              , md_vect_info = vect_info
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
154 155
                              , md_exports   = exports
                              }
156
    }
157

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

Simon Peyton Jones's avatar
Simon Peyton Jones committed
166
tcHiBootIface :: HscSource -> Module -> TcRn SelfBootInfo
167 168
-- Load the hi-boot iface for the module being compiled,
-- if it indeed exists in the transitive closure of imports
Simon Peyton Jones's avatar
Simon Peyton Jones committed
169
-- Return the ModDetails; Nothing if no hi-boot iface
170
tcHiBootIface hsc_src mod
171
  | HsBootFile <- hsc_src            -- Already compiling a hs-boot file
Simon Peyton Jones's avatar
Simon Peyton Jones committed
172
  = return NoSelfBoot
173
  | otherwise
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
174 175 176 177 178 179
  = 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
180
                --
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
181 182
                -- 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
183
                -- compile a module in TypecheckOnly mode, with a stable,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
184 185
                -- 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
186
                -- 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
187 188
                -- it's been compiled once, and we don't need to check the boot iface
          then do { hpt <- getHpt
Simon Peyton Jones's avatar
Simon Peyton Jones committed
189
                 ; case lookupUFM hpt (moduleName mod) of
Simon Peyton Jones's avatar
Simon Peyton Jones committed
190
                      Just info | mi_boot (hm_iface info)
Simon Peyton Jones's avatar
Simon Peyton Jones committed
191 192
                                -> return (mkSelfBootInfo (hm_details info))
                      _ -> return NoSelfBoot }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
193 194
          else do

Simon Peyton Jones's avatar
Simon Peyton Jones committed
195
        -- OK, so we're in one-shot mode.
196 197 198 199 200 201
        -- 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
202

203
        ; case read_result of {
Simon Peyton Jones's avatar
Simon Peyton Jones committed
204 205 206
            Succeeded (iface, _path) -> do { tc_iface <- typecheckIface iface
                                           ; return (mkSelfBootInfo tc_iface) } ;
            Failed err               ->
207 208 209 210 211 212 213 214 215 216

        -- 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
Simon Peyton Jones's avatar
Simon Peyton Jones committed
217
            Nothing -> return NoSelfBoot -- The typical case
218 219

            Just (_, False) -> failWithTc moduleLoop
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
220 221
                -- 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
222

223 224
            Just (_mod, True) -> failWithTc (elaborate err)
                -- The hi-boot file has mysteriously disappeared.
225
    }}}}
226
  where
227 228
    need = text "Need the hi-boot interface for" <+> ppr mod
                 <+> text "to compare against the Real Thing"
229

230 231
    moduleLoop = text "Circular imports: module" <+> quotes (ppr mod)
                     <+> text "depends on itself"
232

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

Simon Peyton Jones's avatar
Simon Peyton Jones committed
236 237 238 239 240 241 242 243 244

mkSelfBootInfo :: ModDetails -> SelfBootInfo
mkSelfBootInfo mds
  = SelfBoot { sb_mds = mds
             , sb_tcs = mkNameSet (map tyConName (typeEnvTyCons iface_env))
             , sb_ids = mkNameSet (map idName (typeEnvIds iface_env)) }
  where
    iface_env = md_types mds

Austin Seipp's avatar
Austin Seipp committed
245 246 247
{-
************************************************************************
*                                                                      *
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
248
                Type and class declarations
Austin Seipp's avatar
Austin Seipp committed
249 250
*                                                                      *
************************************************************************
251 252 253 254 255 256

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
257
E.g.
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
258
        data Foo.S = MkS Baz.T
259 260 261
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
262 263
        data Foo.S = MkS Baz.T
        data Baz.T = MkT Foo.S
264
(in different interface files, of course).
Simon Peyton Jones's avatar
Simon Peyton Jones committed
265
Now, first we load and typecheck Foo.S, and add it to the type envt.
266
If we do explore MkS's argument, we'll load and typecheck Baz.T.
Simon Peyton Jones's avatar
Simon Peyton Jones committed
267
If we explore MkT's argument we'll find Foo.S already in the envt.
268 269 270 271 272 273 274 275 276 277 278

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
279 280 281
        * 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
282

283
Now we look something up in the type envt
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
284 285 286
        * that pulls on <t>
        * which reads the global type envt out of the global EPS mutvar
        * but that depends in turn on <t>
287

Simon Peyton Jones's avatar
Simon Peyton Jones committed
288
It's subtle, because, it'd work fine if we typechecked the constructor args
289 290 291 292 293
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
294
-}
295

296
tcIfaceDecl :: Bool     -- ^ True <=> discard IdInfo on IfaceId bindings
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
297 298
            -> IfaceDecl
            -> IfL TyThing
299
tcIfaceDecl = tc_iface_decl Nothing
300

301 302
tc_iface_decl :: Maybe Class  -- ^ For associated type/data family declarations
              -> Bool         -- ^ True <=> discard IdInfo on IfaceId bindings
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
303 304
              -> IfaceDecl
              -> IfL TyThing
Simon Peyton Jones's avatar
Simon Peyton Jones committed
305
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
306 307 308 309 310 311
                                       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)) }
312

313
tc_iface_decl _ _ (IfaceData {ifName = occ_name,
Simon Peyton Jones's avatar
Simon Peyton Jones committed
314
                          ifCType = cType,
315
                          ifKind = kind,
316 317
                          ifTyVars = tv_bndrs,
                          ifRoles = roles,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
318
                          ifCtxt = ctxt, ifGadtSyntax = gadt_syn,
Simon Peyton Jones's avatar
Simon Peyton Jones committed
319
                          ifCons = rdr_cons,
320
                          ifRec = is_rec, ifParent = mb_parent })
321 322
  = bindIfaceTyVars_AT tv_bndrs $ \ tyvars -> do
    { tc_name <- lookupIfaceTop occ_name
323
    ; kind' <- tcIfaceType kind
324
    ; tycon <- fixM $ \ tycon -> do
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
325
            { stupid_theta <- tcIfaceCtxt ctxt
326
            ; parent' <- tc_parent tc_name mb_parent
327 328 329
            ; cons <- tcIfaceDataCons tc_name tycon tyvars rdr_cons
            ; return (mkAlgTyCon tc_name kind' tyvars roles cType stupid_theta
                                    cons parent' is_rec gadt_syn) }
330 331
    ; traceIf (text "tcIfaceDecl4" <+> ppr tycon)
    ; return (ATyCon tycon) }
332
  where
333 334 335 336 337 338
    tc_parent :: Name -> IfaceTyConParent -> IfL AlgTyConFlav
    tc_parent tc_name IfNoParent
      = do { tc_rep_name <- newTyConRepName tc_name
           ; return (VanillaAlgTyCon tc_rep_name) }
    tc_parent _ (IfDataInstance ax_name _ arg_tys)
      = do { ax <- tcIfaceCoAxiom ax_name
339
           ; let fam_tc  = coAxiomTyCon ax
340
                 ax_unbr = toUnbranchedAxiom ax
341
           ; lhs_tys <- tcIfaceTcArgs arg_tys
342
           ; return (DataFamInstTyCon ax_unbr fam_tc lhs_tys) }
343

344 345 346 347
tc_iface_decl _ _ (IfaceSynonym {ifName = occ_name, ifTyVars = tv_bndrs,
                                      ifRoles = roles,
                                      ifSynRhs = rhs_ty,
                                      ifSynKind = kind })
348
   = bindIfaceTyVars_AT tv_bndrs $ \ tyvars -> do
349
     { tc_name  <- lookupIfaceTop occ_name
350
     ; kind     <- tcIfaceType kind     -- Note [Synonym kind loop]
Simon Peyton Jones's avatar
Simon Peyton Jones committed
351
     ; rhs      <- forkM (mk_doc tc_name) $
352
                   tcIfaceType rhs_ty
353
     ; let tycon = mkSynonymTyCon tc_name kind tyvars roles rhs
354
     ; return (ATyCon tycon) }
355
   where
356
     mk_doc n = text "Type synonym" <+> ppr n
357 358 359

tc_iface_decl parent _ (IfaceFamily {ifName = occ_name, ifTyVars = tv_bndrs,
                                     ifFamFlav = fam_flav,
Jan Stolarek's avatar
Jan Stolarek committed
360 361
                                     ifFamKind = kind,
                                     ifResVar = res, ifFamInj = inj })
362 363
   = bindIfaceTyVars_AT tv_bndrs $ \ tyvars -> do
     { tc_name  <- lookupIfaceTop occ_name
364
     ; kind     <- tcIfaceType kind        -- Note [Synonym kind loop]
365
     ; rhs      <- forkM (mk_doc tc_name) $
366
                   tc_fam_flav tc_name fam_flav
Jan Stolarek's avatar
Jan Stolarek committed
367
     ; res_name <- traverse (newIfaceName . mkTyVarOccFS) res
368
     ; let tycon = mkFamilyTyCon tc_name kind tyvars res_name rhs parent inj
369 370
     ; return (ATyCon tycon) }
   where
371
     mk_doc n = text "Type synonym" <+> ppr n
372 373 374 375 376 377 378

     tc_fam_flav :: Name -> IfaceFamTyConFlav -> IfL FamTyConFlav
     tc_fam_flav tc_name IfaceDataFamilyTyCon
       = do { tc_rep_name <- newTyConRepName tc_name
            ; return (DataFamilyTyCon tc_rep_name) }
     tc_fam_flav _ IfaceOpenSynFamilyTyCon= return OpenSynFamilyTyCon
     tc_fam_flav _ (IfaceClosedSynFamilyTyCon mb_ax_name_branches)
379
       = do { ax <- traverse (tcIfaceCoAxiom . fst) mb_ax_name_branches
380
            ; return (ClosedSynFamilyTyCon ax) }
381
     tc_fam_flav _ IfaceAbstractClosedSynFamilyTyCon
382
         = return AbstractClosedSynFamilyTyCon
383
     tc_fam_flav _ IfaceBuiltInSynFamTyCon
384 385
         = pprPanic "tc_iface_decl"
                    (text "IfaceBuiltInSynFamTyCon in interface file")
386

387
tc_iface_decl _parent ignore_prags
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
388
            (IfaceClass {ifCtxt = rdr_ctxt, ifName = tc_occ,
389 390
                         ifTyVars = tv_bndrs, ifRoles = roles, ifKind = kind,
                         ifFDs = rdr_fds,
Simon Peyton Jones's avatar
Simon Peyton Jones committed
391
                         ifATs = rdr_ats, ifSigs = rdr_sigs,
392
                         ifMinDef = mindef_occ, ifRec = tc_isrec })
393
-- 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
394
--       as we do abstract tycons
395
  = bindIfaceTvBndrs tv_bndrs $ \ tyvars -> do
batterseapower's avatar
batterseapower committed
396
    { tc_name <- lookupIfaceTop tc_occ
397
    ; kind' <- tcIfaceType kind
398 399 400
    ; traceIf (text "tc-iface-class1" <+> ppr tc_occ)
    ; ctxt <- mapM tc_sc rdr_ctxt
    ; traceIf (text "tc-iface-class2" <+> ppr tc_occ)
401 402
    ; sigs <- mapM tc_sig rdr_sigs
    ; fds  <- mapM tc_fd rdr_fds
403
    ; traceIf (text "tc-iface-class3" <+> ppr tc_occ)
404
    ; mindef <- traverse (lookupIfaceTop . mkVarOccFS) mindef_occ
405
    ; cls  <- fixM $ \ cls -> do
406
              { ats  <- mapM (tc_at cls) rdr_ats
407
              ; traceIf (text "tc-iface-class4" <+> ppr tc_occ)
408
              ; buildClass tc_name tyvars roles ctxt kind' fds ats sigs mindef tc_isrec }
batterseapower's avatar
batterseapower committed
409
    ; return (ATyCon (classTyCon cls)) }
410
  where
411 412 413 414 415 416 417 418 419
   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

420 421
   tc_sig :: IfaceClassOp -> IfL TcMethInfo
   tc_sig (IfaceClassOp occ rdr_ty dm)
422
     = do { op_name <- lookupIfaceTop occ
423 424 425 426
          ; ~(op_ty, dm') <- forkM (mk_op_doc op_name rdr_ty) $
                             do { ty <- tcIfaceType rdr_ty
                                ; dm' <- tc_dm dm
                                ; return (ty, dm') }
Simon Peyton Jones's avatar
Simon Peyton Jones committed
427
                -- Must be done lazily for just the same reason as the
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
428
                -- type of a data con; to avoid sucking in types that
429
                -- it mentions unless it's necessary to do so
430 431 432 433 434 435 436
          ; return (op_name, op_ty, dm') }

   tc_dm :: Maybe (DefMethSpec IfaceType) -> IfL (Maybe (DefMethSpec Type))
   tc_dm Nothing               = return Nothing
   tc_dm (Just VanillaDM)      = return (Just VanillaDM)
   tc_dm (Just (GenericDM ty)) = do { ty' <- tcIfaceType ty
                                    ; return (Just (GenericDM ty')) }
437

438
   tc_at cls (IfaceAT tc_decl if_def)
439
     = do ATyCon tc <- tc_iface_decl (Just cls) ignore_prags tc_decl
440 441 442 443 444
          mb_def <- case if_def of
                      Nothing  -> return Nothing
                      Just def -> forkM (mk_at_doc tc)                 $
                                  extendIfaceTyVarEnv (tyConTyVars tc) $
                                  do { tc_def <- tcIfaceType def
445
                                     ; return (Just (tc_def, noSrcSpan)) }
446 447 448
                  -- 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
449
          return (ATI tc mb_def)
450

451 452 453
   mk_sc_doc pred = text "Superclass" <+> ppr pred
   mk_at_doc tc = text "Associated type" <+> ppr tc
   mk_op_doc op_name op_ty = text "Class op" <+> sep [ppr op_name, ppr op_ty]
454

455
   tc_fd (tvs1, tvs2) = do { tvs1' <- mapM tcIfaceTyVar tvs1
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
456 457
                           ; tvs2' <- mapM tcIfaceTyVar tvs2
                           ; return (tvs1', tvs2') }
458

459 460
tc_iface_decl _ _ (IfaceAxiom { ifName = ax_occ, ifTyCon = tc
                              , ifAxBranches = branches, ifRole = role })
461 462
  = do { tc_name     <- lookupIfaceTop ax_occ
       ; tc_tycon    <- tcIfaceTyCon tc
463
       ; tc_branches <- tc_ax_branches branches
464
       ; let axiom = CoAxiom { co_ax_unique   = nameUnique tc_name
465 466
                             , co_ax_name     = tc_name
                             , co_ax_tc       = tc_tycon
467
                             , co_ax_role     = role
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
468
                             , co_ax_branches = manyBranches tc_branches
469 470
                             , co_ax_implicit = False }
       ; return (ACoAxiom axiom) }
471

cactus's avatar
cactus committed
472
tc_iface_decl _ _ (IfacePatSyn{ ifName = occ_name
473 474
                              , ifPatMatcher = if_matcher
                              , ifPatBuilder = if_builder
cactus's avatar
cactus committed
475 476 477 478 479 480
                              , ifPatIsInfix = is_infix
                              , ifPatUnivTvs = univ_tvs
                              , ifPatExTvs = ex_tvs
                              , ifPatProvCtxt = prov_ctxt
                              , ifPatReqCtxt = req_ctxt
                              , ifPatArgs = args
Matthew Pickering's avatar
Matthew Pickering committed
481 482
                              , ifPatTy = pat_ty
                              , ifFieldLabels = field_labels })
cactus's avatar
cactus committed
483
  = do { name <- lookupIfaceTop occ_name
484
       ; traceIf (text "tc_iface_decl" <+> ppr name)
485 486
       ; matcher <- tc_pr if_matcher
       ; builder <- fmapMaybeM tc_pr if_builder
487 488
       ; bindIfaceTvBndrs univ_tvs $ \univ_tvs -> do
       { bindIfaceTvBndrs ex_tvs $ \ex_tvs -> do
489
       { patsyn <- forkM (mk_doc name) $
cactus's avatar
cactus committed
490 491 492
             do { prov_theta <- tcIfaceCtxt prov_ctxt
                ; req_theta  <- tcIfaceCtxt req_ctxt
                ; pat_ty     <- tcIfaceType pat_ty
493
                ; arg_tys    <- mapM tcIfaceType args
494
                ; return $ buildPatSyn name is_infix matcher builder
495
                                       (univ_tvs, req_theta) (ex_tvs, prov_theta)
Matthew Pickering's avatar
Matthew Pickering committed
496
                                       arg_tys pat_ty field_labels }
497
       ; return $ AConLike . PatSynCon $ patsyn }}}
cactus's avatar
cactus committed
498
  where
499
     mk_doc n = text "Pattern synonym" <+> ppr n
500 501 502
     tc_pr :: (IfExtName, Bool) -> IfL (Id, Bool)
     tc_pr (nm, b) = do { id <- forkM (ppr nm) (tcIfaceExtId nm)
                        ; return (id, b) }
cactus's avatar
cactus committed
503

504 505
tc_ax_branches :: [IfaceAxBranch] -> IfL [CoAxBranch]
tc_ax_branches if_branches = foldlM tc_ax_branch [] if_branches
506

507 508
tc_ax_branch :: [CoAxBranch] -> IfaceAxBranch -> IfL [CoAxBranch]
tc_ax_branch prev_branches
509 510
             (IfaceAxBranch { ifaxbTyVars = tv_bndrs, ifaxbCoVars = cv_bndrs
                            , ifaxbLHS = lhs, ifaxbRHS = rhs
511
                            , ifaxbRoles = roles, ifaxbIncomps = incomps })
512
  = bindIfaceTyVars_AT tv_bndrs $ \ tvs ->
513
         -- The _AT variant is needed here; see Note [CoAxBranch type variables] in CoAxiom
514 515
    bindIfaceIds cv_bndrs $ \ cvs -> do
    { tc_lhs <- tcIfaceTcArgs lhs
516
    ; tc_rhs <- tcIfaceType rhs
517 518
    ; let br = CoAxBranch { cab_loc     = noSrcSpan
                          , cab_tvs     = tvs
519
                          , cab_cvs     = cvs
520 521 522
                          , cab_lhs     = tc_lhs
                          , cab_roles   = roles
                          , cab_rhs     = tc_rhs
523
                          , cab_incomps = map (prev_branches `getNth`) incomps }
524
    ; return (prev_branches ++ [br]) }
525

526 527
tcIfaceDataCons :: Name -> TyCon -> [TyVar] -> IfaceConDecls -> IfL AlgTyConRhs
tcIfaceDataCons tycon_name tycon tc_tyvars if_cons
528
  = case if_cons of
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
529
        IfAbstractTyCon dis -> return (AbstractTyCon dis)
Adam Gundry's avatar
Adam Gundry committed
530 531 532 533 534 535
        IfDataTyCon cons _ _ -> do  { field_lbls <- mapM (traverse lookupIfaceTop) (ifaceConDeclFields if_cons)
                                    ; data_cons  <- mapM (tc_con_decl field_lbls) cons
                                    ; return (mkDataTyConRhs data_cons) }
        IfNewTyCon  con  _ _ -> do  { field_lbls <- mapM (traverse lookupIfaceTop) (ifaceConDeclFields if_cons)
                                    ; data_con  <- tc_con_decl field_lbls con
                                    ; mkNewTyConRhs tycon_name tycon data_con }
536
  where
Adam Gundry's avatar
Adam Gundry committed
537
    tc_con_decl field_lbls (IfCon { ifConInfix = is_infix,
538
                         ifConExTvs = ex_tvs,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
539
                         ifConOcc = occ, ifConCtxt = ctxt, ifConEqSpec = spec,
Adam Gundry's avatar
Adam Gundry committed
540
                         ifConArgTys = args, ifConFields = my_lbls,
541 542
                         ifConStricts = if_stricts,
                         ifConSrcStricts = if_src_stricts})
543
     = -- Universally-quantified tyvars are shared with
544
       -- parent TyCon, and are alrady in scope
545
       bindIfaceTvBndrs ex_tvs    $ \ ex_tyvars -> do
546
        { traceIf (text "Start interface-file tc_con_decl" <+> ppr occ)
547
        ; dc_name  <- lookupIfaceTop occ
548 549

        -- Read the context and argument types, but lazily for two reasons
Simon Peyton Jones's avatar
Simon Peyton Jones committed
550
        -- (a) to avoid looking tugging on a recursive use of
551
        --     the type itself, which is knot-tied
Simon Peyton Jones's avatar
Simon Peyton Jones committed
552
        -- (b) to avoid faulting in the component types unless
553
        --     they are really needed
554
        ; ~(eq_spec, theta, arg_tys, stricts) <- forkM (mk_doc dc_name) $
555 556 557
             do { eq_spec <- tcIfaceEqSpec spec
                ; theta   <- tcIfaceCtxt ctxt
                ; arg_tys <- mapM tcIfaceType args
Simon Peyton Jones's avatar
Simon Peyton Jones committed
558 559
                ; stricts <- mapM tc_strict if_stricts
                        -- The IfBang field can mention
560 561
                        -- the type itself; hence inside forkM
                ; return (eq_spec, theta, arg_tys, stricts) }
Adam Gundry's avatar
Adam Gundry committed
562 563 564 565 566 567 568

        -- Look up the field labels for this constructor; note that
        -- they should be in the same order as my_lbls!
        ; let lbl_names = map find_lbl my_lbls
              find_lbl x = case find (\ fl -> nameOccName (flSelector fl) == x) field_lbls of
                             Just fl -> fl
                             Nothing -> error $ "find_lbl missing " ++ occNameString x
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
569 570

        -- Remember, tycon is the representation tycon
Simon Peyton Jones's avatar
Simon Peyton Jones committed
571
        ; let orig_res_ty = mkFamilyTyConApp tycon
niteria's avatar
niteria committed
572
                                (substTyVars (mkTvSubstPrs (map eqSpecPair eq_spec))
573
                                             tc_tyvars)
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
574

575
        ; prom_rep_name <- newTyConRepName dc_name
576 577

        ; con <- buildDataCon (pprPanic "tcIfaceDataCons: FamInstEnvs" (ppr dc_name))
578
                       dc_name is_infix prom_rep_name
579 580 581 582 583 584 585 586 587 588 589 590
                       (map src_strict if_src_stricts)
                       (Just stricts)
                       -- Pass the HsImplBangs (i.e. final
                       -- decisions) to buildDataCon; it'll use
                       -- these to guide the construction of a
                       -- worker.
                       -- See Note [Bangs on imported data constructors] in MkId
                       lbl_names
                       tc_tyvars ex_tyvars
                       eq_spec theta
                       arg_tys orig_res_ty tycon
        ; traceIf (text "Done interface-file tc_con_decl" <+> ppr dc_name)
Simon Peyton Jones's avatar
Simon Peyton Jones committed
591
        ; return con }
592
    mk_doc con_name = text "Constructor" <+> ppr con_name
593

Simon Peyton Jones's avatar
Simon Peyton Jones committed
594
    tc_strict :: IfaceBang -> IfL HsImplBang
595 596
    tc_strict IfNoBang = return (HsLazy)
    tc_strict IfStrict = return (HsStrict)
597 598 599 600
    tc_strict IfUnpack = return (HsUnpack Nothing)
    tc_strict (IfUnpackCo if_co) = do { co <- tcIfaceCo if_co
                                      ; return (HsUnpack (Just co)) }

601 602 603
    src_strict :: IfaceSrcBang -> HsSrcBang
    src_strict (IfSrcBang unpk bang) = HsSrcBang Nothing unpk bang

604
tcIfaceEqSpec :: IfaceEqSpec -> IfL [EqSpec]
605 606 607
tcIfaceEqSpec spec
  = mapM do_item spec
  where
608
    do_item (occ, if_ty) = do { tv <- tcIfaceTyVar occ
609
                              ; ty <- tcIfaceType if_ty
610
                              ; return (mkEqSpec tv ty) }
611

Austin Seipp's avatar
Austin Seipp committed
612
{-
613 614 615
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
616
build a forkM thunk for the *rhs* (and family stuff).  To see why,
617 618 619 620 621 622 623 624 625 626 627 628 629
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.
630

Austin Seipp's avatar
Austin Seipp committed
631 632
************************************************************************
*                                                                      *
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
633
                Instances
Austin Seipp's avatar
Austin Seipp committed
634 635 636
*                                                                      *
************************************************************************
-}
637

638
tcIfaceInst :: IfaceClsInst -> IfL ClsInst
639
tcIfaceInst (IfaceClsInst { ifDFun = dfun_occ, ifOFlag = oflag
640 641
                          , ifInstCls = cls, ifInstTys = mb_tcs
                          , ifInstOrph = orph })
642
  = do { dfun <- forkM (text "Dict fun" <+> ppr dfun_occ) $
643
                 tcIfaceExtId dfun_occ
644
       ; let mb_tcs' = map (fmap ifaceTyConName) mb_tcs
645
       ; return (mkImportedInstance cls mb_tcs' dfun oflag orph) }
646

647 648 649
tcIfaceFamInst :: IfaceFamInst -> IfL FamInst
tcIfaceFamInst (IfaceFamInst { ifFamInstFam = fam, ifFamInstTys = mb_tcs
                             , ifFamInstAxiom = axiom_name } )
650
    = do { axiom' <- forkM (text "Axiom" <+> ppr axiom_name) $
651
                     tcIfaceCoAxiom axiom_name
652 653 654 655
             -- 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'') }
656

Austin Seipp's avatar
Austin Seipp committed
657 658 659
{-
************************************************************************
*                                                                      *
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
660
                Rules
Austin Seipp's avatar
Austin Seipp committed
661 662
*                                                                      *
************************************************************************
663 664

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
665
are in the type environment.  However, remember that typechecking a Rule may
666
(as a side effect) augment the type envt, and so we may need to iterate the process.
Austin Seipp's avatar
Austin Seipp committed
667
-}
668

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
669 670 671
tcIfaceRules :: Bool            -- True <=> ignore rules
             -> [IfaceRule]
             -> IfL [CoreRule]
672 673 674 675
tcIfaceRules ignore_prags if_rules
  | ignore_prags = return []
  | otherwise    = mapM tcIfaceRule if_rules

676 677
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
678
                        ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs,
679
                        ifRuleAuto = auto, ifRuleOrph = orph })
Simon Peyton Jones's avatar
Simon Peyton Jones committed
680
  = do  { ~(bndrs', args', rhs') <-
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
681
                -- Typecheck the payload lazily, in the hope it'll never be looked at
682
                forkM (text "Rule" <+> pprRuleName name) $
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
683 684 685 686 687
                bindIfaceBndrs bndrs                      $ \ bndrs' ->
                do { args' <- mapM tcIfaceExpr args
                   ; rhs'  <- tcIfaceExpr rhs
                   ; return (bndrs', args', rhs') }
        ; let mb_tcs = map ifTopFreeName args
688
        ; this_mod <- getIfModule
Simon Peyton Jones's avatar
Simon Peyton Jones committed
689 690 691
        ; 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
692
                          ru_rough = mb_tcs,
693 694
                          ru_origin = this_mod,
                          ru_orphan = orph,
695
                          ru_auto = auto,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
696 697 698
                          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
699
  where
700
        -- This function *must* mirror exactly what Rules.roughTopNames does
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
701 702 703
        -- 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
Gabor Greif's avatar
Gabor Greif committed
704
        -- type synonyms at the top of a type arg.  Since
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
705 706
        -- we can't tell at this point, we are careful not
        -- to write them out in coreRuleToIfaceRule
707 708
    ifTopFreeName :: IfaceExpr -> Maybe Name
    ifTopFreeName (IfaceType (IfaceTyConApp tc _ )) = Just (ifaceTyConName tc)
709
    ifTopFreeName (IfaceType (IfaceTupleTy s _ ts)) = Just (tupleTyConName s (length (tcArgsIfaceTypes ts)))
Ian Lynagh's avatar
Ian Lynagh committed
710
    ifTopFreeName (IfaceApp f _)                    = ifTopFreeName f
711
    ifTopFreeName (IfaceExt n)                      = Just n
Ian Lynagh's avatar
Ian Lynagh committed
712
    ifTopFreeName _                                 = Nothing
713

Austin Seipp's avatar
Austin Seipp committed
714 715 716
{-
************************************************************************
*                                                                      *
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
717
                Annotations
Austin Seipp's avatar
Austin Seipp committed
718 719 720
*                                                                      *
************************************************************************
-}
721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739

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
740 741 742
{-
************************************************************************
*                                                                      *
743
                Vectorisation information
Austin Seipp's avatar
Austin Seipp committed
744 745 746
*                                                                      *
************************************************************************
-}
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
747

748
-- We need access to the type environment as we need to look up information about type constructors
749 750 751 752 753
-- (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...
754 755
--
tcIfaceVectInfo :: Module -> TypeEnv -> IfaceVectInfo -> IfL VectInfo
Simon Peyton Jones's avatar
Simon Peyton Jones committed
756
tcIfaceVectInfo mod typeEnv (IfaceVectInfo
757 758 759 760 761
                             { ifaceVectInfoVar            = vars
                             , ifaceVectInfoTyCon          = tycons
                             , ifaceVectInfoTyConReuse     = tyconsReuse
                             , ifaceVectInfoParallelVars   = parallelVars
                             , ifaceVectInfoParallelTyCons = parallelTyCons
762
                             })
763 764
  = do { let parallelTyConsSet = mkNameSet parallelTyCons
       ; vVars         <- mapM vectVarMapping                  vars
765
       ; let varsSet = mkVarSet (map fst vVars)
766 767 768
       ; tyConRes1     <- mapM (vectTyConVectMapping varsSet)  tycons
       ; tyConRes2     <- mapM (vectTyConReuseMapping varsSet) tyconsReuse
       ; vParallelVars <- mapM vectVar                         parallelVars
769
       ; let (vTyCons, vDataCons, vScSels) = unzip3 (tyConRes1 ++ tyConRes2)
Simon Peyton Jones's avatar
Simon Peyton Jones committed
770
       ; return $ VectInfo
771 772 773 774 775
                  { vectInfoVar            = mkVarEnv  vVars `extendVarEnvList` concat vScSels
                  , vectInfoTyCon          = mkNameEnv vTyCons
                  , vectInfoDataCon        = mkNameEnv (concat vDataCons)
                  , vectInfoParallelVars   = mkVarSet  vParallelVars
                  , vectInfoParallelTyCons = parallelTyConsSet
776
                  }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
777 778
       }
  where
Simon Peyton Jones's avatar
Simon Peyton Jones committed
779
    vectVarMapping name
780
      = do { vName <- lookupIfaceTop (mkLocalisedOccName mod mkVectOcc name)
781
           ; var   <- forkM (text "vect var"  <+> ppr name)  $
782
                        tcIfaceExtId name
783 784 785
           ; vVar  <- forkM (text "vect vVar [mod =" <+>
                             ppr mod <> text "; nameModule =" <+>
                             ppr (nameModule name) <> text "]" <+> ppr vName) $
786