TcIface.hs 84.5 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
{-# LANGUAGE NondecreasingIndentation #-}
11

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

23 24
#include "HsVersions.h"

25 26
import GhcPrelude

27
import TcTypeNats(typeNatCoAxiomRules)
28
import IfaceSyn
Simon Marlow's avatar
Simon Marlow committed
29 30 31
import LoadIface
import IfaceEnv
import BuildTyCl
32
import TcRnMonad
33
import TcType
Simon Marlow's avatar
Simon Marlow committed
34
import Type
35 36 37
import Coercion
import CoAxiom
import TyCoRep    -- needs to build types & coercions in a knot
Simon Marlow's avatar
Simon Marlow committed
38
import HscTypes
39
import Annotations
Simon Marlow's avatar
Simon Marlow committed
40 41
import InstEnv
import FamInstEnv
42
import CoreSyn
Simon Marlow's avatar
Simon Marlow committed
43
import CoreUtils
44
import CoreUnfold
Simon Marlow's avatar
Simon Marlow committed
45
import CoreLint
46
import MkCore
Simon Marlow's avatar
Simon Marlow committed
47 48 49 50 51
import Id
import MkId
import IdInfo
import Class
import TyCon
Gergő Érdi's avatar
Gergő Érdi committed
52
import ConLike
Simon Marlow's avatar
Simon Marlow committed
53
import DataCon
54
import PrelNames
Simon Marlow's avatar
Simon Marlow committed
55
import TysWiredIn
56
import Literal
57
import Var
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
58
import VarEnv
59
import VarSet
Simon Marlow's avatar
Simon Marlow committed
60
import Name
61
import NameEnv
62 63
import NameSet
import OccurAnal        ( occurAnalyseExpr )
64
import Demand
Simon Marlow's avatar
Simon Marlow committed
65
import Module
66
import UniqFM
Simon Marlow's avatar
Simon Marlow committed
67
import UniqSupply
Simon Peyton Jones's avatar
Simon Peyton Jones committed
68
import Outputable
Simon Marlow's avatar
Simon Marlow committed
69 70 71
import Maybes
import SrcLoc
import DynFlags
Ian Lynagh's avatar
Ian Lynagh committed
72
import Util
73
import FastString
74 75
import BasicTypes hiding ( SuccessFlag(..) )
import ListSetOps
Edward Z. Yang's avatar
Edward Z. Yang committed
76
import GHC.Fingerprint
77
import qualified BooleanFormula as BF
Simon Marlow's avatar
Simon Marlow committed
78

Adam Gundry's avatar
Adam Gundry committed
79
import Data.List
80
import Control.Monad
81
import qualified Data.Map as Map
82

Austin Seipp's avatar
Austin Seipp committed
83
{-
84 85
This module takes

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
86 87 88
        IfaceDecl -> TyThing
        IfaceType -> Type
        etc
89 90 91 92

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

103

Austin Seipp's avatar
Austin Seipp committed
104 105
************************************************************************
*                                                                      *
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
106
                Type-checking a complete interface
Austin Seipp's avatar
Austin Seipp committed
107 108
*                                                                      *
************************************************************************
109

110 111 112 113 114 115 116
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.
117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149

Note [Knot-tying typecheckIface]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Suppose we are typechecking an interface A.hi, and we come across
a Name for another entity defined in A.hi.  How do we get the
'TyCon', in this case?  There are three cases:

    1) tcHiBootIface in TcIface: We're typechecking an hi-boot file in
    preparation of checking if the hs file we're building
    is compatible.  In this case, we want all of the internal
    TyCons to MATCH the ones that we just constructed during
    typechecking: the knot is thus tied through if_rec_types.

    2) retypecheckLoop in GhcMake: We are retypechecking a
    mutually recursive cluster of hi files, in order to ensure
    that all of the references refer to each other correctly.
    In this case, the knot is tied through the HPT passed in,
    which contains all of the interfaces we are in the process
    of typechecking.

    3) genModDetails in HscMain: We are typechecking an
    old interface to generate the ModDetails.  In this case,
    we do the same thing as (2) and pass in an HPT with
    the HomeModInfo being generated to tie knots.

The upshot is that the CLIENT of this function is responsible
for making sure that the knot is tied correctly.  If you don't,
then you'll get a message saying that we couldn't load the
declaration you wanted.

BTW, in one-shot mode we never call typecheckIface; instead,
loadInterface handles type-checking interface.  In that case,
knots are tied through the EPS.  No problem!
Austin Seipp's avatar
Austin Seipp committed
150
-}
151

152
-- Clients of this function be careful, see Note [Knot-tying typecheckIface]
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
153
typecheckIface :: ModIface      -- Get the decls from here
154
               -> IfG ModDetails
155
typecheckIface iface
Edward Z. Yang's avatar
Edward Z. Yang committed
156
  = initIfaceLcl (mi_semantic_module iface) (text "typecheckIface") (mi_boot iface) $ do
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
157 158 159
        {       -- 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
160
                -- 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
161
                -- to handle unboxed tuples, so it must not see unfoldings.
ian@well-typed.com's avatar
ian@well-typed.com committed
162
          ignore_prags <- goptM Opt_IgnoreInterfacePragmas
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
163 164

                -- Typecheck the decls.  This is done lazily, so that the knot-tying
165 166
                -- within this single module works out right.  It's the callers
                -- job to make sure the knot is tied.
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
167 168 169 170 171 172 173 174
        ; names_w_things <- loadDecls ignore_prags (mi_decls iface)
        ; let type_env = mkNameEnv names_w_things

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

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
176
                -- Vectorisation information
Edward Z. Yang's avatar
Edward Z. Yang committed
177
        ; vect_info <- tcIfaceVectInfo (mi_semantic_module iface) type_env (mi_vect_info iface)
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
178

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
179 180 181
                -- Exports
        ; exports <- ifaceExportNames (mi_exports iface)

182 183 184
                -- Complete Sigs
        ; complete_sigs <- tcIfaceCompleteSigs (mi_complete_sigs iface)

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
185 186
                -- Finished
        ; traceIf (vcat [text "Finished typechecking interface for" <+> ppr (mi_module iface),
187 188 189 190
                         -- Careful! If we tug on the TyThing thunks too early
                         -- we'll infinite loop with hs-boot.  See #10083 for
                         -- an example where this would cause non-termination.
                         text "Type envt:" <+> ppr (map fst names_w_things)])
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
191 192 193 194 195
        ; 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
196
                              , md_vect_info = vect_info
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
197
                              , md_exports   = exports
198
                              , md_complete_sigs = complete_sigs
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
199
                              }
200
    }
201

Edward Z. Yang's avatar
Edward Z. Yang committed
202 203 204 205 206 207 208 209 210 211
{-
************************************************************************
*                                                                      *
                Typechecking for merging
*                                                                      *
************************************************************************
-}

-- | Returns true if an 'IfaceDecl' is for @data T@ (an abstract data type)
isAbstractIfaceDecl :: IfaceDecl -> Bool
212
isAbstractIfaceDecl IfaceData{ ifCons = IfAbstractTyCon } = True
213
isAbstractIfaceDecl IfaceClass{ ifBody = IfAbstractClass } = True
214
isAbstractIfaceDecl IfaceFamily{ ifFamFlav = IfaceAbstractClosedSynFamilyTyCon } = True
Edward Z. Yang's avatar
Edward Z. Yang committed
215 216
isAbstractIfaceDecl _ = False

217 218 219 220 221 222
ifMaybeRoles :: IfaceDecl -> Maybe [Role]
ifMaybeRoles IfaceData    { ifRoles = rs } = Just rs
ifMaybeRoles IfaceSynonym { ifRoles = rs } = Just rs
ifMaybeRoles IfaceClass   { ifRoles = rs } = Just rs
ifMaybeRoles _ = Nothing

Edward Z. Yang's avatar
Edward Z. Yang committed
223 224 225 226 227
-- | Merge two 'IfaceDecl's together, preferring a non-abstract one.  If
-- both are non-abstract we pick one arbitrarily (and check for consistency
-- later.)
mergeIfaceDecl :: IfaceDecl -> IfaceDecl -> IfaceDecl
mergeIfaceDecl d1 d2
228 229
    | isAbstractIfaceDecl d1 = d2 `withRolesFrom` d1
    | isAbstractIfaceDecl d2 = d1 `withRolesFrom` d2
230 231
    | IfaceClass{ ifBody = IfConcreteClass { ifSigs = ops1, ifMinDef = bf1 } } <- d1
    , IfaceClass{ ifBody = IfConcreteClass { ifSigs = ops2, ifMinDef = bf2 } } <- d2
232 233 234 235
    = let ops = nameEnvElts $
                  plusNameEnv_C mergeIfaceClassOp
                    (mkNameEnv [ (n, op) | op@(IfaceClassOp n _ _) <- ops1 ])
                    (mkNameEnv [ (n, op) | op@(IfaceClassOp n _ _) <- ops2 ])
236 237 238 239
      in d1 { ifBody = (ifBody d1) {
                ifSigs  = ops,
                ifMinDef = BF.mkOr [noLoc bf1, noLoc bf2]
                }
240
            } `withRolesFrom` d2
Edward Z. Yang's avatar
Edward Z. Yang committed
241 242
    -- It doesn't matter; we'll check for consistency later when
    -- we merge, see 'mergeSignatures'
243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259
    | otherwise              = d1 `withRolesFrom` d2

-- Note [Role merging]
-- ~~~~~~~~~~~~~~~~~~~
-- First, why might it be necessary to do a non-trivial role
-- merge?  It may rescue a merge that might otherwise fail:
--
--      signature A where
--          type role T nominal representational
--          data T a b
--
--      signature A where
--          type role T representational nominal
--          data T a b
--
-- A module that defines T as representational in both arguments
-- would successfully fill both signatures, so it would be better
Gabor Greif's avatar
Gabor Greif committed
260
-- if we merged the roles of these types in some nontrivial
261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282
-- way.
--
-- However, we have to be very careful about how we go about
-- doing this, because role subtyping is *conditional* on
-- the supertype being NOT representationally injective, e.g.,
-- if we have instead:
--
--      signature A where
--          type role T nominal representational
--          data T a b = T a b
--
--      signature A where
--          type role T representational nominal
--          data T a b = T a b
--
-- Should we merge the definitions of T so that the roles are R/R (or N/N)?
-- Absolutely not: neither resulting type is a subtype of the original
-- types (see Note [Role subtyping]), because data is not representationally
-- injective.
--
-- Thus, merging only occurs when BOTH TyCons in question are
-- representationally injective.  If they're not, no merge.
283 284 285 286 287

withRolesFrom :: IfaceDecl -> IfaceDecl -> IfaceDecl
d1 `withRolesFrom` d2
    | Just roles1 <- ifMaybeRoles d1
    , Just roles2 <- ifMaybeRoles d2
288
    , not (isRepInjectiveIfaceDecl d1 || isRepInjectiveIfaceDecl d2)
289 290 291 292
    = d1 { ifRoles = mergeRoles roles1 roles2 }
    | otherwise = d1
  where
    mergeRoles roles1 roles2 = zipWith max roles1 roles2
Edward Z. Yang's avatar
Edward Z. Yang committed
293

294 295 296 297 298
isRepInjectiveIfaceDecl :: IfaceDecl -> Bool
isRepInjectiveIfaceDecl IfaceData{ ifCons = IfDataTyCon _ } = True
isRepInjectiveIfaceDecl IfaceFamily{ ifFamFlav = IfaceDataFamilyTyCon } = True
isRepInjectiveIfaceDecl _ = False

299 300 301 302
mergeIfaceClassOp :: IfaceClassOp -> IfaceClassOp -> IfaceClassOp
mergeIfaceClassOp op1@(IfaceClassOp _ _ (Just _)) _ = op1
mergeIfaceClassOp _ op2 = op2

Edward Z. Yang's avatar
Edward Z. Yang committed
303 304 305 306 307 308 309 310 311 312 313
-- | Merge two 'OccEnv's of 'IfaceDecl's by 'OccName'.
mergeIfaceDecls :: OccEnv IfaceDecl -> OccEnv IfaceDecl -> OccEnv IfaceDecl
mergeIfaceDecls = plusOccEnv_C mergeIfaceDecl

-- | This is a very interesting function.  Like typecheckIface, we want
-- to type check an interface file into a ModDetails.  However, the use-case
-- for these ModDetails is different: we want to compare all of the
-- ModDetails to ensure they define compatible declarations, and then
-- merge them together.  So in particular, we have to take a different
-- strategy for knot-tying: we first speculatively merge the declarations
-- to get the "base" truth for what we believe the types will be
314 315
-- (this is "type computation.")  Then we read everything in relative
-- to this truth and check for compatibility.
Edward Z. Yang's avatar
Edward Z. Yang committed
316
--
317 318 319 320 321 322 323 324 325 326 327
-- During the merge process, we may need to nondeterministically
-- pick a particular declaration to use, if multiple signatures define
-- the declaration ('mergeIfaceDecl').  If, for all choices, there
-- are no type synonym cycles in the resulting merged graph, then
-- we can show that our choice cannot matter. Consider the
-- set of entities which the declarations depend on: by assumption
-- of acyclicity, we can assume that these have already been shown to be equal
-- to each other (otherwise merging will fail).  Then it must
-- be the case that all candidate declarations here are type-equal
-- (the choice doesn't matter) or there is an inequality (in which
-- case merging will fail.)
Edward Z. Yang's avatar
Edward Z. Yang committed
328
--
329 330
-- Unfortunately, the choice can matter if there is a cycle.  Consider the
-- following merge:
Edward Z. Yang's avatar
Edward Z. Yang committed
331
--
332 333
--      signature H where { type A = C;  type B = A; data C      }
--      signature H where { type A = (); data B;     type C = B  }
Edward Z. Yang's avatar
Edward Z. Yang committed
334
--
335 336 337 338 339 340 341
-- If we pick @type A = C@ as our representative, there will be
-- a cycle and merging will fail. But if we pick @type A = ()@ as
-- our representative, no cycle occurs, and we instead conclude
-- that all of the types are unit.  So it seems that we either
-- (a) need a stronger acyclicity check which considers *all*
-- possible choices from a merge, or (b) we must find a selection
-- of declarations which is acyclic, and show that this is always
342
-- the "best" choice we could have made (ezyang conjectures this
343 344
-- is the case but does not have a proof).  For now this is
-- not implemented.
Edward Z. Yang's avatar
Edward Z. Yang committed
345
--
346 347
-- It's worth noting that at the moment, a data constructor and a
-- type synonym are never compatible.  Consider:
Edward Z. Yang's avatar
Edward Z. Yang committed
348
--
349 350
--      signature H where { type Int=C;         type B = Int; data C = Int}
--      signature H where { export Prelude.Int; data B;       type C = B; }
Edward Z. Yang's avatar
Edward Z. Yang committed
351
--
352 353 354 355 356
-- This will be rejected, because the reexported Int in the second
-- signature (a proper data type) is never considered equal to a
-- type synonym.  Perhaps this should be relaxed, where a type synonym
-- in a signature is considered implemented by a data type declaration
-- which matches the reference of the type synonym.
Edward Z. Yang's avatar
Edward Z. Yang committed
357 358 359 360 361 362 363
typecheckIfacesForMerging :: Module -> [ModIface] -> IORef TypeEnv -> IfM lcl (TypeEnv, [ModDetails])
typecheckIfacesForMerging mod ifaces tc_env_var =
  -- cannot be boot (False)
  initIfaceLcl mod (text "typecheckIfacesForMerging") False $ do
    ignore_prags <- goptM Opt_IgnoreInterfacePragmas
    -- Build the initial environment
    -- NB: Don't include dfuns here, because we don't want to
364 365
    -- serialize them out.  See Note [rnIfaceNeverExported] in RnModIface
    -- NB: But coercions are OK, because they will have the right OccName.
Edward Z. Yang's avatar
Edward Z. Yang committed
366
    let mk_decl_env decls
367
            = mkOccEnv [ (getOccName decl, decl)
Edward Z. Yang's avatar
Edward Z. Yang committed
368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383
                       | decl <- decls
                       , case decl of
                            IfaceId { ifIdDetails = IfDFunId } -> False -- exclude DFuns
                            _ -> True ]
        decl_envs = map (mk_decl_env . map snd . mi_decls) ifaces
                        :: [OccEnv IfaceDecl]
        decl_env = foldl' mergeIfaceDecls emptyOccEnv decl_envs
                        ::  OccEnv IfaceDecl
    -- TODO: change loadDecls to accept w/o Fingerprint
    names_w_things <- loadDecls ignore_prags (map (\x -> (fingerprint0, x))
                                                  (occEnvElts decl_env))
    let global_type_env = mkNameEnv names_w_things
    writeMutVar tc_env_var global_type_env

    -- OK, now typecheck each ModIface using this environment
    details <- forM ifaces $ \iface -> do
384
        -- See Note [Resolving never-exported Names in TcIface]
385 386 387 388
        type_env <- fixM $ \type_env -> do
            setImplicitEnvM type_env $ do
                decls <- loadDecls ignore_prags (mi_decls iface)
                return (mkNameEnv decls)
Edward Z. Yang's avatar
Edward Z. Yang committed
389 390
        -- But note that we use this type_env to typecheck references to DFun
        -- in 'IfaceInst'
391 392
        setImplicitEnvM type_env $ do
        insts     <- mapM tcIfaceInst (mi_insts iface)
Edward Z. Yang's avatar
Edward Z. Yang committed
393 394 395 396 397
        fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface)
        rules     <- tcIfaceRules ignore_prags (mi_rules iface)
        anns      <- tcIfaceAnnotations (mi_anns iface)
        vect_info <- tcIfaceVectInfo (mi_semantic_module iface) type_env (mi_vect_info iface)
        exports   <- ifaceExportNames (mi_exports iface)
398
        complete_sigs <- tcIfaceCompleteSigs (mi_complete_sigs iface)
Edward Z. Yang's avatar
Edward Z. Yang committed
399 400 401 402 403 404 405
        return $ ModDetails { md_types     = type_env
                            , md_insts     = insts
                            , md_fam_insts = fam_insts
                            , md_rules     = rules
                            , md_anns      = anns
                            , md_vect_info = vect_info
                            , md_exports   = exports
406
                            , md_complete_sigs = complete_sigs
Edward Z. Yang's avatar
Edward Z. Yang committed
407 408 409 410 411 412 413 414 415 416 417 418
                            }
    return (global_type_env, details)

-- | Typecheck a signature 'ModIface' under the assumption that we have
-- instantiated it under some implementation (recorded in 'mi_semantic_module')
-- and want to check if the implementation fills the signature.
--
-- This needs to operate slightly differently than 'typecheckIface'
-- because (1) we have a 'NameShape', from the exports of the
-- implementing module, which we will use to give our top-level
-- declarations the correct 'Name's even when the implementor
-- provided them with a reexport, and (2) we have to deal with
419
-- DFun silliness (see Note [rnIfaceNeverExported])
Edward Z. Yang's avatar
Edward Z. Yang committed
420 421 422 423 424 425
typecheckIfaceForInstantiate :: NameShape -> ModIface -> IfM lcl ModDetails
typecheckIfaceForInstantiate nsubst iface =
  initIfaceLclWithSubst (mi_semantic_module iface)
                        (text "typecheckIfaceForInstantiate")
                        (mi_boot iface) nsubst $ do
    ignore_prags <- goptM Opt_IgnoreInterfacePragmas
426
    -- See Note [Resolving never-exported Names in TcIface]
427 428 429 430
    type_env <- fixM $ \type_env -> do
        setImplicitEnvM type_env $ do
            decls     <- loadDecls ignore_prags (mi_decls iface)
            return (mkNameEnv decls)
431
    -- See Note [rnIfaceNeverExported]
432 433
    setImplicitEnvM type_env $ do
    insts     <- mapM tcIfaceInst (mi_insts iface)
Edward Z. Yang's avatar
Edward Z. Yang committed
434 435 436 437 438
    fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface)
    rules     <- tcIfaceRules ignore_prags (mi_rules iface)
    anns      <- tcIfaceAnnotations (mi_anns iface)
    vect_info <- tcIfaceVectInfo (mi_semantic_module iface) type_env (mi_vect_info iface)
    exports   <- ifaceExportNames (mi_exports iface)
439
    complete_sigs <- tcIfaceCompleteSigs (mi_complete_sigs iface)
Edward Z. Yang's avatar
Edward Z. Yang committed
440 441 442 443 444 445 446
    return $ ModDetails { md_types     = type_env
                        , md_insts     = insts
                        , md_fam_insts = fam_insts
                        , md_rules     = rules
                        , md_anns      = anns
                        , md_vect_info = vect_info
                        , md_exports   = exports
447
                        , md_complete_sigs = complete_sigs
Edward Z. Yang's avatar
Edward Z. Yang committed
448 449
                        }

450 451 452 453 454
-- Note [Resolving never-exported Names in TcIface]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- For the high-level overview, see
-- Note [Handling never-exported TyThings under Backpack]
--
455 456 457 458 459 460
-- As described in 'typecheckIfacesForMerging', the splendid innovation
-- of signature merging is to rewrite all Names in each of the signatures
-- we are merging together to a pre-merged structure; this is the key
-- ingredient that lets us solve some problems when merging type
-- synonyms.
--
461 462 463 464 465 466 467 468 469
-- However, when a 'Name' refers to a NON-exported entity, as is the
-- case with the DFun of a ClsInst, or a CoAxiom of a type family,
-- this strategy causes problems: if we pick one and rewrite all
-- references to a shared 'Name', we will accidentally fail to check
-- if the DFun or CoAxioms are compatible, as they will never be
-- checked--only exported entities are checked for compatibility,
-- and a non-exported TyThing is checked WHEN we are checking the
-- ClsInst or type family for compatibility in checkBootDeclM.
-- By virtue of the fact that everything's been pointed to the merged
470 471 472
-- declaration, you'll never notice there's a difference even if there
-- is one.
--
473 474 475 476
-- Fortunately, there are only a few places in the interface declarations
-- where this can occur, so we replace those calls with 'tcIfaceImplicit',
-- which will consult a local TypeEnv that records any never-exported
-- TyThings which we should wire up with.
477
--
478 479 480 481
-- Note that we actually knot-tie this local TypeEnv (the 'fixM'), because a
-- type family can refer to a coercion axiom, all of which are done in one go
-- when we typecheck 'mi_decls'.  An alternate strategy would be to typecheck
-- coercions first before type families, but that seemed more fragile.
482 483
--

Austin Seipp's avatar
Austin Seipp committed
484 485 486
{-
************************************************************************
*                                                                      *
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
487
                Type and class declarations
Austin Seipp's avatar
Austin Seipp committed
488 489 490
*                                                                      *
************************************************************************
-}
491

Simon Peyton Jones's avatar
Simon Peyton Jones committed
492
tcHiBootIface :: HscSource -> Module -> TcRn SelfBootInfo
493 494
-- 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
495
-- Return the ModDetails; Nothing if no hi-boot iface
496
tcHiBootIface hsc_src mod
497
  | HsBootFile <- hsc_src            -- Already compiling a hs-boot file
Simon Peyton Jones's avatar
Simon Peyton Jones committed
498
  = return NoSelfBoot
499
  | otherwise
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
500 501 502 503 504 505
  = 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
506
                --
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
507 508
                -- 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
509
                -- compile a module in TypecheckOnly mode, with a stable,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
510 511
                -- 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
512
                -- 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
513 514
                -- it's been compiled once, and we don't need to check the boot iface
          then do { hpt <- getHpt
niteria's avatar
niteria committed
515
                 ; case lookupHpt hpt (moduleName mod) of
Simon Peyton Jones's avatar
Simon Peyton Jones committed
516
                      Just info | mi_boot (hm_iface info)
517
                                -> mkSelfBootInfo (hm_iface info) (hm_details info)
Simon Peyton Jones's avatar
Simon Peyton Jones committed
518
                      _ -> return NoSelfBoot }
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
519 520
          else do

Simon Peyton Jones's avatar
Simon Peyton Jones committed
521
        -- OK, so we're in one-shot mode.
522 523 524 525
        -- 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
526
                                need (fst (splitModuleInsts mod)) mod
527
                                True    -- Hi-boot file
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
528

529
        ; case read_result of {
530
            Succeeded (iface, _path) -> do { tc_iface <- initIfaceTcRn $ typecheckIface iface
531
                                           ; mkSelfBootInfo iface tc_iface } ;
Simon Peyton Jones's avatar
Simon Peyton Jones committed
532
            Failed err               ->
533 534 535 536 537 538 539 540 541 542

        -- 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
543
            Nothing -> return NoSelfBoot -- The typical case
544 545

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

549 550
            Just (_mod, True) -> failWithTc (elaborate err)
                -- The hi-boot file has mysteriously disappeared.
551
    }}}}
552
  where
553 554
    need = text "Need the hi-boot interface for" <+> ppr mod
                 <+> text "to compare against the Real Thing"
555

556 557
    moduleLoop = text "Circular imports: module" <+> quotes (ppr mod)
                     <+> text "depends on itself"
558

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

Simon Peyton Jones's avatar
Simon Peyton Jones committed
562

563 564 565 566 567
mkSelfBootInfo :: ModIface -> ModDetails -> TcRn SelfBootInfo
mkSelfBootInfo iface mds
  = do -- NB: This is computed DIRECTLY from the ModIface rather
       -- than from the ModDetails, so that we can query 'sb_tcs'
       -- WITHOUT forcing the contents of the interface.
568 569 570 571
       let tcs = map ifName
                 . filter isIfaceTyCon
                 . map snd
                 $ mi_decls iface
572 573
       return $ SelfBoot { sb_mds = mds
                         , sb_tcs = mkNameSet tcs }
Simon Peyton Jones's avatar
Simon Peyton Jones committed
574
  where
575 576 577 578 579 580 581 582 583 584
    -- | Retuerns @True@ if, when you call 'tcIfaceDecl' on
    -- this 'IfaceDecl', an ATyCon would be returned.
    -- NB: This code assumes that a TyCon cannot be implicit.
    isIfaceTyCon IfaceId{}      = False
    isIfaceTyCon IfaceData{}    = True
    isIfaceTyCon IfaceSynonym{} = True
    isIfaceTyCon IfaceFamily{}  = True
    isIfaceTyCon IfaceClass{}   = True
    isIfaceTyCon IfaceAxiom{}   = False
    isIfaceTyCon IfacePatSyn{}  = False
Simon Peyton Jones's avatar
Simon Peyton Jones committed
585

Austin Seipp's avatar
Austin Seipp committed
586 587 588
{-
************************************************************************
*                                                                      *
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
589
                Type and class declarations
Austin Seipp's avatar
Austin Seipp committed
590 591
*                                                                      *
************************************************************************
592 593 594 595 596 597

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
598
E.g.
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
599
        data Foo.S = MkS Baz.T
600
Maybe we can get away without even loading the interface for Baz!
601 602

This is not just a performance thing.  Suppose we have
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
603 604
        data Foo.S = MkS Baz.T
        data Baz.T = MkT Foo.S
605
(in different interface files, of course).
Simon Peyton Jones's avatar
Simon Peyton Jones committed
606
Now, first we load and typecheck Foo.S, and add it to the type envt.
607
If we do explore MkS's argument, we'll load and typecheck Baz.T.
Simon Peyton Jones's avatar
Simon Peyton Jones committed
608
If we explore MkT's argument we'll find Foo.S already in the envt.
609 610 611 612 613 614 615 616 617 618 619

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
620 621 622
        * 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
623

624
Now we look something up in the type envt
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
625 626 627
        * that pulls on <t>
        * which reads the global type envt out of the global EPS mutvar
        * but that depends in turn on <t>
628

Simon Peyton Jones's avatar
Simon Peyton Jones committed
629
It's subtle, because, it'd work fine if we typechecked the constructor args
630 631 632 633 634
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
635
-}
636

637
tcIfaceDecl :: Bool     -- ^ True <=> discard IdInfo on IfaceId bindings
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
638 639
            -> IfaceDecl
            -> IfL TyThing
640
tcIfaceDecl = tc_iface_decl Nothing
641

642 643
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
644 645
              -> IfaceDecl
              -> IfL TyThing
646
tc_iface_decl _ ignore_prags (IfaceId {ifName = name, ifType = iface_type,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
647
                                       ifIdDetails = details, ifIdInfo = info})
648
  = do  { ty <- tcIfaceType iface_type
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
649
        ; details <- tcIdDetails ty details
650
        ; info <- tcIdInfo ignore_prags TopLevel name ty info
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
651
        ; return (AnId (mkGlobalId details name ty info)) }
652

653
tc_iface_decl _ _ (IfaceData {ifName = tc_name,
Simon Peyton Jones's avatar
Simon Peyton Jones committed
654
                          ifCType = cType,
655 656
                          ifBinders = binders,
                          ifResKind = res_kind,
657
                          ifRoles = roles,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
658
                          ifCtxt = ctxt, ifGadtSyntax = gadt_syn,
Simon Peyton Jones's avatar
Simon Peyton Jones committed
659
                          ifCons = rdr_cons,
Edward Z. Yang's avatar
Edward Z. Yang committed
660
                          ifParent = mb_parent })
661
  = bindIfaceTyConBinders_AT binders $ \ binders' -> do
662
    { res_kind' <- tcIfaceType res_kind
663

664
    ; tycon <- fixM $ \ tycon -> do
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
665
            { stupid_theta <- tcIfaceCtxt ctxt
666
            ; parent' <- tc_parent tc_name mb_parent
667 668 669
            ; cons <- tcIfaceDataCons tc_name tycon binders' rdr_cons
            ; return (mkAlgTyCon tc_name binders' res_kind'
                                 roles cType stupid_theta
Edward Z. Yang's avatar
Edward Z. Yang committed
670
                                 cons parent' gadt_syn) }
671 672
    ; traceIf (text "tcIfaceDecl4" <+> ppr tycon)
    ; return (ATyCon tycon) }
673
  where
674 675 676 677 678 679
    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
680
           ; let fam_tc  = coAxiomTyCon ax
681
                 ax_unbr = toUnbranchedAxiom ax
682
           ; lhs_tys <- tcIfaceTcArgs arg_tys
683
           ; return (DataFamInstTyCon ax_unbr fam_tc lhs_tys) }
684

685
tc_iface_decl _ _ (IfaceSynonym {ifName = tc_name,
686 687
                                      ifRoles = roles,
                                      ifSynRhs = rhs_ty,
688 689
                                      ifBinders = binders,
                                      ifResKind = res_kind })
690
   = bindIfaceTyConBinders_AT binders $ \ binders' -> do
691
     { res_kind' <- tcIfaceType res_kind     -- Note [Synonym kind loop]
Simon Peyton Jones's avatar
Simon Peyton Jones committed
692
     ; rhs      <- forkM (mk_doc tc_name) $
693
                   tcIfaceType rhs_ty
694
     ; let tycon = buildSynTyCon tc_name binders' res_kind' roles rhs
695
     ; return (ATyCon tycon) }
696
   where
697
     mk_doc n = text "Type synonym" <+> ppr n
698

699
tc_iface_decl parent _ (IfaceFamily {ifName = tc_name,
700
                                     ifFamFlav = fam_flav,
701 702
                                     ifBinders = binders,
                                     ifResKind = res_kind,
Jan Stolarek's avatar
Jan Stolarek committed
703
                                     ifResVar = res, ifFamInj = inj })
704
   = bindIfaceTyConBinders_AT binders $ \ binders' -> do
705
     { res_kind' <- tcIfaceType res_kind    -- Note [Synonym kind loop]
706
     ; rhs      <- forkM (mk_doc tc_name) $
707
                   tc_fam_flav tc_name fam_flav
Jan Stolarek's avatar
Jan Stolarek committed
708
     ; res_name <- traverse (newIfaceName . mkTyVarOccFS) res
709
     ; let tycon = mkFamilyTyCon tc_name binders' res_kind' res_name rhs parent inj
710 711
     ; return (ATyCon tycon) }
   where
712
     mk_doc n = text "Type synonym" <+> ppr n
713 714 715 716 717 718 719

     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)
720
       = do { ax <- traverse (tcIfaceCoAxiom . fst) mb_ax_name_branches
721
            ; return (ClosedSynFamilyTyCon ax) }
722
     tc_fam_flav _ IfaceAbstractClosedSynFamilyTyCon
723
         = return AbstractClosedSynFamilyTyCon
724
     tc_fam_flav _ IfaceBuiltInSynFamTyCon
725 726
         = pprPanic "tc_iface_decl"
                    (text "IfaceBuiltInSynFamTyCon in interface file")
727

728 729 730 731 732 733 734 735 736 737 738
tc_iface_decl _parent _ignore_prags
            (IfaceClass {ifName = tc_name,
                         ifRoles = roles,
                         ifBinders = binders,
                         ifFDs = rdr_fds,
                         ifBody = IfAbstractClass})
  = bindIfaceTyConBinders binders $ \ binders' -> do
    { fds  <- mapM tc_fd rdr_fds
    ; cls  <- buildClass tc_name binders' roles fds Nothing
    ; return (ATyCon (classTyCon cls)) }

739
tc_iface_decl _parent ignore_prags
740
            (IfaceClass {ifName = tc_name,
741 742
                         ifRoles = roles,
                         ifBinders = binders,
743
                         ifFDs = rdr_fds,
744 745 746 747 748
                         ifBody = IfConcreteClass {
                             ifClassCtxt = rdr_ctxt,
                             ifATs = rdr_ats, ifSigs = rdr_sigs,
                             ifMinDef = mindef_occ
                         }})
749
  = bindIfaceTyConBinders binders $ \ binders' -> do
750
    { traceIf (text "tc-iface-class1" <+> ppr tc_name)
751
    ; ctxt <- mapM tc_sc rdr_ctxt
752
    ; traceIf (text "tc-iface-class2" <+> ppr tc_name)
753 754
    ; sigs <- mapM tc_sig rdr_sigs
    ; fds  <- mapM tc_fd rdr_fds
755
    ; traceIf (text "tc-iface-class3" <+> ppr tc_name)
756
    ; mindef <- traverse (lookupIfaceTop . mkVarOccFS) mindef_occ
757
    ; cls  <- fixM $ \ cls -> do
758
              { ats  <- mapM (tc_at cls) rdr_ats
759
              ; traceIf (text "tc-iface-class4" <+> ppr tc_name)
760
              ; buildClass tc_name binders' roles fds (Just (ctxt, ats, sigs, mindef)) }
batterseapower's avatar
batterseapower committed
761
    ; return (ATyCon (classTyCon cls)) }
762
  where
763 764 765 766 767 768 769 770 771
   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

772
   tc_sig :: IfaceClassOp -> IfL TcMethInfo
773 774
   tc_sig (IfaceClassOp op_name rdr_ty dm)
     = do { let doc = mk_op_doc op_name rdr_ty
775
          ; op_ty <- forkM (doc <+> text "ty") $ tcIfaceType rdr_ty
Simon Peyton Jones's avatar
Simon Peyton Jones committed
776
                -- Must be done lazily for just the same reason as the
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
777
                -- type of a data con; to avoid sucking in types that
778
                -- it mentions unless it's necessary to do so
779
          ; dm'   <- tc_dm doc dm
780 781
          ; return (op_name, op_ty, dm') }

782 783
   tc_dm :: SDoc
         -> Maybe (DefMethSpec IfaceType)
784
         -> IfL (Maybe (DefMethSpec (SrcSpan, Type)))
785 786 787 788 789
   tc_dm _   Nothing               = return Nothing
   tc_dm _   (Just VanillaDM)      = return (Just VanillaDM)
   tc_dm doc (Just (GenericDM ty))
        = do { -- Must be done lazily to avoid sucking in types
             ; ty' <- forkM (doc <+> text "dm") $ tcIfaceType ty
790
             ; return (Just (GenericDM (noSrcSpan, ty'))) }
791

792
   tc_at cls (IfaceAT tc_decl if_def)
793
     = do ATyCon tc <- tc_iface_decl (Just cls) ignore_prags tc_decl
794 795 796 797 798
          mb_def <- case if_def of
                      Nothing  -> return Nothing
                      Just def -> forkM (mk_at_doc tc)                 $
                                  extendIfaceTyVarEnv (tyConTyVars tc) $
                                  do { tc_def <- tcIfaceType def
799
                                     ; return (Just (tc_def, noSrcSpan)) }
800 801 802
                  -- 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
803
          return (ATI tc mb_def)
804

805 806 807
   mk_sc_doc pred = text "Superclass" <+> ppr pred
   mk_at_doc tc = text "Associated type" <+> ppr tc
   mk_op_doc op_name op_ty = text "Class op" <+> sep [ppr op_name, ppr op_ty]
808

809
tc_iface_decl _ _ (IfaceAxiom { ifName = tc_name, ifTyCon = tc
810
                              , ifAxBranches = branches, ifRole = role })
811
  = do { tc_tycon    <- tcIfaceTyCon tc
812 813 814 815 816 817 818 819
       -- Must be done lazily, because axioms are forced when checking
       -- for family instance consistency, and the RHS may mention
       -- a hs-boot declared type constructor that is going to be
       -- defined by this module.
       -- e.g. type instance F Int = ToBeDefined
       -- See Trac #13803
       ; tc_branches <- forkM (text "Axiom branches" <+> ppr tc_name)
                      $ tc_ax_branches branches
820
       ; let axiom = CoAxiom { co_ax_unique   = nameUnique tc_name
821 822
                             , co_ax_name     = tc_name
                             , co_ax_tc       = tc_tycon
823
                             , co_ax_role     = role
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
824
                             , co_ax_branches = manyBranches tc_branches
825 826
                             , co_ax_implicit = False }
       ; return (ACoAxiom axiom) }
827

828
tc_iface_decl _ _ (IfacePatSyn{ ifName = name
829 830
                              , ifPatMatcher = if_matcher
                              , ifPatBuilder = if_builder
Gergő Érdi's avatar
Gergő Érdi committed
831
                              , ifPatIsInfix = is_infix
832 833
                              , ifPatUnivBndrs = univ_bndrs
                              , ifPatExBndrs = ex_bndrs
Gergő Érdi's avatar
Gergő Érdi committed
834 835 836
                              , ifPatProvCtxt = prov_ctxt
                              , ifPatReqCtxt = req_ctxt
                              , ifPatArgs = args
Matthew Pickering's avatar
Matthew Pickering committed
837 838
                              , ifPatTy = pat_ty
                              , ifFieldLabels = field_labels })
839
  = do { traceIf (text "tc_iface_decl" <+> ppr name)
840 841
       ; matcher <- tc_pr if_matcher
       ; builder <- fmapMaybeM tc_pr if_builder
Simon Peyton Jones's avatar
Simon Peyton Jones committed
842 843
       ; bindIfaceForAllBndrs univ_bndrs $ \univ_tvs -> do
       { bindIfaceForAllBndrs ex_bndrs $ \ex_tvs -> do
844
       { patsyn <- forkM (mk_doc name) $
Gergő Érdi's avatar
Gergő Érdi committed
845 846 847
             do { prov_theta <- tcIfaceCtxt prov_ctxt
                ; req_theta  <- tcIfaceCtxt req_ctxt
                ; pat_ty     <- tcIfaceType pat_ty
848
                ; arg_tys    <- mapM tcIfaceType args
849
                ; return $ buildPatSyn name is_infix matcher builder
Simon Peyton Jones's avatar
Simon Peyton Jones committed
850 851
                                       (univ_tvs, req_theta)
                                       (ex_tvs, prov_theta)
Matthew Pickering's avatar
Matthew Pickering committed
852
                                       arg_tys pat_ty field_labels }
853
       ; return $ AConLike . PatSynCon $ patsyn }}}
Gergő Érdi's avatar
Gergő Érdi committed
854
  where
855
     mk_doc n = text "Pattern synonym" <+> ppr n