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 10
{-# LANGUAGE CPP #-}

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

20 21
#include "HsVersions.h"

22
import TcTypeNats(typeNatCoAxiomRules)
23
import IfaceSyn
Simon Marlow's avatar
Simon Marlow committed
24 25 26
import LoadIface
import IfaceEnv
import BuildTyCl
27
import TcRnMonad
28
import TcType
Simon Marlow's avatar
Simon Marlow committed
29
import Type
30
import Coercion hiding (substTy)
Simon Marlow's avatar
Simon Marlow committed
31 32
import TypeRep
import HscTypes
33
import Annotations
Simon Marlow's avatar
Simon Marlow committed
34 35
import InstEnv
import FamInstEnv
36
import CoreSyn
Simon Marlow's avatar
Simon Marlow committed
37
import CoreUtils
38
import CoreUnfold
Simon Marlow's avatar
Simon Marlow committed
39
import CoreLint
40
import MkCore
Simon Marlow's avatar
Simon Marlow committed
41 42 43 44 45
import Id
import MkId
import IdInfo
import Class
import TyCon
46
import CoAxiom
Gergő Érdi's avatar
Gergő Érdi committed
47
import ConLike
Simon Marlow's avatar
Simon Marlow committed
48
import DataCon
49
import PrelNames
Simon Marlow's avatar
Simon Marlow committed
50
import TysWiredIn
51
import TysPrim          ( superKindTyConName )
52 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

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

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

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

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

99

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
304 305 306 307
tc_iface_decl :: TyConParent    -- For nested declarations
              -> Bool   -- True <=> discard IdInfo on IfaceId bindings
              -> IfaceDecl
              -> IfL TyThing
Simon Peyton Jones's avatar
Simon Peyton Jones committed
308
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
309 310 311 312 313 314
                                       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)) }
315

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

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

tc_iface_decl parent _ (IfaceFamily {ifName = occ_name, ifTyVars = tv_bndrs,
                                     ifFamFlav = fam_flav,
                                     ifFamKind = kind })
   = bindIfaceTyVars_AT tv_bndrs $ \ tyvars -> do
     { tc_name  <- lookupIfaceTop occ_name
     ; rhs_kind <- tcIfaceKind kind     -- Note [Synonym kind loop]
     ; rhs      <- forkM (mk_doc tc_name) $
                   tc_fam_flav fam_flav
     ; tycon    <- buildFamilyTyCon tc_name tyvars rhs rhs_kind parent
     ; return (ATyCon tycon) }
   where
     mk_doc n = ptext (sLit "Type synonym") <+> ppr n
     tc_fam_flav IfaceOpenSynFamilyTyCon   = return OpenSynFamilyTyCon
372 373
     tc_fam_flav (IfaceClosedSynFamilyTyCon mb_ax_name_branches)
       = do { ax <- traverse (tcIfaceCoAxiom . fst) mb_ax_name_branches
374
            ; return (ClosedSynFamilyTyCon ax) }
375 376 377 378 379
     tc_fam_flav IfaceAbstractClosedSynFamilyTyCon
         = return AbstractClosedSynFamilyTyCon
     tc_fam_flav IfaceBuiltInSynFamTyCon
         = pprPanic "tc_iface_decl"
                    (text "IfaceBuiltInSynFamTyCon in interface file")
380

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

412 413
   tc_sig (IfaceClassOp occ dm rdr_ty)
     = do { op_name <- lookupIfaceTop occ
414
          ; op_ty   <- forkM (mk_op_doc op_name rdr_ty) (tcIfaceType rdr_ty)
Simon Peyton Jones's avatar
Simon Peyton Jones committed
415
                -- Must be done lazily for just the same reason as the
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
416
                -- type of a data con; to avoid sucking in types that
417
                -- it mentions unless it's necessary to do so
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
418
          ; return (op_name, dm, op_ty) }
419

420
   tc_at cls (IfaceAT tc_decl if_def)
421
     = do ATyCon tc <- tc_iface_decl (AssocFamilyTyCon cls) ignore_prags tc_decl
422 423 424 425 426 427
          mb_def <- case if_def of
                      Nothing  -> return Nothing
                      Just def -> forkM (mk_at_doc tc)                 $
                                  extendIfaceTyVarEnv (tyConTyVars tc) $
                                  do { tc_def <- tcIfaceType def
                                     ; return (Just tc_def) }
428 429 430
                  -- 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
431
          return (ATI tc mb_def)
432

433 434
   mk_sc_doc pred = ptext (sLit "Superclass") <+> ppr pred
   mk_at_doc tc = ptext (sLit "Associated type") <+> ppr tc
435
   mk_op_doc op_name op_ty = ptext (sLit "Class op") <+> sep [ppr op_name, ppr op_ty]
436

437
   tc_fd (tvs1, tvs2) = do { tvs1' <- mapM tcIfaceTyVar tvs1
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
438 439
                           ; tvs2' <- mapM tcIfaceTyVar tvs2
                           ; return (tvs1', tvs2') }
440

441 442
tc_iface_decl _ _ (IfaceAxiom { ifName = ax_occ, ifTyCon = tc
                              , ifAxBranches = branches, ifRole = role })
443 444
  = do { tc_name     <- lookupIfaceTop ax_occ
       ; tc_tycon    <- tcIfaceTyCon tc
445
       ; tc_branches <- tc_ax_branches branches
446
       ; let axiom = CoAxiom { co_ax_unique   = nameUnique tc_name
447 448
                             , co_ax_name     = tc_name
                             , co_ax_tc       = tc_tycon
449
                             , co_ax_role     = role
450 451 452
                             , co_ax_branches = toBranchList tc_branches
                             , co_ax_implicit = False }
       ; return (ACoAxiom axiom) }
453

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

485 486
tc_ax_branches :: [IfaceAxBranch] -> IfL [CoAxBranch]
tc_ax_branches if_branches = foldlM tc_ax_branch [] if_branches
487

488 489
tc_ax_branch :: [CoAxBranch] -> IfaceAxBranch -> IfL [CoAxBranch]
tc_ax_branch prev_branches
490 491
             (IfaceAxBranch { ifaxbTyVars = tv_bndrs, ifaxbLHS = lhs, ifaxbRHS = rhs
                            , ifaxbRoles = roles, ifaxbIncomps = incomps })
492 493
  = bindIfaceTyVars_AT tv_bndrs $ \ tvs -> do
         -- The _AT variant is needed here; see Note [CoAxBranch type variables] in CoAxiom
494
    { tc_lhs <- tcIfaceTcArgs lhs   -- See Note [Checking IfaceTypes vs IfaceKinds]
495
    ; tc_rhs <- tcIfaceType rhs
496 497 498 499 500
    ; let br = CoAxBranch { cab_loc     = noSrcSpan
                          , cab_tvs     = tvs
                          , cab_lhs     = tc_lhs
                          , cab_roles   = roles
                          , cab_rhs     = tc_rhs
501 502
                          , cab_incomps = map (prev_branches !!) incomps }
    ; return (prev_branches ++ [br]) }
503

Ian Lynagh's avatar
Ian Lynagh committed
504
tcIfaceDataCons :: Name -> TyCon -> [TyVar] -> IfaceConDecls -> IfL AlgTyConRhs
505
tcIfaceDataCons tycon_name tycon tc_tyvars if_cons
506
  = case if_cons of
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
507
        IfAbstractTyCon dis -> return (AbstractTyCon dis)
508
        IfDataFamTyCon  -> return DataFamilyTyCon
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
509 510 511 512
        IfDataTyCon cons -> do  { data_cons <- mapM tc_con_decl cons
                                ; return (mkDataTyConRhs data_cons) }
        IfNewTyCon con   -> do  { data_con <- tc_con_decl con
                                ; mkNewTyConRhs tycon_name tycon data_con }
513
  where
Simon Peyton Jones's avatar
Simon Peyton Jones committed
514
    tc_con_decl (IfCon { ifConInfix = is_infix,
515
                         ifConExTvs = ex_tvs,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
516 517
                         ifConOcc = occ, ifConCtxt = ctxt, ifConEqSpec = spec,
                         ifConArgTys = args, ifConFields = field_lbls,
518 519
                         ifConStricts = if_stricts,
                         ifConSrcStricts = if_src_stricts})
520
     = -- Universally-quantified tyvars are shared with
521
       -- parent TyCon, and are alrady in scope
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
522
       bindIfaceTyVars ex_tvs    $ \ ex_tyvars -> do
523 524
        { traceIf (text "Start interface-file tc_con_decl" <+> ppr occ)
        ; name  <- lookupIfaceTop occ
525 526

        -- Read the context and argument types, but lazily for two reasons
Simon Peyton Jones's avatar
Simon Peyton Jones committed
527
        -- (a) to avoid looking tugging on a recursive use of
528
        --     the type itself, which is knot-tied
Simon Peyton Jones's avatar
Simon Peyton Jones committed
529
        -- (b) to avoid faulting in the component types unless
530
        --     they are really needed
531
        ; ~(eq_spec, theta, arg_tys, stricts) <- forkM (mk_doc name) $
532 533 534
             do { eq_spec <- tcIfaceEqSpec spec
                ; theta   <- tcIfaceCtxt ctxt
                ; arg_tys <- mapM tcIfaceType args
Simon Peyton Jones's avatar
Simon Peyton Jones committed
535 536
                ; stricts <- mapM tc_strict if_stricts
                        -- The IfBang field can mention
537 538
                        -- the type itself; hence inside forkM
                ; return (eq_spec, theta, arg_tys, stricts) }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
539 540 541
        ; lbl_names <- mapM lookupIfaceTop field_lbls

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

545
        ; con <- buildDataCon (pprPanic "tcIfaceDataCons: FamInstEnvs" (ppr name))
546 547 548 549 550 551 552 553 554 555 556 557
                   name is_infix
                   (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
558
        ; traceIf (text "Done interface-file tc_con_decl" <+> ppr name)
Simon Peyton Jones's avatar
Simon Peyton Jones committed
559
        ; return con }
Ian Lynagh's avatar
Ian Lynagh committed
560
    mk_doc con_name = ptext (sLit "Constructor") <+> ppr con_name
561

Simon Peyton Jones's avatar
Simon Peyton Jones committed
562
    tc_strict :: IfaceBang -> IfL HsImplBang
563 564
    tc_strict IfNoBang = return (HsLazy)
    tc_strict IfStrict = return (HsStrict)
565 566 567 568
    tc_strict IfUnpack = return (HsUnpack Nothing)
    tc_strict (IfUnpackCo if_co) = do { co <- tcIfaceCo if_co
                                      ; return (HsUnpack (Just co)) }

569 570 571
    src_strict :: IfaceSrcBang -> HsSrcBang
    src_strict (IfSrcBang unpk bang) = HsSrcBang Nothing unpk bang

572
tcIfaceEqSpec :: IfaceEqSpec -> IfL [(TyVar, Type)]
573 574 575
tcIfaceEqSpec spec
  = mapM do_item spec
  where
576
    do_item (occ, if_ty) = do { tv <- tcIfaceTyVar occ
577 578
                              ; ty <- tcIfaceType if_ty
                              ; return (tv,ty) }
579

Austin Seipp's avatar
Austin Seipp committed
580
{-
581 582 583
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
584
build a forkM thunk for the *rhs* (and family stuff).  To see why,
585 586 587 588 589 590 591 592 593 594 595 596 597
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.
598

Austin Seipp's avatar
Austin Seipp committed
599 600
************************************************************************
*                                                                      *
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
601
                Instances
Austin Seipp's avatar
Austin Seipp committed
602 603 604
*                                                                      *
************************************************************************
-}
605

606
tcIfaceInst :: IfaceClsInst -> IfL ClsInst
607
tcIfaceInst (IfaceClsInst { ifDFun = dfun_occ, ifOFlag = oflag
608 609
                          , ifInstCls = cls, ifInstTys = mb_tcs
                          , ifInstOrph = orph })
610 611
  = do { dfun <- forkM (ptext (sLit "Dict fun") <+> ppr dfun_occ) $
                 tcIfaceExtId dfun_occ
612
       ; let mb_tcs' = map (fmap ifaceTyConName) mb_tcs
613
       ; return (mkImportedInstance cls mb_tcs' dfun oflag orph) }
614

615 616 617
tcIfaceFamInst :: IfaceFamInst -> IfL FamInst
tcIfaceFamInst (IfaceFamInst { ifFamInstFam = fam, ifFamInstTys = mb_tcs
                             , ifFamInstAxiom = axiom_name } )
618 619
    = do { axiom' <- forkM (ptext (sLit "Axiom") <+> ppr axiom_name) $
                     tcIfaceCoAxiom axiom_name
620 621 622 623
             -- 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'') }
624

Austin Seipp's avatar
Austin Seipp committed
625 626 627
{-
************************************************************************
*                                                                      *
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
628
                Rules
Austin Seipp's avatar
Austin Seipp committed
629 630
*                                                                      *
************************************************************************
631 632

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

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
637 638 639
tcIfaceRules :: Bool            -- True <=> ignore rules
             -> [IfaceRule]
             -> IfL [CoreRule]
640 641 642 643
tcIfaceRules ignore_prags if_rules
  | ignore_prags = return []
  | otherwise    = mapM tcIfaceRule if_rules

644 645
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
646
                        ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs,
647
                        ifRuleAuto = auto, ifRuleOrph = orph })
Simon Peyton Jones's avatar
Simon Peyton Jones committed
648
  = do  { ~(bndrs', args', rhs') <-
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
649
                -- Typecheck the payload lazily, in the hope it'll never be looked at
650
                forkM (ptext (sLit "Rule") <+> pprRuleName name) $
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
651 652 653 654 655
                bindIfaceBndrs bndrs                      $ \ bndrs' ->
                do { args' <- mapM tcIfaceExpr args
                   ; rhs'  <- tcIfaceExpr rhs
                   ; return (bndrs', args', rhs') }
        ; let mb_tcs = map ifTopFreeName args
656
        ; this_mod <- getIfModule
Simon Peyton Jones's avatar
Simon Peyton Jones committed
657 658 659
        ; 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
660
                          ru_rough = mb_tcs,
661 662
                          ru_origin = this_mod,
                          ru_orphan = orph,
663
                          ru_auto = auto,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
664 665 666
                          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
667
  where
668
        -- This function *must* mirror exactly what Rules.roughTopNames does
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
669 670 671
        -- 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
672
        -- type synonyms at the top of a type arg.  Since
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
673 674
        -- we can't tell at this point, we are careful not
        -- to write them out in coreRuleToIfaceRule
675 676
    ifTopFreeName :: IfaceExpr -> Maybe Name
    ifTopFreeName (IfaceType (IfaceTyConApp tc _ )) = Just (ifaceTyConName tc)
677
    ifTopFreeName (IfaceType (IfaceTupleTy s _ ts)) = Just (tupleTyConName s (length (tcArgsIfaceTypes ts)))
Ian Lynagh's avatar
Ian Lynagh committed
678
    ifTopFreeName (IfaceApp f _)                    = ifTopFreeName f
679
    ifTopFreeName (IfaceExt n)                      = Just n
Ian Lynagh's avatar
Ian Lynagh committed
680
    ifTopFreeName _                                 = Nothing
681

Austin Seipp's avatar
Austin Seipp committed
682 683 684
{-
************************************************************************
*                                                                      *
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
685
                Annotations
Austin Seipp's avatar
Austin Seipp committed
686 687 688
*                                                                      *
************************************************************************
-}
689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707

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
708 709 710
{-
************************************************************************
*                                                                      *
711
                Vectorisation information
Austin Seipp's avatar
Austin Seipp committed
712 713 714
*                                                                      *
************************************************************************
-}
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
715

716
-- We need access to the type environment as we need to look up information about type constructors
717 718 719 720 721
-- (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...
722 723
--
tcIfaceVectInfo :: Module -> TypeEnv -> IfaceVectInfo -> IfL VectInfo
Simon Peyton Jones's avatar
Simon Peyton Jones committed
724
tcIfaceVectInfo mod typeEnv (IfaceVectInfo
725 726 727 728 729
                             { ifaceVectInfoVar            = vars
                             , ifaceVectInfoTyCon          = tycons
                             , ifaceVectInfoTyConReuse     = tyconsReuse
                             , ifaceVectInfoParallelVars   = parallelVars
                             , ifaceVectInfoParallelTyCons = parallelTyCons
730
                             })
731 732
  = do { let parallelTyConsSet = mkNameSet parallelTyCons
       ; vVars         <- mapM vectVarMapping                  vars
733
       ; let varsSet = mkVarSet (map fst vVars)
734 735 736
       ; tyConRes1     <- mapM (vectTyConVectMapping varsSet)  tycons
       ; tyConRes2     <- mapM (vectTyConReuseMapping varsSet) tyconsReuse
       ; vParallelVars <- mapM vectVar                         parallelVars
737
       ; let (vTyCons, vDataCons, vScSels) = unzip3 (tyConRes1 ++ tyConRes2)
Simon Peyton Jones's avatar
Simon Peyton Jones committed
738
       ; return $ VectInfo
739 740 741 742 743
                  { vectInfoVar            = mkVarEnv  vVars `extendVarEnvList` concat vScSels
                  , vectInfoTyCon          = mkNameEnv vTyCons
                  , vectInfoDataCon        = mkNameEnv (concat vDataCons)
                  , vectInfoParallelVars   = mkVarSet  vParallelVars
                  , vectInfoParallelTyCons = parallelTyConsSet
744
                  }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
745 746
       }
  where
Simon Peyton Jones's avatar
Simon Peyton Jones committed
747
    vectVarMapping name
748
      = do { vName <- lookupIfaceTop (mkLocalisedOccName mod mkVectOcc name)
749 750
           ; var   <- forkM (ptext (sLit "vect var")  <+> ppr name)  $
                        tcIfaceExtId name
Simon Peyton Jones's avatar
Simon Peyton Jones committed
751 752
           ; vVar  <- forkM (ptext (sLit "vect vVar [mod =") <+>
                             ppr mod <> ptext (sLit "; nameModule =") <+>
753 754
                             ppr (nameModule name) <> ptext (sLit "]") <+> ppr vName) $
                       tcIfaceExtId vName
755
           ; return (var, (var, vVar))
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
756
           }
757 758 759 760 761 762 763 764 765 766 767
      -- where
      --   lookupLocalOrExternalId name
      --     = do { let mb_id = lookupTypeEnv typeEnv name
      --          ; case mb_id of
      --                -- id is local
      --              Just (AnId id) -> return id
      --                -- name is not an Id => internal inconsistency
      --              Just _         -> notAnIdErr
      --                -- Id is external
      --              Nothing        -> tcIfaceExtId name
      --          }
Simon Peyton Jones's avatar
Simon Peyton Jones committed
768
      --
769
      --   notAnIdErr = pprPanic "TcIface.tcIfaceVectInfo: not an id" (ppr name)
770

Simon Peyton Jones's avatar
Simon Peyton Jones committed
771
    vectVar name
772 773 774
      = forkM (ptext (sLit "vect scalar var")  <+> ppr name)  $
          tcIfaceExtId name

775
    vectTyConVectMapping vars name
776
      = do { vName  <- lookupIfaceTop (mkLocalisedOccName mod mkVectTyConOcc name)
777 778 779 780 781 782 783
           ; vectTyConMapping vars name vName
           }

    vectTyConReuseMapping vars name
      = vectTyConMapping vars name name

    vectTyConMapping vars name vName
784
      = do { tycon  <-