TcIface.hs 63.8 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
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 53
import BasicTypes       ( strongLoopBreaker, Arity, TupleSort(..)
                        , Boxity(..), pprRuleName )
54
import Literal
Simon Marlow's avatar
Simon Marlow committed
55
import qualified Var
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
56
import VarEnv
57
import VarSet
Simon Marlow's avatar
Simon Marlow committed
58
import Name
59
import NameEnv
60 61
import NameSet
import OccurAnal        ( occurAnalyseExpr )
62
import Demand
Simon Marlow's avatar
Simon Marlow committed
63
import Module
64
import UniqFM
Simon Marlow's avatar
Simon Marlow committed
65
import UniqSupply
Simon Peyton Jones's avatar
Simon Peyton Jones committed
66
import Outputable
Simon Marlow's avatar
Simon Marlow committed
67 68 69
import Maybes
import SrcLoc
import DynFlags
Ian Lynagh's avatar
Ian Lynagh committed
70
import Util
71
import FastString
Simon Marlow's avatar
Simon Marlow committed
72

Adam Gundry's avatar
Adam Gundry committed
73
import Data.List
74
import Control.Monad
75
import qualified Data.Map as Map
76
#if __GLASGOW_HASKELL__ < 709
77
import Data.Traversable ( traverse )
78
#endif
79

Austin Seipp's avatar
Austin Seipp committed
80
{-
81 82
This module takes

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

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

100

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

107 108 109 110 111 112 113
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
114
-}
115

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

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

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
143
                -- Vectorisation information
144
        ; 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
145

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

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

Simon Peyton Jones's avatar
Simon Peyton Jones committed
170
tcHiBootIface :: HscSource -> Module -> TcRn SelfBootInfo
171 172
-- 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
173
-- Return the ModDetails; Nothing if no hi-boot iface
174
tcHiBootIface hsc_src mod
175
  | HsBootFile <- hsc_src            -- Already compiling a hs-boot file
Simon Peyton Jones's avatar
Simon Peyton Jones committed
176
  = return NoSelfBoot
177
  | otherwise
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
178 179 180 181 182 183
  = 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
184
                --
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
185 186
                -- 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
187
                -- compile a module in TypecheckOnly mode, with a stable,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
188 189
                -- 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
190
                -- 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
191 192
                -- 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
193
                 ; case lookupUFM hpt (moduleName mod) of
Simon Peyton Jones's avatar
Simon Peyton Jones committed
194
                      Just info | mi_boot (hm_iface info)
Simon Peyton Jones's avatar
Simon Peyton Jones committed
195 196
                                -> return (mkSelfBootInfo (hm_details info))
                      _ -> return NoSelfBoot }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
197 198
          else do

Simon Peyton Jones's avatar
Simon Peyton Jones committed
199
        -- OK, so we're in one-shot mode.
200 201 202 203 204 205
        -- 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
206

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

        -- 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
221
            Nothing -> return NoSelfBoot -- The typical case
222 223

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

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

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

Simon Peyton Jones's avatar
Simon Peyton Jones committed
237
    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
238
                          quotes (ppr mod) <> colon) 4 err
239

Simon Peyton Jones's avatar
Simon Peyton Jones committed
240 241 242 243 244 245 246 247 248

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
249 250 251
{-
************************************************************************
*                                                                      *
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
252
                Type and class declarations
Austin Seipp's avatar
Austin Seipp committed
253 254
*                                                                      *
************************************************************************
255 256 257 258 259 260

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

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
283 284 285
        * 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
286

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

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

300
tcIfaceDecl :: Bool     -- ^ True <=> discard IdInfo on IfaceId bindings
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
301 302
            -> IfaceDecl
            -> IfL TyThing
303
tcIfaceDecl = tc_iface_decl Nothing
304

305 306
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
307 308
              -> IfaceDecl
              -> IfL TyThing
Simon Peyton Jones's avatar
Simon Peyton Jones committed
309
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
310 311 312 313 314 315
                                       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)) }
316

317
tc_iface_decl _ _ (IfaceData {ifName = occ_name,
Simon Peyton Jones's avatar
Simon Peyton Jones committed
318
                          ifCType = cType,
319 320
                          ifTyVars = tv_bndrs,
                          ifRoles = roles,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
321
                          ifCtxt = ctxt, ifGadtSyntax = gadt_syn,
Simon Peyton Jones's avatar
Simon Peyton Jones committed
322 323
                          ifCons = rdr_cons,
                          ifRec = is_rec, ifPromotable = is_prom,
324
                          ifParent = mb_parent })
325 326
  = bindIfaceTyVars_AT tv_bndrs $ \ tyvars -> do
    { tc_name <- lookupIfaceTop occ_name
327
    ; tycon <- fixM $ \ tycon -> do
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
328
            { stupid_theta <- tcIfaceCtxt ctxt
329 330
            ; parent' <- tc_parent tc_name mb_parent
            ; cons <- tcIfaceDataCons tc_name tycon tyvars rdr_cons is_prom
Simon Peyton Jones's avatar
Simon Peyton Jones committed
331
            ; return (buildAlgTyCon tc_name tyvars roles cType stupid_theta
332
                                    cons is_rec is_prom gadt_syn parent') }
333 334
    ; traceIf (text "tcIfaceDecl4" <+> ppr tycon)
    ; return (ATyCon tycon) }
335
  where
336 337 338 339 340 341
    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
342
           ; let fam_tc  = coAxiomTyCon ax
343
                 ax_unbr = toUnbranchedAxiom ax
344
           ; lhs_tys <- tcIfaceTcArgs arg_tys
345
           ; return (DataFamInstTyCon ax_unbr fam_tc lhs_tys) }
346

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

tc_iface_decl parent _ (IfaceFamily {ifName = occ_name, ifTyVars = tv_bndrs,
                                     ifFamFlav = fam_flav,
Jan Stolarek's avatar
Jan Stolarek committed
363 364
                                     ifFamKind = kind,
                                     ifResVar = res, ifFamInj = inj })
365 366 367 368
   = 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) $
369
                   tc_fam_flav tc_name fam_flav
Jan Stolarek's avatar
Jan Stolarek committed
370 371 372
     ; res_name <- traverse (newIfaceName . mkTyVarOccFS) res
     ; let tycon = buildFamilyTyCon tc_name tyvars res_name rhs rhs_kind
                                    parent inj
373 374 375
     ; return (ATyCon tycon) }
   where
     mk_doc n = ptext (sLit "Type synonym") <+> ppr n
376 377 378 379 380 381 382

     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)
383
       = do { ax <- traverse (tcIfaceCoAxiom . fst) mb_ax_name_branches
384
            ; return (ClosedSynFamilyTyCon ax) }
385
     tc_fam_flav _ IfaceAbstractClosedSynFamilyTyCon
386
         = return AbstractClosedSynFamilyTyCon
387
     tc_fam_flav _ IfaceBuiltInSynFamTyCon
388 389
         = pprPanic "tc_iface_decl"
                    (text "IfaceBuiltInSynFamTyCon in interface file")
390

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

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

430
   tc_at cls (IfaceAT tc_decl if_def)
431
     = do ATyCon tc <- tc_iface_decl (Just cls) ignore_prags tc_decl
432 433 434 435 436
          mb_def <- case if_def of
                      Nothing  -> return Nothing
                      Just def -> forkM (mk_at_doc tc)                 $
                                  extendIfaceTyVarEnv (tyConTyVars tc) $
                                  do { tc_def <- tcIfaceType def
437
                                     ; return (Just (tc_def, noSrcSpan)) }
438 439 440
                  -- 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
441
          return (ATI tc mb_def)
442

443 444
   mk_sc_doc pred = ptext (sLit "Superclass") <+> ppr pred
   mk_at_doc tc = ptext (sLit "Associated type") <+> ppr tc
445
   mk_op_doc op_name op_ty = ptext (sLit "Class op") <+> sep [ppr op_name, ppr op_ty]
446

447
   tc_fd (tvs1, tvs2) = do { tvs1' <- mapM tcIfaceTyVar tvs1
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
448 449
                           ; tvs2' <- mapM tcIfaceTyVar tvs2
                           ; return (tvs1', tvs2') }
450

451 452
tc_iface_decl _ _ (IfaceAxiom { ifName = ax_occ, ifTyCon = tc
                              , ifAxBranches = branches, ifRole = role })
453 454
  = do { tc_name     <- lookupIfaceTop ax_occ
       ; tc_tycon    <- tcIfaceTyCon tc
455
       ; tc_branches <- tc_ax_branches branches
456
       ; let axiom = CoAxiom { co_ax_unique   = nameUnique tc_name
457 458
                             , co_ax_name     = tc_name
                             , co_ax_tc       = tc_tycon
459
                             , co_ax_role     = role
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
460
                             , co_ax_branches = manyBranches tc_branches
461 462
                             , co_ax_implicit = False }
       ; return (ACoAxiom axiom) }
463

Gergő Érdi's avatar
Gergő Érdi committed
464
tc_iface_decl _ _ (IfacePatSyn{ ifName = occ_name
465 466
                              , ifPatMatcher = if_matcher
                              , ifPatBuilder = if_builder
Gergő Érdi's avatar
Gergő Érdi committed
467 468 469 470 471 472
                              , ifPatIsInfix = is_infix
                              , ifPatUnivTvs = univ_tvs
                              , ifPatExTvs = ex_tvs
                              , ifPatProvCtxt = prov_ctxt
                              , ifPatReqCtxt = req_ctxt
                              , ifPatArgs = args
Matthew Pickering's avatar
Matthew Pickering committed
473 474
                              , ifPatTy = pat_ty
                              , ifFieldLabels = field_labels })
Gergő Érdi's avatar
Gergő Érdi committed
475 476
  = do { name <- lookupIfaceTop occ_name
       ; traceIf (ptext (sLit "tc_iface_decl") <+> ppr name)
477 478
       ; matcher <- tc_pr if_matcher
       ; builder <- fmapMaybeM tc_pr if_builder
Gergő Érdi's avatar
Gergő Érdi committed
479 480
       ; bindIfaceTyVars univ_tvs $ \univ_tvs -> do
       { bindIfaceTyVars ex_tvs $ \ex_tvs -> do
481
       { patsyn <- forkM (mk_doc name) $
Gergő Érdi's avatar
Gergő Érdi committed
482 483 484
             do { prov_theta <- tcIfaceCtxt prov_ctxt
                ; req_theta  <- tcIfaceCtxt req_ctxt
                ; pat_ty     <- tcIfaceType pat_ty
485
                ; arg_tys    <- mapM tcIfaceType args
486
                ; return $ buildPatSyn name is_infix matcher builder
487
                                       (univ_tvs, req_theta) (ex_tvs, prov_theta)
Matthew Pickering's avatar
Matthew Pickering committed
488
                                       arg_tys pat_ty field_labels }
489
       ; return $ AConLike . PatSynCon $ patsyn }}}
Gergő Érdi's avatar
Gergő Érdi committed
490 491
  where
     mk_doc n = ptext (sLit "Pattern synonym") <+> ppr n
492 493 494
     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
495

496 497
tc_ax_branches :: [IfaceAxBranch] -> IfL [CoAxBranch]
tc_ax_branches if_branches = foldlM tc_ax_branch [] if_branches
498

499 500
tc_ax_branch :: [CoAxBranch] -> IfaceAxBranch -> IfL [CoAxBranch]
tc_ax_branch prev_branches
501 502
             (IfaceAxBranch { ifaxbTyVars = tv_bndrs, ifaxbLHS = lhs, ifaxbRHS = rhs
                            , ifaxbRoles = roles, ifaxbIncomps = incomps })
503 504
  = bindIfaceTyVars_AT tv_bndrs $ \ tvs -> do
         -- The _AT variant is needed here; see Note [CoAxBranch type variables] in CoAxiom
505
    { tc_lhs <- tcIfaceTcArgs lhs   -- See Note [Checking IfaceTypes vs IfaceKinds]
506
    ; tc_rhs <- tcIfaceType rhs
507 508 509 510 511
    ; let br = CoAxBranch { cab_loc     = noSrcSpan
                          , cab_tvs     = tvs
                          , cab_lhs     = tc_lhs
                          , cab_roles   = roles
                          , cab_rhs     = tc_rhs
512 513
                          , cab_incomps = map (prev_branches !!) incomps }
    ; return (prev_branches ++ [br]) }
514

515 516
tcIfaceDataCons :: Name -> TyCon -> [TyVar] -> IfaceConDecls -> Bool -> IfL AlgTyConRhs
tcIfaceDataCons tycon_name tycon tc_tyvars if_cons is_prom
517
  = case if_cons of
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
518
        IfAbstractTyCon dis -> return (AbstractTyCon dis)
Adam Gundry's avatar
Adam Gundry committed
519 520 521 522 523 524
        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 }
525
  where
Adam Gundry's avatar
Adam Gundry committed
526
    tc_con_decl field_lbls (IfCon { ifConInfix = is_infix,
527
                         ifConExTvs = ex_tvs,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
528
                         ifConOcc = occ, ifConCtxt = ctxt, ifConEqSpec = spec,
Adam Gundry's avatar
Adam Gundry committed
529
                         ifConArgTys = args, ifConFields = my_lbls,
530 531
                         ifConStricts = if_stricts,
                         ifConSrcStricts = if_src_stricts})
532
     = -- Universally-quantified tyvars are shared with
533
       -- parent TyCon, and are alrady in scope
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
534
       bindIfaceTyVars ex_tvs    $ \ ex_tyvars -> do
535
        { traceIf (text "Start interface-file tc_con_decl" <+> ppr occ)
536
        ; dc_name  <- lookupIfaceTop occ
537 538

        -- Read the context and argument types, but lazily for two reasons
Simon Peyton Jones's avatar
Simon Peyton Jones committed
539
        -- (a) to avoid looking tugging on a recursive use of
540
        --     the type itself, which is knot-tied
Simon Peyton Jones's avatar
Simon Peyton Jones committed
541
        -- (b) to avoid faulting in the component types unless
542
        --     they are really needed
543
        ; ~(eq_spec, theta, arg_tys, stricts) <- forkM (mk_doc dc_name) $
544 545 546
             do { eq_spec <- tcIfaceEqSpec spec
                ; theta   <- tcIfaceCtxt ctxt
                ; arg_tys <- mapM tcIfaceType args
Simon Peyton Jones's avatar
Simon Peyton Jones committed
547 548
                ; stricts <- mapM tc_strict if_stricts
                        -- The IfBang field can mention
549 550
                        -- the type itself; hence inside forkM
                ; return (eq_spec, theta, arg_tys, stricts) }
Adam Gundry's avatar
Adam Gundry committed
551 552 553 554 555 556 557

        -- 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
558 559

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

563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580
        ; prom_info <- if is_prom then do { n <- newTyConRepName dc_name
                                          ; return (Promoted n) }
                                  else return NotPromoted

        ; con <- buildDataCon (pprPanic "tcIfaceDataCons: FamInstEnvs" (ppr dc_name))
                       dc_name is_infix prom_info
                       (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
581
        ; return con }
Ian Lynagh's avatar
Ian Lynagh committed
582
    mk_doc con_name = ptext (sLit "Constructor") <+> ppr con_name
583

Simon Peyton Jones's avatar
Simon Peyton Jones committed
584
    tc_strict :: IfaceBang -> IfL HsImplBang
585 586
    tc_strict IfNoBang = return (HsLazy)
    tc_strict IfStrict = return (HsStrict)
587 588 589 590
    tc_strict IfUnpack = return (HsUnpack Nothing)
    tc_strict (IfUnpackCo if_co) = do { co <- tcIfaceCo if_co
                                      ; return (HsUnpack (Just co)) }

591 592 593
    src_strict :: IfaceSrcBang -> HsSrcBang
    src_strict (IfSrcBang unpk bang) = HsSrcBang Nothing unpk bang

594
tcIfaceEqSpec :: IfaceEqSpec -> IfL [(TyVar, Type)]
595 596 597
tcIfaceEqSpec spec
  = mapM do_item spec
  where
598
    do_item (occ, if_ty) = do { tv <- tcIfaceTyVar occ
599 600
                              ; ty <- tcIfaceType if_ty
                              ; return (tv,ty) }
601

Austin Seipp's avatar
Austin Seipp committed
602
{-
603 604 605
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
606
build a forkM thunk for the *rhs* (and family stuff).  To see why,
607 608 609 610 611 612 613 614 615 616 617 618 619
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.
620

Austin Seipp's avatar
Austin Seipp committed
621 622
************************************************************************
*                                                                      *
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
623
                Instances
Austin Seipp's avatar
Austin Seipp committed
624 625 626
*                                                                      *
************************************************************************
-}
627

628
tcIfaceInst :: IfaceClsInst -> IfL ClsInst
629
tcIfaceInst (IfaceClsInst { ifDFun = dfun_occ, ifOFlag = oflag
630 631
                          , ifInstCls = cls, ifInstTys = mb_tcs
                          , ifInstOrph = orph })
632 633
  = do { dfun <- forkM (ptext (sLit "Dict fun") <+> ppr dfun_occ) $
                 tcIfaceExtId dfun_occ
634
       ; let mb_tcs' = map (fmap ifaceTyConName) mb_tcs
635
       ; return (mkImportedInstance cls mb_tcs' dfun oflag orph) }
636

637 638 639
tcIfaceFamInst :: IfaceFamInst -> IfL FamInst
tcIfaceFamInst (IfaceFamInst { ifFamInstFam = fam, ifFamInstTys = mb_tcs
                             , ifFamInstAxiom = axiom_name } )
640 641
    = do { axiom' <- forkM (ptext (sLit "Axiom") <+> ppr axiom_name) $
                     tcIfaceCoAxiom axiom_name
642 643 644 645
             -- 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'') }
646

Austin Seipp's avatar
Austin Seipp committed
647 648 649
{-
************************************************************************
*                                                                      *
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
650
                Rules
Austin Seipp's avatar
Austin Seipp committed
651 652
*                                                                      *
************************************************************************
653 654

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

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
659 660 661
tcIfaceRules :: Bool            -- True <=> ignore rules
             -> [IfaceRule]
             -> IfL [CoreRule]
662 663 664 665
tcIfaceRules ignore_prags if_rules
  | ignore_prags = return []
  | otherwise    = mapM tcIfaceRule if_rules

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

Austin Seipp's avatar
Austin Seipp committed
704 705 706
{-
************************************************************************
*                                                                      *
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
707
                Annotations
Austin Seipp's avatar
Austin Seipp committed
708 709 710
*                                                                      *
************************************************************************
-}
711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729

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
730 731 732
{-
************************************************************************
*                                                                      *
733
                Vectorisation information
Austin Seipp's avatar
Austin Seipp committed
734 735 736
*                                                                      *
************************************************************************
-}
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
737

738
-- We need access to the type environment as we need to look up information about type constructors
739 740 741 742 743
-- (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...
744 745
--
tcIfaceVectInfo :: Module -> TypeEnv -> IfaceVectInfo -> IfL VectInfo
Simon Peyton Jones's avatar
Simon Peyton Jones committed
746
tcIfaceVectInfo mod typeEnv (IfaceVectInfo
747 748 749 750 751
                             { ifaceVectInfoVar            = vars
                             , ifaceVectInfoTyCon          = tycons
                             , ifaceVectInfoTyConReuse     = tyconsReuse
                             , ifaceVectInfoParallelVars   = parallelVars
                             , ifaceVectInfoParallelTyCons = parallelTyCons
752
                             })
753 754
  = do { let parallelTyConsSet = mkNameSet parallelTyCons
       ; vVars         <- mapM vectVarMapping                  vars
755
       ; let varsSet = mkVarSet (map fst vVars)
756 757 758
       ; tyConRes1     <- mapM (vectTyConVectMapping varsSet)  tycons
       ; tyConRes2     <- mapM (vectTyConReuseMapping varsSet) tyconsReuse
       ; vParallelVars <- mapM vectVar                         parallelVars
759
       ; let (vTyCons, vDataCons, vScSels) = unzip3 (tyConRes1 ++ tyConRes2)
Simon Peyton Jones's avatar
Simon Peyton Jones committed
760
       ; return $ VectInfo
761 762 763 764 765
                  { vectInfoVar            = mkVarEnv  vVars `extendVarEnvList` concat vScSels
                  , vectInfoTyCon          = mkNameEnv vTyCons
                  , vectInfoDataCon        = mkNameEnv (concat vDataCons)
                  , vectInfoParallelVars   = mkVarSet  vParallelVars
                  , vectInfoParallelTyCons = parallelTyConsSet
766
                  }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
767 768
       }
  where
Simon Peyton Jones's avatar
Simon Peyton Jones committed
769
    vectVarMapping name
770
      = do { vName <- lookupIfaceTop (mkLocalisedOccName mod mkVectOcc name)
chak@cse.unsw.edu.au.'s avatar