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

Simon Marlow's avatar
Simon Marlow committed
5 6

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

9
{-# LANGUAGE CPP #-}
10
{-# 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
        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
58
import VarSet
Simon Marlow's avatar
Simon Marlow committed
59
import Name
60
import NameEnv
61 62
import NameSet
import OccurAnal        ( occurAnalyseExpr )
63
import Demand
Simon Marlow's avatar
Simon Marlow committed
64
import Module
65
import UniqFM
Simon Marlow's avatar
Simon Marlow committed
66
import UniqSupply
Simon Peyton Jones's avatar
Simon Peyton Jones committed
67
import Outputable
Simon Marlow's avatar
Simon Marlow committed
68 69 70
import Maybes
import SrcLoc
import DynFlags
Ian Lynagh's avatar
Ian Lynagh committed
71
import Util
72
import FastString
73 74
import BasicTypes hiding ( SuccessFlag(..) )
import ListSetOps
Edward Z. Yang's avatar
Edward Z. Yang committed
75
import GHC.Fingerprint
76
import qualified BooleanFormula as BF
Simon Marlow's avatar
Simon Marlow committed
77

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

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

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

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

102

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

109 110 111 112 113 114 115
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.
116 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

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
149
-}
150

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

                -- Typecheck the decls.  This is done lazily, so that the knot-tying
164 165
                -- 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
166 167 168 169 170 171 172 173
        ; 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)
174

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
175 176 177
                -- Exports
        ; exports <- ifaceExportNames (mi_exports iface)

178 179 180
                -- Complete Sigs
        ; complete_sigs <- tcIfaceCompleteSigs (mi_complete_sigs iface)

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
181 182
                -- Finished
        ; traceIf (vcat [text "Finished typechecking interface for" <+> ppr (mi_module iface),
183 184 185 186
                         -- 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
187 188 189 190 191 192
        ; return $ ModDetails { md_types     = type_env
                              , md_insts     = insts
                              , md_fam_insts = fam_insts
                              , md_rules     = rules
                              , md_anns      = anns
                              , md_exports   = exports
193
                              , md_complete_sigs = complete_sigs
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
194
                              }
195
    }
196

Edward Z. Yang's avatar
Edward Z. Yang committed
197 198 199 200 201 202 203 204 205 206
{-
************************************************************************
*                                                                      *
                Typechecking for merging
*                                                                      *
************************************************************************
-}

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

212 213 214 215 216 217
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
218 219 220 221 222
-- | 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
223 224
    | isAbstractIfaceDecl d1 = d2 `withRolesFrom` d1
    | isAbstractIfaceDecl d2 = d1 `withRolesFrom` d2
225 226
    | IfaceClass{ ifBody = IfConcreteClass { ifSigs = ops1, ifMinDef = bf1 } } <- d1
    , IfaceClass{ ifBody = IfConcreteClass { ifSigs = ops2, ifMinDef = bf2 } } <- d2
227 228 229 230
    = let ops = nameEnvElts $
                  plusNameEnv_C mergeIfaceClassOp
                    (mkNameEnv [ (n, op) | op@(IfaceClassOp n _ _) <- ops1 ])
                    (mkNameEnv [ (n, op) | op@(IfaceClassOp n _ _) <- ops2 ])
231 232 233 234
      in d1 { ifBody = (ifBody d1) {
                ifSigs  = ops,
                ifMinDef = BF.mkOr [noLoc bf1, noLoc bf2]
                }
235
            } `withRolesFrom` d2
Edward Z. Yang's avatar
Edward Z. Yang committed
236 237
    -- It doesn't matter; we'll check for consistency later when
    -- we merge, see 'mergeSignatures'
238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254
    | 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
255
-- if we merged the roles of these types in some nontrivial
256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277
-- 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.
278 279 280 281 282

withRolesFrom :: IfaceDecl -> IfaceDecl -> IfaceDecl
d1 `withRolesFrom` d2
    | Just roles1 <- ifMaybeRoles d1
    , Just roles2 <- ifMaybeRoles d2
283
    , not (isRepInjectiveIfaceDecl d1 || isRepInjectiveIfaceDecl d2)
284 285 286 287
    = d1 { ifRoles = mergeRoles roles1 roles2 }
    | otherwise = d1
  where
    mergeRoles roles1 roles2 = zipWith max roles1 roles2
Edward Z. Yang's avatar
Edward Z. Yang committed
288

289 290 291 292 293
isRepInjectiveIfaceDecl :: IfaceDecl -> Bool
isRepInjectiveIfaceDecl IfaceData{ ifCons = IfDataTyCon _ } = True
isRepInjectiveIfaceDecl IfaceFamily{ ifFamFlav = IfaceDataFamilyTyCon } = True
isRepInjectiveIfaceDecl _ = False

294 295 296 297
mergeIfaceClassOp :: IfaceClassOp -> IfaceClassOp -> IfaceClassOp
mergeIfaceClassOp op1@(IfaceClassOp _ _ (Just _)) _ = op1
mergeIfaceClassOp _ op2 = op2

Edward Z. Yang's avatar
Edward Z. Yang committed
298 299 300 301 302 303 304 305 306 307 308
-- | 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
309 310
-- (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
311
--
312 313 314 315 316 317 318 319 320 321 322
-- 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
323
--
324 325
-- Unfortunately, the choice can matter if there is a cycle.  Consider the
-- following merge:
Edward Z. Yang's avatar
Edward Z. Yang committed
326
--
327 328
--      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
329
--
330 331 332 333 334 335 336
-- 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
337
-- the "best" choice we could have made (ezyang conjectures this
338 339
-- is the case but does not have a proof).  For now this is
-- not implemented.
Edward Z. Yang's avatar
Edward Z. Yang committed
340
--
341 342
-- 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
343
--
344 345
--      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
346
--
347 348 349 350 351
-- 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
352 353 354 355 356 357 358
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
359 360
    -- 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
361
    let mk_decl_env decls
362
            = mkOccEnv [ (getOccName decl, decl)
Edward Z. Yang's avatar
Edward Z. Yang committed
363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378
                       | 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
379
        -- See Note [Resolving never-exported Names in TcIface]
380 381 382 383
        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
384 385
        -- But note that we use this type_env to typecheck references to DFun
        -- in 'IfaceInst'
386 387
        setImplicitEnvM type_env $ do
        insts     <- mapM tcIfaceInst (mi_insts iface)
Edward Z. Yang's avatar
Edward Z. Yang committed
388 389 390 391
        fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface)
        rules     <- tcIfaceRules ignore_prags (mi_rules iface)
        anns      <- tcIfaceAnnotations (mi_anns iface)
        exports   <- ifaceExportNames (mi_exports iface)
392
        complete_sigs <- tcIfaceCompleteSigs (mi_complete_sigs iface)
Edward Z. Yang's avatar
Edward Z. Yang committed
393 394 395 396 397 398
        return $ ModDetails { md_types     = type_env
                            , md_insts     = insts
                            , md_fam_insts = fam_insts
                            , md_rules     = rules
                            , md_anns      = anns
                            , md_exports   = exports
399
                            , md_complete_sigs = complete_sigs
Edward Z. Yang's avatar
Edward Z. Yang committed
400 401 402 403 404 405 406 407 408 409 410 411
                            }
    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
412
-- DFun silliness (see Note [rnIfaceNeverExported])
Edward Z. Yang's avatar
Edward Z. Yang committed
413 414 415 416 417 418
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
419
    -- See Note [Resolving never-exported Names in TcIface]
420 421 422 423
    type_env <- fixM $ \type_env -> do
        setImplicitEnvM type_env $ do
            decls     <- loadDecls ignore_prags (mi_decls iface)
            return (mkNameEnv decls)
424
    -- See Note [rnIfaceNeverExported]
425 426
    setImplicitEnvM type_env $ do
    insts     <- mapM tcIfaceInst (mi_insts iface)
Edward Z. Yang's avatar
Edward Z. Yang committed
427 428 429 430
    fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface)
    rules     <- tcIfaceRules ignore_prags (mi_rules iface)
    anns      <- tcIfaceAnnotations (mi_anns iface)
    exports   <- ifaceExportNames (mi_exports iface)
431
    complete_sigs <- tcIfaceCompleteSigs (mi_complete_sigs iface)
Edward Z. Yang's avatar
Edward Z. Yang committed
432 433 434 435 436 437
    return $ ModDetails { md_types     = type_env
                        , md_insts     = insts
                        , md_fam_insts = fam_insts
                        , md_rules     = rules
                        , md_anns      = anns
                        , md_exports   = exports
438
                        , md_complete_sigs = complete_sigs
Edward Z. Yang's avatar
Edward Z. Yang committed
439 440
                        }

441 442 443 444 445
-- Note [Resolving never-exported Names in TcIface]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- For the high-level overview, see
-- Note [Handling never-exported TyThings under Backpack]
--
446 447 448 449 450 451
-- 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.
--
452 453 454 455 456 457 458 459 460
-- 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
461 462 463
-- declaration, you'll never notice there's a difference even if there
-- is one.
--
464 465 466 467
-- 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.
468
--
469 470 471 472
-- 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.
473 474
--

Austin Seipp's avatar
Austin Seipp committed
475 476 477
{-
************************************************************************
*                                                                      *
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
478
                Type and class declarations
Austin Seipp's avatar
Austin Seipp committed
479 480 481
*                                                                      *
************************************************************************
-}
482

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

Simon Peyton Jones's avatar
Simon Peyton Jones committed
512
        -- OK, so we're in one-shot mode.
513 514 515 516
        -- 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
517
                                need (fst (splitModuleInsts mod)) mod
518
                                True    -- Hi-boot file
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
519

520
        ; case read_result of {
521
            Succeeded (iface, _path) -> do { tc_iface <- initIfaceTcRn $ typecheckIface iface
522
                                           ; mkSelfBootInfo iface tc_iface } ;
Simon Peyton Jones's avatar
Simon Peyton Jones committed
523
            Failed err               ->
524 525 526 527 528 529 530 531 532 533

        -- 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
534
            Nothing -> return NoSelfBoot -- The typical case
535 536

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

540 541
            Just (_mod, True) -> failWithTc (elaborate err)
                -- The hi-boot file has mysteriously disappeared.
542
    }}}}
543
  where
544 545
    need = text "Need the hi-boot interface for" <+> ppr mod
                 <+> text "to compare against the Real Thing"
546

547 548
    moduleLoop = text "Circular imports: module" <+> quotes (ppr mod)
                     <+> text "depends on itself"
549

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

Simon Peyton Jones's avatar
Simon Peyton Jones committed
553

554 555 556 557 558
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.
559 560 561 562
       let tcs = map ifName
                 . filter isIfaceTyCon
                 . map snd
                 $ mi_decls iface
563 564
       return $ SelfBoot { sb_mds = mds
                         , sb_tcs = mkNameSet tcs }
Simon Peyton Jones's avatar
Simon Peyton Jones committed
565
  where
566 567 568 569 570 571 572 573 574 575
    -- | 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
576

Austin Seipp's avatar
Austin Seipp committed
577 578 579
{-
************************************************************************
*                                                                      *
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
580
                Type and class declarations
Austin Seipp's avatar
Austin Seipp committed
581 582
*                                                                      *
************************************************************************
583 584 585 586 587 588

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

This is not just a performance thing.  Suppose we have
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
594 595
        data Foo.S = MkS Baz.T
        data Baz.T = MkT Foo.S
596
(in different interface files, of course).
Simon Peyton Jones's avatar
Simon Peyton Jones committed
597
Now, first we load and typecheck Foo.S, and add it to the type envt.
598
If we do explore MkS's argument, we'll load and typecheck Baz.T.
Simon Peyton Jones's avatar
Simon Peyton Jones committed
599
If we explore MkT's argument we'll find Foo.S already in the envt.
600 601 602 603 604 605 606 607 608 609 610

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
611 612 613
        * 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
614

615
Now we look something up in the type envt
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
616 617 618
        * that pulls on <t>
        * which reads the global type envt out of the global EPS mutvar
        * but that depends in turn on <t>
619

Simon Peyton Jones's avatar
Simon Peyton Jones committed
620
It's subtle, because, it'd work fine if we typechecked the constructor args
621 622 623 624 625
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
626
-}
627

628
tcIfaceDecl :: Bool     -- ^ True <=> discard IdInfo on IfaceId bindings
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
629 630
            -> IfaceDecl
            -> IfL TyThing
631
tcIfaceDecl = tc_iface_decl Nothing
632

633 634
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
635 636
              -> IfaceDecl
              -> IfL TyThing
637
tc_iface_decl _ ignore_prags (IfaceId {ifName = name, ifType = iface_type,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
638
                                       ifIdDetails = details, ifIdInfo = info})
639
  = do  { ty <- tcIfaceType iface_type
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
640
        ; details <- tcIdDetails ty details
641
        ; info <- tcIdInfo ignore_prags TopLevel name ty info
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
642
        ; return (AnId (mkGlobalId details name ty info)) }
643

644
tc_iface_decl _ _ (IfaceData {ifName = tc_name,
Simon Peyton Jones's avatar
Simon Peyton Jones committed
645
                          ifCType = cType,
646 647
                          ifBinders = binders,
                          ifResKind = res_kind,
648
                          ifRoles = roles,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
649
                          ifCtxt = ctxt, ifGadtSyntax = gadt_syn,
Simon Peyton Jones's avatar
Simon Peyton Jones committed
650
                          ifCons = rdr_cons,
Edward Z. Yang's avatar
Edward Z. Yang committed
651
                          ifParent = mb_parent })
652
  = bindIfaceTyConBinders_AT binders $ \ binders' -> do
653
    { res_kind' <- tcIfaceType res_kind
654

655
    ; tycon <- fixM $ \ tycon -> do
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
656
            { stupid_theta <- tcIfaceCtxt ctxt
657
            ; parent' <- tc_parent tc_name mb_parent
658 659 660
            ; 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
661
                                 cons parent' gadt_syn) }
662 663
    ; traceIf (text "tcIfaceDecl4" <+> ppr tycon)
    ; return (ATyCon tycon) }
664
  where
665 666 667 668 669 670
    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
671
           ; let fam_tc  = coAxiomTyCon ax
672
                 ax_unbr = toUnbranchedAxiom ax
673
           ; lhs_tys <- tcIfaceTcArgs arg_tys
674
           ; return (DataFamInstTyCon ax_unbr fam_tc lhs_tys) }
675

676
tc_iface_decl _ _ (IfaceSynonym {ifName = tc_name,
677 678
                                      ifRoles = roles,
                                      ifSynRhs = rhs_ty,
679 680
                                      ifBinders = binders,
                                      ifResKind = res_kind })
681
   = bindIfaceTyConBinders_AT binders $ \ binders' -> do
682
     { res_kind' <- tcIfaceType res_kind     -- Note [Synonym kind loop]
Simon Peyton Jones's avatar
Simon Peyton Jones committed
683
     ; rhs      <- forkM (mk_doc tc_name) $
684
                   tcIfaceType rhs_ty
685
     ; let tycon = buildSynTyCon tc_name binders' res_kind' roles rhs
686
     ; return (ATyCon tycon) }
687
   where
688
     mk_doc n = text "Type synonym" <+> ppr n
689

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

     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)
711
       = do { ax <- traverse (tcIfaceCoAxiom . fst) mb_ax_name_branches
712
            ; return (ClosedSynFamilyTyCon ax) }
713
     tc_fam_flav _ IfaceAbstractClosedSynFamilyTyCon
714
         = return AbstractClosedSynFamilyTyCon
715
     tc_fam_flav _ IfaceBuiltInSynFamTyCon
716 717
         = pprPanic "tc_iface_decl"
                    (text "IfaceBuiltInSynFamTyCon in interface file")
718

719 720 721 722 723 724 725 726 727 728 729
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)) }

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

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

773 774
   tc_dm :: SDoc
         -> Maybe (DefMethSpec IfaceType)
775
         -> IfL (Maybe (DefMethSpec (SrcSpan, Type)))
776 777 778 779 780
   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
781
             ; return (Just (GenericDM (noSrcSpan, ty'))) }
782

783
   tc_at cls (IfaceAT tc_decl if_def)
784
     = do ATyCon tc <- tc_iface_decl (Just cls) ignore_prags tc_decl
785 786 787 788 789
          mb_def <- case if_def of
                      Nothing  -> return Nothing
                      Just def -> forkM (mk_at_doc tc)                 $
                                  extendIfaceTyVarEnv (tyConTyVars tc) $
                                  do { tc_def <- tcIfaceType def
790
                                     ; return (Just (tc_def, noSrcSpan)) }
791 792 793
                  -- 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
794
          return (ATI tc mb_def)
795

796 797 798
   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]
799

800
tc_iface_decl _ _ (IfaceAxiom { ifName = tc_name, ifTyCon = tc
801
                              , ifAxBranches = branches, ifRole = role })
802
  = do { tc_tycon    <- tcIfaceTyCon tc
803 804 805 806 807 808 809 810
       -- 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
811
       ; let axiom = CoAxiom { co_ax_unique   = nameUnique tc_name
812 813
                             , co_ax_name     = tc_name
                             , co_ax_tc       = tc_tycon
814
                             , co_ax_role     = role
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
815
                             , co_ax_branches = manyBranches tc_branches
816 817
                             , co_ax_implicit = False }
       ; return (ACoAxiom axiom) }
818

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

851 852 853 854 855
tc_fd :: FunDep IfLclName -> IfL (FunDep TyVar)
tc_fd (tvs1, tvs2) = do { tvs1' <- mapM tcIfaceTyVar tvs1
                        ; tvs2' <- mapM tcIfaceTyVar tvs2
                        ;