{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998


Type checking of type signatures in interface files
-}

{-# LANGUAGE CPP #-}
{-# LANGUAGE NondecreasingIndentation #-}

module TcIface (
        tcLookupImported_maybe,
        importDecl, checkWiredInTyCon, tcHiBootIface, typecheckIface,
        typecheckIfacesForMerging,
        typecheckIfaceForInstantiate,
        tcIfaceDecl, tcIfaceInst, tcIfaceFamInst, tcIfaceRules,
        tcIfaceAnnotations, tcIfaceCompleteSigs,
        tcIfaceExpr,    -- Desired by HERMIT (#7683)
        tcIfaceGlobal
 ) where

#include "HsVersions.h"

import GhcPrelude

import TcTypeNats(typeNatCoAxiomRules)
import IfaceSyn
import LoadIface
import IfaceEnv
import BuildTyCl
import TcRnMonad
import TcType
import Type
import Coercion
import CoAxiom
import TyCoRep    -- needs to build types & coercions in a knot
import TyCoSubst ( substTyCoVars )
import HscTypes
import Annotations
import InstEnv
import FamInstEnv
import CoreSyn
import CoreUtils
import CoreUnfold
import CoreLint
import MkCore
import Id
import MkId
import IdInfo
import Class
import TyCon
import ConLike
import DataCon
import PrelNames
import TysWiredIn
import Literal
import Var
import VarSet
import Name
import NameEnv
import NameSet
import OccurAnal        ( occurAnalyseExpr )
import Demand
import Module
import UniqFM
import UniqSupply
import Outputable
import Maybes
import SrcLoc
import DynFlags
import Util
import FastString
import BasicTypes hiding ( SuccessFlag(..) )
import ListSetOps
import GHC.Fingerprint
import qualified BooleanFormula as BF

import Control.Monad
import qualified Data.Map as Map

{-
This module takes

        IfaceDecl -> TyThing
        IfaceType -> Type
        etc

An IfaceDecl is populated with RdrNames, and these are not renamed to
Names before typechecking, because there should be no scope errors etc.

        -- For (b) consider: f = \$(...h....)
        -- where h is imported, and calls f via an hi-boot file.
        -- This is bad!  But it is not seen as a staging error, because h
        -- is indeed imported.  We don't want the type-checker to black-hole
        -- 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.


************************************************************************
*                                                                      *
                Type-checking a complete interface
*                                                                      *
************************************************************************

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.

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!
-}

-- Clients of this function be careful, see Note [Knot-tying typecheckIface]
typecheckIface :: ModIface      -- Get the decls from here
               -> IfG ModDetails
typecheckIface :: ModIface -> IfG ModDetails
typecheckIface ModIface
iface
  = Module -> SDoc -> Bool -> IfL ModDetails -> IfG ModDetails
forall a lcl. Module -> SDoc -> Bool -> IfL a -> IfM lcl a
initIfaceLcl (ModIface -> Module
forall (a :: ModIfacePhase). ModIface_ a -> Module
mi_semantic_module ModIface
iface) (String -> SDoc
text String
"typecheckIface") (ModIface -> Bool
mi_boot ModIface
iface) (IfL ModDetails -> IfG ModDetails)
-> IfL ModDetails -> IfG ModDetails
forall a b. (a -> b) -> a -> b
$ do
        {       -- 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
                -- It's not actually *wrong* to do so, but in fact GHCi is unable
                -- to handle unboxed tuples, so it must not see unfoldings.
          Bool
ignore_prags <- GeneralFlag -> TcRnIf IfGblEnv IfLclEnv Bool
forall gbl lcl. GeneralFlag -> TcRnIf gbl lcl Bool
goptM GeneralFlag
Opt_IgnoreInterfacePragmas

                -- Typecheck the decls.  This is done lazily, so that the knot-tying
                -- within this single module works out right.  It's the callers
                -- job to make sure the knot is tied.
        ; [(Name, TyThing)]
names_w_things <- Bool -> [(Fingerprint, IfaceDecl)] -> IfL [(Name, TyThing)]
loadDecls Bool
ignore_prags (ModIface -> [IfaceDeclExts 'ModIfaceFinal]
forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceDeclExts phase]
mi_decls ModIface
iface)
        ; let type_env :: NameEnv TyThing
type_env = [(Name, TyThing)] -> NameEnv TyThing
forall a. [(Name, a)] -> NameEnv a
mkNameEnv [(Name, TyThing)]
names_w_things

                -- Now do those rules, instances and annotations
        ; [ClsInst]
insts     <- (IfaceClsInst -> IOEnv (Env IfGblEnv IfLclEnv) ClsInst)
-> [IfaceClsInst] -> IOEnv (Env IfGblEnv IfLclEnv) [ClsInst]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceClsInst -> IOEnv (Env IfGblEnv IfLclEnv) ClsInst
tcIfaceInst (ModIface -> [IfaceClsInst]
forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceClsInst]
mi_insts ModIface
iface)
        ; [FamInst]
fam_insts <- (IfaceFamInst -> IOEnv (Env IfGblEnv IfLclEnv) FamInst)
-> [IfaceFamInst] -> IOEnv (Env IfGblEnv IfLclEnv) [FamInst]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceFamInst -> IOEnv (Env IfGblEnv IfLclEnv) FamInst
tcIfaceFamInst (ModIface -> [IfaceFamInst]
forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceFamInst]
mi_fam_insts ModIface
iface)
        ; [CoreRule]
rules     <- Bool -> [IfaceRule] -> IfL [CoreRule]
tcIfaceRules Bool
ignore_prags (ModIface -> [IfaceRule]
forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceRule]
mi_rules ModIface
iface)
        ; [Annotation]
anns      <- [IfaceAnnotation] -> IfL [Annotation]
tcIfaceAnnotations (ModIface -> [IfaceAnnotation]
forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceAnnotation]
mi_anns ModIface
iface)

                -- Exports
        ; [AvailInfo]
exports <- [AvailInfo] -> TcRnIf IfGblEnv IfLclEnv [AvailInfo]
forall gbl lcl. [AvailInfo] -> TcRnIf gbl lcl [AvailInfo]
ifaceExportNames (ModIface -> [AvailInfo]
forall (phase :: ModIfacePhase). ModIface_ phase -> [AvailInfo]
mi_exports ModIface
iface)

                -- Complete Sigs
        ; [CompleteMatch]
complete_sigs <- [IfaceCompleteMatch] -> IfL [CompleteMatch]
tcIfaceCompleteSigs (ModIface -> [IfaceCompleteMatch]
forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceCompleteMatch]
mi_complete_sigs ModIface
iface)

                -- Finished
        ; SDoc -> TcRnIf IfGblEnv IfLclEnv ()
forall m n. SDoc -> TcRnIf m n ()
traceIf ([SDoc] -> SDoc
vcat [String -> SDoc
text String
"Finished typechecking interface for" SDoc -> SDoc -> SDoc
<+> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ModIface -> Module
forall (a :: ModIfacePhase). ModIface_ a -> Module
mi_module ModIface
iface),
                         -- 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.
                         String -> SDoc
text String
"Type envt:" SDoc -> SDoc -> SDoc
<+> [Name] -> SDoc
forall a. Outputable a => a -> SDoc
ppr (((Name, TyThing) -> Name) -> [(Name, TyThing)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, TyThing) -> Name
forall a b. (a, b) -> a
fst [(Name, TyThing)]
names_w_things)])
        ; ModDetails -> IfL ModDetails
forall (m :: * -> *) a. Monad m => a -> m a
return (ModDetails -> IfL ModDetails) -> ModDetails -> IfL ModDetails
forall a b. (a -> b) -> a -> b
$ ModDetails :: [AvailInfo]
-> NameEnv TyThing
-> [ClsInst]
-> [FamInst]
-> [CoreRule]
-> [Annotation]
-> [CompleteMatch]
-> ModDetails
ModDetails { md_types :: NameEnv TyThing
md_types     = NameEnv TyThing
type_env
                              , md_insts :: [ClsInst]
md_insts     = [ClsInst]
insts
                              , md_fam_insts :: [FamInst]
md_fam_insts = [FamInst]
fam_insts
                              , md_rules :: [CoreRule]
md_rules     = [CoreRule]
rules
                              , md_anns :: [Annotation]
md_anns      = [Annotation]
anns
                              , md_exports :: [AvailInfo]
md_exports   = [AvailInfo]
exports
                              , md_complete_sigs :: [CompleteMatch]
md_complete_sigs = [CompleteMatch]
complete_sigs
                              }
    }

{-
************************************************************************
*                                                                      *
                Typechecking for merging
*                                                                      *
************************************************************************
-}

-- | Returns true if an 'IfaceDecl' is for @data T@ (an abstract data type)
isAbstractIfaceDecl :: IfaceDecl -> Bool
isAbstractIfaceDecl :: IfaceDecl -> Bool
isAbstractIfaceDecl IfaceData{ ifCons :: IfaceDecl -> IfaceConDecls
ifCons = IfaceConDecls
IfAbstractTyCon } = Bool
True
isAbstractIfaceDecl IfaceClass{ ifBody :: IfaceDecl -> IfaceClassBody
ifBody = IfaceClassBody
IfAbstractClass } = Bool
True
isAbstractIfaceDecl IfaceFamily{ ifFamFlav :: IfaceDecl -> IfaceFamTyConFlav
ifFamFlav = IfaceFamTyConFlav
IfaceAbstractClosedSynFamilyTyCon } = Bool
True
isAbstractIfaceDecl IfaceDecl
_ = Bool
False

ifMaybeRoles :: IfaceDecl -> Maybe [Role]
ifMaybeRoles :: IfaceDecl -> Maybe [Role]
ifMaybeRoles IfaceData    { ifRoles :: IfaceDecl -> [Role]
ifRoles = [Role]
rs } = [Role] -> Maybe [Role]
forall a. a -> Maybe a
Just [Role]
rs
ifMaybeRoles IfaceSynonym { ifRoles :: IfaceDecl -> [Role]
ifRoles = [Role]
rs } = [Role] -> Maybe [Role]
forall a. a -> Maybe a
Just [Role]
rs
ifMaybeRoles IfaceClass   { ifRoles :: IfaceDecl -> [Role]
ifRoles = [Role]
rs } = [Role] -> Maybe [Role]
forall a. a -> Maybe a
Just [Role]
rs
ifMaybeRoles IfaceDecl
_ = Maybe [Role]
forall a. Maybe a
Nothing

-- | 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 :: IfaceDecl -> IfaceDecl -> IfaceDecl
mergeIfaceDecl IfaceDecl
d1 IfaceDecl
d2
    | IfaceDecl -> Bool
isAbstractIfaceDecl IfaceDecl
d1 = IfaceDecl
d2 IfaceDecl -> IfaceDecl -> IfaceDecl
`withRolesFrom` IfaceDecl
d1
    | IfaceDecl -> Bool
isAbstractIfaceDecl IfaceDecl
d2 = IfaceDecl
d1 IfaceDecl -> IfaceDecl -> IfaceDecl
`withRolesFrom` IfaceDecl
d2
    | IfaceClass{ ifBody :: IfaceDecl -> IfaceClassBody
ifBody = IfConcreteClass { ifSigs :: IfaceClassBody -> [IfaceClassOp]
ifSigs = [IfaceClassOp]
ops1, ifMinDef :: IfaceClassBody -> BooleanFormula IfLclName
ifMinDef = BooleanFormula IfLclName
bf1 } } <- IfaceDecl
d1
    , IfaceClass{ ifBody :: IfaceDecl -> IfaceClassBody
ifBody = IfConcreteClass { ifSigs :: IfaceClassBody -> [IfaceClassOp]
ifSigs = [IfaceClassOp]
ops2, ifMinDef :: IfaceClassBody -> BooleanFormula IfLclName
ifMinDef = BooleanFormula IfLclName
bf2 } } <- IfaceDecl
d2
    = let ops :: [IfaceClassOp]
ops = NameEnv IfaceClassOp -> [IfaceClassOp]
forall a. NameEnv a -> [a]
nameEnvElts (NameEnv IfaceClassOp -> [IfaceClassOp])
-> NameEnv IfaceClassOp -> [IfaceClassOp]
forall a b. (a -> b) -> a -> b
$
                  (IfaceClassOp -> IfaceClassOp -> IfaceClassOp)
-> NameEnv IfaceClassOp
-> NameEnv IfaceClassOp
-> NameEnv IfaceClassOp
forall a. (a -> a -> a) -> NameEnv a -> NameEnv a -> NameEnv a
plusNameEnv_C IfaceClassOp -> IfaceClassOp -> IfaceClassOp
mergeIfaceClassOp
                    ([(Name, IfaceClassOp)] -> NameEnv IfaceClassOp
forall a. [(Name, a)] -> NameEnv a
mkNameEnv [ (Name
n, IfaceClassOp
op) | op :: IfaceClassOp
op@(IfaceClassOp Name
n IfaceType
_ Maybe (DefMethSpec IfaceType)
_) <- [IfaceClassOp]
ops1 ])
                    ([(Name, IfaceClassOp)] -> NameEnv IfaceClassOp
forall a. [(Name, a)] -> NameEnv a
mkNameEnv [ (Name
n, IfaceClassOp
op) | op :: IfaceClassOp
op@(IfaceClassOp Name
n IfaceType
_ Maybe (DefMethSpec IfaceType)
_) <- [IfaceClassOp]
ops2 ])
      in IfaceDecl
d1 { ifBody :: IfaceClassBody
ifBody = (IfaceDecl -> IfaceClassBody
ifBody IfaceDecl
d1) {
                ifSigs :: [IfaceClassOp]
ifSigs  = [IfaceClassOp]
ops,
                ifMinDef :: BooleanFormula IfLclName
ifMinDef = [LBooleanFormula IfLclName] -> BooleanFormula IfLclName
forall a. Eq a => [LBooleanFormula a] -> BooleanFormula a
BF.mkOr [SrcSpanLess (LBooleanFormula IfLclName)
-> LBooleanFormula IfLclName
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc SrcSpanLess (LBooleanFormula IfLclName)
BooleanFormula IfLclName
bf1, SrcSpanLess (LBooleanFormula IfLclName)
-> LBooleanFormula IfLclName
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc SrcSpanLess (LBooleanFormula IfLclName)
BooleanFormula IfLclName
bf2]
                }
            } IfaceDecl -> IfaceDecl -> IfaceDecl
`withRolesFrom` IfaceDecl
d2
    -- It doesn't matter; we'll check for consistency later when
    -- we merge, see 'mergeSignatures'
    | Bool
otherwise              = IfaceDecl
d1 IfaceDecl -> IfaceDecl -> IfaceDecl
`withRolesFrom` IfaceDecl
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
-- if we merged the roles of these types in some nontrivial
-- 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.

withRolesFrom :: IfaceDecl -> IfaceDecl -> IfaceDecl
IfaceDecl
d1 withRolesFrom :: IfaceDecl -> IfaceDecl -> IfaceDecl
`withRolesFrom` IfaceDecl
d2
    | Just [Role]
roles1 <- IfaceDecl -> Maybe [Role]
ifMaybeRoles IfaceDecl
d1
    , Just [Role]
roles2 <- IfaceDecl -> Maybe [Role]
ifMaybeRoles IfaceDecl
d2
    , Bool -> Bool
not (IfaceDecl -> Bool
isRepInjectiveIfaceDecl IfaceDecl
d1 Bool -> Bool -> Bool
|| IfaceDecl -> Bool
isRepInjectiveIfaceDecl IfaceDecl
d2)
    = IfaceDecl
d1 { ifRoles :: [Role]
ifRoles = [Role] -> [Role] -> [Role]
forall c. Ord c => [c] -> [c] -> [c]
mergeRoles [Role]
roles1 [Role]
roles2 }
    | Bool
otherwise = IfaceDecl
d1
  where
    mergeRoles :: [c] -> [c] -> [c]
mergeRoles [c]
roles1 [c]
roles2 = (c -> c -> c) -> [c] -> [c] -> [c]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith c -> c -> c
forall a. Ord a => a -> a -> a
max [c]
roles1 [c]
roles2

isRepInjectiveIfaceDecl :: IfaceDecl -> Bool
isRepInjectiveIfaceDecl :: IfaceDecl -> Bool
isRepInjectiveIfaceDecl IfaceData{ ifCons :: IfaceDecl -> IfaceConDecls
ifCons = IfDataTyCon [IfaceConDecl]
_ } = Bool
True
isRepInjectiveIfaceDecl IfaceFamily{ ifFamFlav :: IfaceDecl -> IfaceFamTyConFlav
ifFamFlav = IfaceFamTyConFlav
IfaceDataFamilyTyCon } = Bool
True
isRepInjectiveIfaceDecl IfaceDecl
_ = Bool
False

mergeIfaceClassOp :: IfaceClassOp -> IfaceClassOp -> IfaceClassOp
mergeIfaceClassOp :: IfaceClassOp -> IfaceClassOp -> IfaceClassOp
mergeIfaceClassOp op1 :: IfaceClassOp
op1@(IfaceClassOp Name
_ IfaceType
_ (Just DefMethSpec IfaceType
_)) IfaceClassOp
_ = IfaceClassOp
op1
mergeIfaceClassOp IfaceClassOp
_ IfaceClassOp
op2 = IfaceClassOp
op2

-- | Merge two 'OccEnv's of 'IfaceDecl's by 'OccName'.
mergeIfaceDecls :: OccEnv IfaceDecl -> OccEnv IfaceDecl -> OccEnv IfaceDecl
mergeIfaceDecls :: OccEnv IfaceDecl -> OccEnv IfaceDecl -> OccEnv IfaceDecl
mergeIfaceDecls = (IfaceDecl -> IfaceDecl -> IfaceDecl)
-> OccEnv IfaceDecl -> OccEnv IfaceDecl -> OccEnv IfaceDecl
forall a. (a -> a -> a) -> OccEnv a -> OccEnv a -> OccEnv a
plusOccEnv_C IfaceDecl -> IfaceDecl -> IfaceDecl
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
-- (this is "type computation.")  Then we read everything in relative
-- to this truth and check for compatibility.
--
-- 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.)
--
-- Unfortunately, the choice can matter if there is a cycle.  Consider the
-- following merge:
--
--      signature H where { type A = C;  type B = A; data C      }
--      signature H where { type A = (); data B;     type C = B  }
--
-- 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
-- the "best" choice we could have made (ezyang conjectures this
-- is the case but does not have a proof).  For now this is
-- not implemented.
--
-- It's worth noting that at the moment, a data constructor and a
-- type synonym are never compatible.  Consider:
--
--      signature H where { type Int=C;         type B = Int; data C = Int}
--      signature H where { export Prelude.Int; data B;       type C = B; }
--
-- 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.
typecheckIfacesForMerging :: Module -> [ModIface] -> IORef TypeEnv -> IfM lcl (TypeEnv, [ModDetails])
typecheckIfacesForMerging :: Module
-> [ModIface]
-> IORef (NameEnv TyThing)
-> IfM lcl (NameEnv TyThing, [ModDetails])
typecheckIfacesForMerging Module
mod [ModIface]
ifaces IORef (NameEnv TyThing)
tc_env_var =
  -- cannot be boot (False)
  Module
-> SDoc
-> Bool
-> IfL (NameEnv TyThing, [ModDetails])
-> IfM lcl (NameEnv TyThing, [ModDetails])
forall a lcl. Module -> SDoc -> Bool -> IfL a -> IfM lcl a
initIfaceLcl Module
mod (String -> SDoc
text String
"typecheckIfacesForMerging") Bool
False (IfL (NameEnv TyThing, [ModDetails])
 -> IfM lcl (NameEnv TyThing, [ModDetails]))
-> IfL (NameEnv TyThing, [ModDetails])
-> IfM lcl (NameEnv TyThing, [ModDetails])
forall a b. (a -> b) -> a -> b
$ do
    Bool
ignore_prags <- GeneralFlag -> TcRnIf IfGblEnv IfLclEnv Bool
forall gbl lcl. GeneralFlag -> TcRnIf gbl lcl Bool
goptM GeneralFlag
Opt_IgnoreInterfacePragmas
    -- Build the initial environment
    -- NB: Don't include dfuns here, because we don't want to
    -- serialize them out.  See Note [rnIfaceNeverExported] in RnModIface
    -- NB: But coercions are OK, because they will have the right OccName.
    let mk_decl_env :: [IfaceDecl] -> OccEnv IfaceDecl
mk_decl_env [IfaceDecl]
decls
            = [(OccName, IfaceDecl)] -> OccEnv IfaceDecl
forall a. [(OccName, a)] -> OccEnv a
mkOccEnv [ (IfaceDecl -> OccName
forall a. NamedThing a => a -> OccName
getOccName IfaceDecl
decl, IfaceDecl
decl)
                       | IfaceDecl
decl <- [IfaceDecl]
decls
                       , case IfaceDecl
decl of
                            IfaceId { ifIdDetails :: IfaceDecl -> IfaceIdDetails
ifIdDetails = IfaceIdDetails
IfDFunId } -> Bool
False -- exclude DFuns
                            IfaceDecl
_ -> Bool
True ]
        decl_envs :: [OccEnv IfaceDecl]
decl_envs = (ModIface -> OccEnv IfaceDecl) -> [ModIface] -> [OccEnv IfaceDecl]
forall a b. (a -> b) -> [a] -> [b]
map ([IfaceDecl] -> OccEnv IfaceDecl
mk_decl_env ([IfaceDecl] -> OccEnv IfaceDecl)
-> (ModIface -> [IfaceDecl]) -> ModIface -> OccEnv IfaceDecl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Fingerprint, IfaceDecl) -> IfaceDecl)
-> [(Fingerprint, IfaceDecl)] -> [IfaceDecl]
forall a b. (a -> b) -> [a] -> [b]
map (Fingerprint, IfaceDecl) -> IfaceDecl
forall a b. (a, b) -> b
snd ([(Fingerprint, IfaceDecl)] -> [IfaceDecl])
-> (ModIface -> [(Fingerprint, IfaceDecl)])
-> ModIface
-> [IfaceDecl]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModIface -> [(Fingerprint, IfaceDecl)]
forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceDeclExts phase]
mi_decls) [ModIface]
ifaces
                        :: [OccEnv IfaceDecl]
        decl_env :: OccEnv IfaceDecl
decl_env = (OccEnv IfaceDecl -> OccEnv IfaceDecl -> OccEnv IfaceDecl)
-> OccEnv IfaceDecl -> [OccEnv IfaceDecl] -> OccEnv IfaceDecl
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' OccEnv IfaceDecl -> OccEnv IfaceDecl -> OccEnv IfaceDecl
mergeIfaceDecls OccEnv IfaceDecl
forall a. OccEnv a
emptyOccEnv [OccEnv IfaceDecl]
decl_envs
                        ::  OccEnv IfaceDecl
    -- TODO: change loadDecls to accept w/o Fingerprint
    [(Name, TyThing)]
names_w_things <- Bool -> [(Fingerprint, IfaceDecl)] -> IfL [(Name, TyThing)]
loadDecls Bool
ignore_prags ((IfaceDecl -> (Fingerprint, IfaceDecl))
-> [IfaceDecl] -> [(Fingerprint, IfaceDecl)]
forall a b. (a -> b) -> [a] -> [b]
map (\IfaceDecl
x -> (Fingerprint
fingerprint0, IfaceDecl
x))
                                                  (OccEnv IfaceDecl -> [IfaceDecl]
forall a. OccEnv a -> [a]
occEnvElts OccEnv IfaceDecl
decl_env))
    let global_type_env :: NameEnv TyThing
global_type_env = [(Name, TyThing)] -> NameEnv TyThing
forall a. [(Name, a)] -> NameEnv a
mkNameEnv [(Name, TyThing)]
names_w_things
    IORef (NameEnv TyThing)
-> NameEnv TyThing -> TcRnIf IfGblEnv IfLclEnv ()
forall a env. IORef a -> a -> IOEnv env ()
writeMutVar IORef (NameEnv TyThing)
tc_env_var NameEnv TyThing
global_type_env

    -- OK, now typecheck each ModIface using this environment
    [ModDetails]
details <- [ModIface]
-> (ModIface -> IfL ModDetails)
-> IOEnv (Env IfGblEnv IfLclEnv) [ModDetails]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ModIface]
ifaces ((ModIface -> IfL ModDetails)
 -> IOEnv (Env IfGblEnv IfLclEnv) [ModDetails])
-> (ModIface -> IfL ModDetails)
-> IOEnv (Env IfGblEnv IfLclEnv) [ModDetails]
forall a b. (a -> b) -> a -> b
$ \ModIface
iface -> do
        -- See Note [Resolving never-exported Names in TcIface]
        NameEnv TyThing
type_env <- (NameEnv TyThing
 -> IOEnv (Env IfGblEnv IfLclEnv) (NameEnv TyThing))
-> IOEnv (Env IfGblEnv IfLclEnv) (NameEnv TyThing)
forall a env. (a -> IOEnv env a) -> IOEnv env a
fixM ((NameEnv TyThing
  -> IOEnv (Env IfGblEnv IfLclEnv) (NameEnv TyThing))
 -> IOEnv (Env IfGblEnv IfLclEnv) (NameEnv TyThing))
-> (NameEnv TyThing
    -> IOEnv (Env IfGblEnv IfLclEnv) (NameEnv TyThing))
-> IOEnv (Env IfGblEnv IfLclEnv) (NameEnv TyThing)
forall a b. (a -> b) -> a -> b
$ \NameEnv TyThing
type_env -> do
            NameEnv TyThing
-> IOEnv (Env IfGblEnv IfLclEnv) (NameEnv TyThing)
-> IOEnv (Env IfGblEnv IfLclEnv) (NameEnv TyThing)
forall a. NameEnv TyThing -> IfL a -> IfL a
setImplicitEnvM NameEnv TyThing
type_env (IOEnv (Env IfGblEnv IfLclEnv) (NameEnv TyThing)
 -> IOEnv (Env IfGblEnv IfLclEnv) (NameEnv TyThing))
-> IOEnv (Env IfGblEnv IfLclEnv) (NameEnv TyThing)
-> IOEnv (Env IfGblEnv IfLclEnv) (NameEnv TyThing)
forall a b. (a -> b) -> a -> b
$ do
                [(Name, TyThing)]
decls <- Bool -> [(Fingerprint, IfaceDecl)] -> IfL [(Name, TyThing)]
loadDecls Bool
ignore_prags (ModIface -> [IfaceDeclExts 'ModIfaceFinal]
forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceDeclExts phase]
mi_decls ModIface
iface)
                NameEnv TyThing -> IOEnv (Env IfGblEnv IfLclEnv) (NameEnv TyThing)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Name, TyThing)] -> NameEnv TyThing
forall a. [(Name, a)] -> NameEnv a
mkNameEnv [(Name, TyThing)]
decls)
        -- But note that we use this type_env to typecheck references to DFun
        -- in 'IfaceInst'
        NameEnv TyThing -> IfL ModDetails -> IfL ModDetails
forall a. NameEnv TyThing -> IfL a -> IfL a
setImplicitEnvM NameEnv TyThing
type_env (IfL ModDetails -> IfL ModDetails)
-> IfL ModDetails -> IfL ModDetails
forall a b. (a -> b) -> a -> b
$ do
        [ClsInst]
insts     <- (IfaceClsInst -> IOEnv (Env IfGblEnv IfLclEnv) ClsInst)
-> [IfaceClsInst] -> IOEnv (Env IfGblEnv IfLclEnv) [ClsInst]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceClsInst -> IOEnv (Env IfGblEnv IfLclEnv) ClsInst
tcIfaceInst (ModIface -> [IfaceClsInst]
forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceClsInst]
mi_insts ModIface
iface)
        [FamInst]
fam_insts <- (IfaceFamInst -> IOEnv (Env IfGblEnv IfLclEnv) FamInst)
-> [IfaceFamInst] -> IOEnv (Env IfGblEnv IfLclEnv) [FamInst]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceFamInst -> IOEnv (Env IfGblEnv IfLclEnv) FamInst
tcIfaceFamInst (ModIface -> [IfaceFamInst]
forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceFamInst]
mi_fam_insts ModIface
iface)
        [CoreRule]
rules     <- Bool -> [IfaceRule] -> IfL [CoreRule]
tcIfaceRules Bool
ignore_prags (ModIface -> [IfaceRule]
forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceRule]
mi_rules ModIface
iface)
        [Annotation]
anns      <- [IfaceAnnotation] -> IfL [Annotation]
tcIfaceAnnotations (ModIface -> [IfaceAnnotation]
forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceAnnotation]
mi_anns ModIface
iface)
        [AvailInfo]
exports   <- [AvailInfo] -> TcRnIf IfGblEnv IfLclEnv [AvailInfo]
forall gbl lcl. [AvailInfo] -> TcRnIf gbl lcl [AvailInfo]
ifaceExportNames (ModIface -> [AvailInfo]
forall (phase :: ModIfacePhase). ModIface_ phase -> [AvailInfo]
mi_exports ModIface
iface)
        [CompleteMatch]
complete_sigs <- [IfaceCompleteMatch] -> IfL [CompleteMatch]
tcIfaceCompleteSigs (ModIface -> [IfaceCompleteMatch]
forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceCompleteMatch]
mi_complete_sigs ModIface
iface)
        ModDetails -> IfL ModDetails
forall (m :: * -> *) a. Monad m => a -> m a
return (ModDetails -> IfL ModDetails) -> ModDetails -> IfL ModDetails
forall a b. (a -> b) -> a -> b
$ ModDetails :: [AvailInfo]
-> NameEnv TyThing
-> [ClsInst]
-> [FamInst]
-> [CoreRule]
-> [Annotation]
-> [CompleteMatch]
-> ModDetails
ModDetails { md_types :: NameEnv TyThing
md_types     = NameEnv TyThing
type_env
                            , md_insts :: [ClsInst]
md_insts     = [ClsInst]
insts
                            , md_fam_insts :: [FamInst]
md_fam_insts = [FamInst]
fam_insts
                            , md_rules :: [CoreRule]
md_rules     = [CoreRule]
rules
                            , md_anns :: [Annotation]
md_anns      = [Annotation]
anns
                            , md_exports :: [AvailInfo]
md_exports   = [AvailInfo]
exports
                            , md_complete_sigs :: [CompleteMatch]
md_complete_sigs = [CompleteMatch]
complete_sigs
                            }
    (NameEnv TyThing, [ModDetails])
-> IfL (NameEnv TyThing, [ModDetails])
forall (m :: * -> *) a. Monad m => a -> m a
return (NameEnv TyThing
global_type_env, [ModDetails]
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
-- DFun silliness (see Note [rnIfaceNeverExported])
typecheckIfaceForInstantiate :: NameShape -> ModIface -> IfM lcl ModDetails
typecheckIfaceForInstantiate :: NameShape -> ModIface -> IfM lcl ModDetails
typecheckIfaceForInstantiate NameShape
nsubst ModIface
iface =
  Module
-> SDoc
-> Bool
-> NameShape
-> IfL ModDetails
-> IfM lcl ModDetails
forall a lcl.
Module -> SDoc -> Bool -> NameShape -> IfL a -> IfM lcl a
initIfaceLclWithSubst (ModIface -> Module
forall (a :: ModIfacePhase). ModIface_ a -> Module
mi_semantic_module ModIface
iface)
                        (String -> SDoc
text String
"typecheckIfaceForInstantiate")
                        (ModIface -> Bool
mi_boot ModIface
iface) NameShape
nsubst (IfL ModDetails -> IfM lcl ModDetails)
-> IfL ModDetails -> IfM lcl ModDetails
forall a b. (a -> b) -> a -> b
$ do
    Bool
ignore_prags <- GeneralFlag -> TcRnIf IfGblEnv IfLclEnv Bool
forall gbl lcl. GeneralFlag -> TcRnIf gbl lcl Bool
goptM GeneralFlag
Opt_IgnoreInterfacePragmas
    -- See Note [Resolving never-exported Names in TcIface]
    NameEnv TyThing
type_env <- (NameEnv TyThing
 -> IOEnv (Env IfGblEnv IfLclEnv) (NameEnv TyThing))
-> IOEnv (Env IfGblEnv IfLclEnv) (NameEnv TyThing)
forall a env. (a -> IOEnv env a) -> IOEnv env a
fixM ((NameEnv TyThing
  -> IOEnv (Env IfGblEnv IfLclEnv) (NameEnv TyThing))
 -> IOEnv (Env IfGblEnv IfLclEnv) (NameEnv TyThing))
-> (NameEnv TyThing
    -> IOEnv (Env IfGblEnv IfLclEnv) (NameEnv TyThing))
-> IOEnv (Env IfGblEnv IfLclEnv) (NameEnv TyThing)
forall a b. (a -> b) -> a -> b
$ \NameEnv TyThing
type_env -> do
        NameEnv TyThing
-> IOEnv (Env IfGblEnv IfLclEnv) (NameEnv TyThing)
-> IOEnv (Env IfGblEnv IfLclEnv) (NameEnv TyThing)
forall a. NameEnv TyThing -> IfL a -> IfL a
setImplicitEnvM NameEnv TyThing
type_env (IOEnv (Env IfGblEnv IfLclEnv) (NameEnv TyThing)
 -> IOEnv (Env IfGblEnv IfLclEnv) (NameEnv TyThing))
-> IOEnv (Env IfGblEnv IfLclEnv) (NameEnv TyThing)
-> IOEnv (Env IfGblEnv IfLclEnv) (NameEnv TyThing)
forall a b. (a -> b) -> a -> b
$ do
            [(Name, TyThing)]
decls     <- Bool -> [(Fingerprint, IfaceDecl)] -> IfL [(Name, TyThing)]
loadDecls Bool
ignore_prags (ModIface -> [IfaceDeclExts 'ModIfaceFinal]
forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceDeclExts phase]
mi_decls ModIface
iface)
            NameEnv TyThing -> IOEnv (Env IfGblEnv IfLclEnv) (NameEnv TyThing)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Name, TyThing)] -> NameEnv TyThing
forall a. [(Name, a)] -> NameEnv a
mkNameEnv [(Name, TyThing)]
decls)
    -- See Note [rnIfaceNeverExported]
    NameEnv TyThing -> IfL ModDetails -> IfL ModDetails
forall a. NameEnv TyThing -> IfL a -> IfL a
setImplicitEnvM NameEnv TyThing
type_env (IfL ModDetails -> IfL ModDetails)
-> IfL ModDetails -> IfL ModDetails
forall a b. (a -> b) -> a -> b
$ do
    [ClsInst]
insts     <- (IfaceClsInst -> IOEnv (Env IfGblEnv IfLclEnv) ClsInst)
-> [IfaceClsInst] -> IOEnv (Env IfGblEnv IfLclEnv) [ClsInst]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceClsInst -> IOEnv (Env IfGblEnv IfLclEnv) ClsInst
tcIfaceInst (ModIface -> [IfaceClsInst]
forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceClsInst]
mi_insts ModIface
iface)
    [FamInst]
fam_insts <- (IfaceFamInst -> IOEnv (Env IfGblEnv IfLclEnv) FamInst)
-> [IfaceFamInst] -> IOEnv (Env IfGblEnv IfLclEnv) [FamInst]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceFamInst -> IOEnv (Env IfGblEnv IfLclEnv) FamInst
tcIfaceFamInst (ModIface -> [IfaceFamInst]
forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceFamInst]
mi_fam_insts ModIface
iface)
    [CoreRule]
rules     <- Bool -> [IfaceRule] -> IfL [CoreRule]
tcIfaceRules Bool
ignore_prags (ModIface -> [IfaceRule]
forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceRule]
mi_rules ModIface
iface)
    [Annotation]
anns      <- [IfaceAnnotation] -> IfL [Annotation]
tcIfaceAnnotations (ModIface -> [IfaceAnnotation]
forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceAnnotation]
mi_anns ModIface
iface)
    [AvailInfo]
exports   <- [AvailInfo] -> TcRnIf IfGblEnv IfLclEnv [AvailInfo]
forall gbl lcl. [AvailInfo] -> TcRnIf gbl lcl [AvailInfo]
ifaceExportNames (ModIface -> [AvailInfo]
forall (phase :: ModIfacePhase). ModIface_ phase -> [AvailInfo]
mi_exports ModIface
iface)
    [CompleteMatch]
complete_sigs <- [IfaceCompleteMatch] -> IfL [CompleteMatch]
tcIfaceCompleteSigs (ModIface -> [IfaceCompleteMatch]
forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceCompleteMatch]
mi_complete_sigs ModIface
iface)
    ModDetails -> IfL ModDetails
forall (m :: * -> *) a. Monad m => a -> m a
return (ModDetails -> IfL ModDetails) -> ModDetails -> IfL ModDetails
forall a b. (a -> b) -> a -> b
$ ModDetails :: [AvailInfo]
-> NameEnv TyThing
-> [ClsInst]
-> [FamInst]
-> [CoreRule]
-> [Annotation]
-> [CompleteMatch]
-> ModDetails
ModDetails { md_types :: NameEnv TyThing
md_types     = NameEnv TyThing
type_env
                        , md_insts :: [ClsInst]
md_insts     = [ClsInst]
insts
                        , md_fam_insts :: [FamInst]
md_fam_insts = [FamInst]
fam_insts
                        , md_rules :: [CoreRule]
md_rules     = [CoreRule]
rules
                        , md_anns :: [Annotation]
md_anns      = [Annotation]
anns
                        , md_exports :: [AvailInfo]
md_exports   = [AvailInfo]
exports
                        , md_complete_sigs :: [CompleteMatch]
md_complete_sigs = [CompleteMatch]
complete_sigs
                        }

-- Note [Resolving never-exported Names in TcIface]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- For the high-level overview, see
-- Note [Handling never-exported TyThings under Backpack]
--
-- 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.
--
-- 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
-- declaration, you'll never notice there's a difference even if there
-- is one.
--
-- 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.
--
-- 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.
--

{-
************************************************************************
*                                                                      *
                Type and class declarations
*                                                                      *
************************************************************************
-}

tcHiBootIface :: HscSource -> Module -> TcRn SelfBootInfo
-- Load the hi-boot iface for the module being compiled,
-- if it indeed exists in the transitive closure of imports
-- Return the ModDetails; Nothing if no hi-boot iface
tcHiBootIface :: HscSource -> Module -> TcRn SelfBootInfo
tcHiBootIface HscSource
hsc_src Module
mod
  | HscSource
HsBootFile <- HscSource
hsc_src            -- Already compiling a hs-boot file
  = SelfBootInfo -> TcRn SelfBootInfo
forall (m :: * -> *) a. Monad m => a -> m a
return SelfBootInfo
NoSelfBoot
  | Bool
otherwise
  = do  { SDoc -> TcRnIf TcGblEnv TcLclEnv ()
forall m n. SDoc -> TcRnIf m n ()
traceIf (String -> SDoc
text String
"loadHiBootInterface" SDoc -> SDoc -> SDoc
<+> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod)

        ; GhcMode
mode <- TcRnIf TcGblEnv TcLclEnv GhcMode
forall gbl lcl. TcRnIf gbl lcl GhcMode
getGhcMode
        ; if Bool -> Bool
not (GhcMode -> Bool
isOneShot GhcMode
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
                --
                -- We check wheher the interface is a *boot* interface.
                -- It can happen (when using GHC from Visual Studio) that we
                -- compile a module in TypecheckOnly mode, with a stable,
                -- 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.
                -- And that's fine, because if M's ModInfo is in the HPT, then
                -- it's been compiled once, and we don't need to check the boot iface
          then do { HomePackageTable
hpt <- TcRnIf TcGblEnv TcLclEnv HomePackageTable
forall gbl lcl. TcRnIf gbl lcl HomePackageTable
getHpt
                 ; case HomePackageTable -> ModuleName -> Maybe HomeModInfo
lookupHpt HomePackageTable
hpt (Module -> ModuleName
moduleName Module
mod) of
                      Just HomeModInfo
info | ModIface -> Bool
mi_boot (HomeModInfo -> ModIface
hm_iface HomeModInfo
info)
                                -> ModIface -> ModDetails -> TcRn SelfBootInfo
mkSelfBootInfo (HomeModInfo -> ModIface
hm_iface HomeModInfo
info) (HomeModInfo -> ModDetails
hm_details HomeModInfo
info)
                      Maybe HomeModInfo
_ -> SelfBootInfo -> TcRn SelfBootInfo
forall (m :: * -> *) a. Monad m => a -> m a
return SelfBootInfo
NoSelfBoot }
          else do

        -- OK, so we're in one-shot mode.
        -- 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.
        { MaybeErr SDoc (ModIface, String)
read_result <- SDoc
-> InstalledModule
-> Module
-> Bool
-> TcRnIf TcGblEnv TcLclEnv (MaybeErr SDoc (ModIface, String))
forall gbl lcl.
SDoc
-> InstalledModule
-> Module
-> Bool
-> TcRnIf gbl lcl (MaybeErr SDoc (ModIface, String))
findAndReadIface
                                SDoc
need ((InstalledModule, Maybe IndefModule) -> InstalledModule
forall a b. (a, b) -> a
fst (Module -> (InstalledModule, Maybe IndefModule)
splitModuleInsts Module
mod)) Module
mod
                                Bool
True    -- Hi-boot file

        ; case MaybeErr SDoc (ModIface, String)
read_result of {
            Succeeded (ModIface
iface, String
_path) -> do { ModDetails
tc_iface <- IfG ModDetails -> TcRn ModDetails
forall a. IfG a -> TcRn a
initIfaceTcRn (IfG ModDetails -> TcRn ModDetails)
-> IfG ModDetails -> TcRn ModDetails
forall a b. (a -> b) -> a -> b
$ ModIface -> IfG ModDetails
typecheckIface ModIface
iface
                                           ; ModIface -> ModDetails -> TcRn SelfBootInfo
mkSelfBootInfo ModIface
iface ModDetails
tc_iface } ;
            Failed SDoc
err               ->

        -- 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  { ExternalPackageState
eps <- TcRnIf TcGblEnv TcLclEnv ExternalPackageState
forall gbl lcl. TcRnIf gbl lcl ExternalPackageState
getEps
        ; case UniqFM (ModuleName, Bool) -> ModuleName -> Maybe (ModuleName, Bool)
forall key elt. Uniquable key => UniqFM elt -> key -> Maybe elt
lookupUFM (ExternalPackageState -> UniqFM (ModuleName, Bool)
eps_is_boot ExternalPackageState
eps) (Module -> ModuleName
moduleName Module
mod) of
            Maybe (ModuleName, Bool)
Nothing -> SelfBootInfo -> TcRn SelfBootInfo
forall (m :: * -> *) a. Monad m => a -> m a
return SelfBootInfo
NoSelfBoot -- The typical case

            Just (ModuleName
_, Bool
False) -> SDoc -> TcRn SelfBootInfo
forall a. SDoc -> TcM a
failWithTc SDoc
moduleLoop
                -- Someone below us imported us!
                -- This is a loop with no hi-boot in the way

            Just (ModuleName
_mod, Bool
True) -> SDoc -> TcRn SelfBootInfo
forall a. SDoc -> TcM a
failWithTc (SDoc -> SDoc
elaborate SDoc
err)
                -- The hi-boot file has mysteriously disappeared.
    }}}}
  where
    need :: SDoc
need = String -> SDoc
text String
"Need the hi-boot interface for" SDoc -> SDoc -> SDoc
<+> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod
                 SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"to compare against the Real Thing"

    moduleLoop :: SDoc
moduleLoop = String -> SDoc
text String
"Circular imports: module" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod)
                     SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"depends on itself"

    elaborate :: SDoc -> SDoc
elaborate SDoc
err = SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Could not find hi-boot interface for" SDoc -> SDoc -> SDoc
<+>
                          SDoc -> SDoc
quotes (Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod) SDoc -> SDoc -> SDoc
<> SDoc
colon) Int
4 SDoc
err


mkSelfBootInfo :: ModIface -> ModDetails -> TcRn SelfBootInfo
mkSelfBootInfo :: ModIface -> ModDetails -> TcRn SelfBootInfo
mkSelfBootInfo ModIface
iface ModDetails
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.
       let tcs :: [Name]
tcs = (IfaceDecl -> Name) -> [IfaceDecl] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map IfaceDecl -> Name
ifName
                 ([IfaceDecl] -> [Name])
-> ([(Fingerprint, IfaceDecl)] -> [IfaceDecl])
-> [(Fingerprint, IfaceDecl)]
-> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IfaceDecl -> Bool) -> [IfaceDecl] -> [IfaceDecl]
forall a. (a -> Bool) -> [a] -> [a]
filter IfaceDecl -> Bool
isIfaceTyCon
                 ([IfaceDecl] -> [IfaceDecl])
-> ([(Fingerprint, IfaceDecl)] -> [IfaceDecl])
-> [(Fingerprint, IfaceDecl)]
-> [IfaceDecl]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Fingerprint, IfaceDecl) -> IfaceDecl)
-> [(Fingerprint, IfaceDecl)] -> [IfaceDecl]
forall a b. (a -> b) -> [a] -> [b]
map (Fingerprint, IfaceDecl) -> IfaceDecl
forall a b. (a, b) -> b
snd
                 ([(Fingerprint, IfaceDecl)] -> [Name])
-> [(Fingerprint, IfaceDecl)] -> [Name]
forall a b. (a -> b) -> a -> b
$ ModIface -> [IfaceDeclExts 'ModIfaceFinal]
forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceDeclExts phase]
mi_decls ModIface
iface
       SelfBootInfo -> TcRn SelfBootInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (SelfBootInfo -> TcRn SelfBootInfo)
-> SelfBootInfo -> TcRn SelfBootInfo
forall a b. (a -> b) -> a -> b
$ SelfBoot :: ModDetails -> NameSet -> SelfBootInfo
SelfBoot { sb_mds :: ModDetails
sb_mds = ModDetails
mds
                         , sb_tcs :: NameSet
sb_tcs = [Name] -> NameSet
mkNameSet [Name]
tcs }
  where
    -- | 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 :: IfaceDecl -> Bool
isIfaceTyCon IfaceId{}      = Bool
False
    isIfaceTyCon IfaceData{}    = Bool
True
    isIfaceTyCon IfaceSynonym{} = Bool
True
    isIfaceTyCon IfaceFamily{}  = Bool
True
    isIfaceTyCon IfaceClass{}   = Bool
True
    isIfaceTyCon IfaceAxiom{}   = Bool
False
    isIfaceTyCon IfacePatSyn{}  = Bool
False

{-
************************************************************************
*                                                                      *
                Type and class declarations
*                                                                      *
************************************************************************

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.

E.g.
        data Foo.S = MkS Baz.T
Maybe we can get away without even loading the interface for Baz!

This is not just a performance thing.  Suppose we have
        data Foo.S = MkS Baz.T
        data Baz.T = MkT Foo.S
(in different interface files, of course).
Now, first we load and typecheck Foo.S, and add it to the type envt.
If we do explore MkS's argument, we'll load and typecheck Baz.T.
If we explore MkT's argument we'll find Foo.S already in the envt.

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:
        * 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

Now we look something up in the type envt
        * that pulls on <t>
        * which reads the global type envt out of the global EPS mutvar
        * but that depends in turn on <t>

It's subtle, because, it'd work fine if we typechecked the constructor args
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.
-}

tcIfaceDecl :: Bool     -- ^ True <=> discard IdInfo on IfaceId bindings
            -> IfaceDecl
            -> IfL TyThing
tcIfaceDecl :: Bool -> IfaceDecl -> IfL TyThing
tcIfaceDecl = Maybe Class -> Bool -> IfaceDecl -> IfL TyThing
tc_iface_decl Maybe Class
forall a. Maybe a
Nothing

tc_iface_decl :: Maybe Class  -- ^ For associated type/data family declarations
              -> Bool         -- ^ True <=> discard IdInfo on IfaceId bindings
              -> IfaceDecl
              -> IfL TyThing
tc_iface_decl :: Maybe Class -> Bool -> IfaceDecl -> IfL TyThing
tc_iface_decl Maybe Class
_ Bool
ignore_prags (IfaceId {ifName :: IfaceDecl -> Name
ifName = Name
name, ifType :: IfaceDecl -> IfaceType
ifType = IfaceType
iface_type,
                                       ifIdDetails :: IfaceDecl -> IfaceIdDetails
ifIdDetails = IfaceIdDetails
details, ifIdInfo :: IfaceDecl -> IfaceIdInfo
ifIdInfo = IfaceIdInfo
info})
  = do  { Type
ty <- IfaceType -> IfL Type
tcIfaceType IfaceType
iface_type
        ; IdDetails
details <- Type -> IfaceIdDetails -> IfL IdDetails
tcIdDetails Type
ty IfaceIdDetails
details
        ; IdInfo
info <- Bool -> TopLevelFlag -> Name -> Type -> IfaceIdInfo -> IfL IdInfo
tcIdInfo Bool
ignore_prags TopLevelFlag
TopLevel Name
name Type
ty IfaceIdInfo
info
        ; TyThing -> IfL TyThing
forall (m :: * -> *) a. Monad m => a -> m a
return (Id -> TyThing
AnId (IdDetails -> Name -> Type -> IdInfo -> Id
mkGlobalId IdDetails
details Name
name Type
ty IdInfo
info)) }

tc_iface_decl Maybe Class
_ Bool
_ (IfaceData {ifName :: IfaceDecl -> Name
ifName = Name
tc_name,
                          ifCType :: IfaceDecl -> Maybe CType
ifCType = Maybe CType
cType,
                          ifBinders :: IfaceDecl -> [IfaceTyConBinder]
ifBinders = [IfaceTyConBinder]
binders,
                          ifResKind :: IfaceDecl -> IfaceType
ifResKind = IfaceType
res_kind,
                          ifRoles :: IfaceDecl -> [Role]
ifRoles = [Role]
roles,
                          ifCtxt :: IfaceDecl -> IfaceContext
ifCtxt = IfaceContext
ctxt, ifGadtSyntax :: IfaceDecl -> Bool
ifGadtSyntax = Bool
gadt_syn,
                          ifCons :: IfaceDecl -> IfaceConDecls
ifCons = IfaceConDecls
rdr_cons,
                          ifParent :: IfaceDecl -> IfaceTyConParent
ifParent = IfaceTyConParent
mb_parent })
  = [IfaceTyConBinder] -> ([TyConBinder] -> IfL TyThing) -> IfL TyThing
forall a. [IfaceTyConBinder] -> ([TyConBinder] -> IfL a) -> IfL a
bindIfaceTyConBinders_AT [IfaceTyConBinder]
binders (([TyConBinder] -> IfL TyThing) -> IfL TyThing)
-> ([TyConBinder] -> IfL TyThing) -> IfL TyThing
forall a b. (a -> b) -> a -> b
$ \ [TyConBinder]
binders' -> do
    { Type
res_kind' <- IfaceType -> IfL Type
tcIfaceType IfaceType
res_kind

    ; TyCon
tycon <- (TyCon -> IOEnv (Env IfGblEnv IfLclEnv) TyCon)
-> IOEnv (Env IfGblEnv IfLclEnv) TyCon
forall a env. (a -> IOEnv env a) -> IOEnv env a
fixM ((TyCon -> IOEnv (Env IfGblEnv IfLclEnv) TyCon)
 -> IOEnv (Env IfGblEnv IfLclEnv) TyCon)
-> (TyCon -> IOEnv (Env IfGblEnv IfLclEnv) TyCon)
-> IOEnv (Env IfGblEnv IfLclEnv) TyCon
forall a b. (a -> b) -> a -> b
$ \ TyCon
tycon -> do
            { ThetaType
stupid_theta <- IfaceContext -> IfL ThetaType
tcIfaceCtxt IfaceContext
ctxt
            ; AlgTyConFlav
parent' <- Name -> IfaceTyConParent -> IfL AlgTyConFlav
tc_parent Name
tc_name IfaceTyConParent
mb_parent
            ; AlgTyConRhs
cons <- Name -> TyCon -> [TyConBinder] -> IfaceConDecls -> IfL AlgTyConRhs
tcIfaceDataCons Name
tc_name TyCon
tycon [TyConBinder]
binders' IfaceConDecls
rdr_cons
            ; TyCon -> IOEnv (Env IfGblEnv IfLclEnv) TyCon
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
-> [TyConBinder]
-> Type
-> [Role]
-> Maybe CType
-> ThetaType
-> AlgTyConRhs
-> AlgTyConFlav
-> Bool
-> TyCon
mkAlgTyCon Name
tc_name [TyConBinder]
binders' Type
res_kind'
                                 [Role]
roles Maybe CType
cType ThetaType
stupid_theta
                                 AlgTyConRhs
cons AlgTyConFlav
parent' Bool
gadt_syn) }
    ; SDoc -> TcRnIf IfGblEnv IfLclEnv ()
forall m n. SDoc -> TcRnIf m n ()
traceIf (String -> SDoc
text String
"tcIfaceDecl4" SDoc -> SDoc -> SDoc
<+> TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tycon)
    ; TyThing -> IfL TyThing
forall (m :: * -> *) a. Monad m => a -> m a
return (TyCon -> TyThing
ATyCon TyCon
tycon) }
  where
    tc_parent :: Name -> IfaceTyConParent -> IfL AlgTyConFlav
    tc_parent :: Name -> IfaceTyConParent -> IfL AlgTyConFlav
tc_parent Name
tc_name IfaceTyConParent
IfNoParent
      = do { Name
tc_rep_name <- Name -> TcRnIf IfGblEnv IfLclEnv Name
forall gbl lcl. Name -> TcRnIf gbl lcl Name
newTyConRepName Name
tc_name
           ; AlgTyConFlav -> IfL AlgTyConFlav
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> AlgTyConFlav
VanillaAlgTyCon Name
tc_rep_name) }
    tc_parent Name
_ (IfDataInstance Name
ax_name IfaceTyCon
_ IfaceAppArgs
arg_tys)
      = do { CoAxiom Branched
ax <- Name -> IfL (CoAxiom Branched)
tcIfaceCoAxiom Name
ax_name
           ; let fam_tc :: TyCon
fam_tc  = CoAxiom Branched -> TyCon
forall (br :: BranchFlag). CoAxiom br -> TyCon
coAxiomTyCon CoAxiom Branched
ax
                 ax_unbr :: CoAxiom Unbranched
ax_unbr = CoAxiom Branched -> CoAxiom Unbranched
forall (br :: BranchFlag). CoAxiom br -> CoAxiom Unbranched
toUnbranchedAxiom CoAxiom Branched
ax
           ; ThetaType
lhs_tys <- IfaceAppArgs -> IfL ThetaType
tcIfaceAppArgs IfaceAppArgs
arg_tys
           ; AlgTyConFlav -> IfL AlgTyConFlav
forall (m :: * -> *) a. Monad m => a -> m a
return (CoAxiom Unbranched -> TyCon -> ThetaType -> AlgTyConFlav
DataFamInstTyCon CoAxiom Unbranched
ax_unbr TyCon
fam_tc ThetaType
lhs_tys) }

tc_iface_decl Maybe Class
_ Bool
_ (IfaceSynonym {ifName :: IfaceDecl -> Name
ifName = Name
tc_name,
                                      ifRoles :: IfaceDecl -> [Role]
ifRoles = [Role]
roles,
                                      ifSynRhs :: IfaceDecl -> IfaceType
ifSynRhs = IfaceType
rhs_ty,
                                      ifBinders :: IfaceDecl -> [IfaceTyConBinder]
ifBinders = [IfaceTyConBinder]
binders,
                                      ifResKind :: IfaceDecl -> IfaceType
ifResKind = IfaceType
res_kind })
   = [IfaceTyConBinder] -> ([TyConBinder] -> IfL TyThing) -> IfL TyThing
forall a. [IfaceTyConBinder] -> ([TyConBinder] -> IfL a) -> IfL a
bindIfaceTyConBinders_AT [IfaceTyConBinder]
binders (([TyConBinder] -> IfL TyThing) -> IfL TyThing)
-> ([TyConBinder] -> IfL TyThing) -> IfL TyThing
forall a b. (a -> b) -> a -> b
$ \ [TyConBinder]
binders' -> do
     { Type
res_kind' <- IfaceType -> IfL Type
tcIfaceType IfaceType
res_kind     -- Note [Synonym kind loop]
     ; Type
rhs      <- SDoc -> IfL Type -> IfL Type
forall a. SDoc -> IfL a -> IfL a
forkM (Name -> SDoc
forall a. Outputable a => a -> SDoc
mk_doc Name
tc_name) (IfL Type -> IfL Type) -> IfL Type -> IfL Type
forall a b. (a -> b) -> a -> b
$
                   IfaceType -> IfL Type
tcIfaceType IfaceType
rhs_ty
     ; let tycon :: TyCon
tycon = Name -> [TyConBinder] -> Type -> [Role] -> Type -> TyCon
buildSynTyCon Name
tc_name [TyConBinder]
binders' Type
res_kind' [Role]
roles Type
rhs
     ; TyThing -> IfL TyThing
forall (m :: * -> *) a. Monad m => a -> m a
return (TyCon -> TyThing
ATyCon TyCon
tycon) }
   where
     mk_doc :: a -> SDoc
mk_doc a
n = String -> SDoc
text String
"Type synonym" SDoc -> SDoc -> SDoc
<+> a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
n

tc_iface_decl Maybe Class
parent Bool
_ (IfaceFamily {ifName :: IfaceDecl -> Name
ifName = Name
tc_name,
                                     ifFamFlav :: IfaceDecl -> IfaceFamTyConFlav
ifFamFlav = IfaceFamTyConFlav
fam_flav,
                                     ifBinders :: IfaceDecl -> [IfaceTyConBinder]
ifBinders = [IfaceTyConBinder]
binders,
                                     ifResKind :: IfaceDecl -> IfaceType
ifResKind = IfaceType
res_kind,
                                     ifResVar :: IfaceDecl -> Maybe IfLclName
ifResVar = Maybe IfLclName
res, ifFamInj :: IfaceDecl -> Injectivity
ifFamInj = Injectivity
inj })
   = [IfaceTyConBinder] -> ([TyConBinder] -> IfL TyThing) -> IfL TyThing
forall a. [IfaceTyConBinder] -> ([TyConBinder] -> IfL a) -> IfL a
bindIfaceTyConBinders_AT [IfaceTyConBinder]
binders (([TyConBinder] -> IfL TyThing) -> IfL TyThing)
-> ([TyConBinder] -> IfL TyThing) -> IfL TyThing
forall a b. (a -> b) -> a -> b
$ \ [TyConBinder]
binders' -> do
     { Type
res_kind' <- IfaceType -> IfL Type
tcIfaceType IfaceType
res_kind    -- Note [Synonym kind loop]
     ; FamTyConFlav
rhs      <- SDoc -> IfL FamTyConFlav -> IfL FamTyConFlav
forall a. SDoc -> IfL a -> IfL a
forkM (Name -> SDoc
forall a. Outputable a => a -> SDoc
mk_doc Name
tc_name) (IfL FamTyConFlav -> IfL FamTyConFlav)
-> IfL FamTyConFlav -> IfL FamTyConFlav
forall a b. (a -> b) -> a -> b
$
                   Name -> IfaceFamTyConFlav -> IfL FamTyConFlav
tc_fam_flav Name
tc_name IfaceFamTyConFlav
fam_flav
     ; Maybe Name
res_name <- (IfLclName -> TcRnIf IfGblEnv IfLclEnv Name)
-> Maybe IfLclName -> IOEnv (Env IfGblEnv IfLclEnv) (Maybe Name)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (OccName -> TcRnIf IfGblEnv IfLclEnv Name
newIfaceName (OccName -> TcRnIf IfGblEnv IfLclEnv Name)
-> (IfLclName -> OccName)
-> IfLclName
-> TcRnIf IfGblEnv IfLclEnv Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IfLclName -> OccName
mkTyVarOccFS) Maybe IfLclName
res
     ; let tycon :: TyCon
tycon = Name
-> [TyConBinder]
-> Type
-> Maybe Name
-> FamTyConFlav
-> Maybe Class
-> Injectivity
-> TyCon
mkFamilyTyCon Name
tc_name [TyConBinder]
binders' Type
res_kind' Maybe Name
res_name FamTyConFlav
rhs Maybe Class
parent Injectivity
inj
     ; TyThing -> IfL TyThing
forall (m :: * -> *) a. Monad m => a -> m a
return (TyCon -> TyThing
ATyCon TyCon
tycon) }
   where
     mk_doc :: a -> SDoc
mk_doc a
n = String -> SDoc
text String
"Type synonym" SDoc -> SDoc -> SDoc
<+> a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
n

     tc_fam_flav :: Name -> IfaceFamTyConFlav -> IfL FamTyConFlav
     tc_fam_flav :: Name -> IfaceFamTyConFlav -> IfL FamTyConFlav
tc_fam_flav Name
tc_name IfaceFamTyConFlav
IfaceDataFamilyTyCon
       = do { Name
tc_rep_name <- Name -> TcRnIf IfGblEnv IfLclEnv Name
forall gbl lcl. Name -> TcRnIf gbl lcl Name
newTyConRepName Name
tc_name
            ; FamTyConFlav -> IfL FamTyConFlav
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> FamTyConFlav
DataFamilyTyCon Name
tc_rep_name) }
     tc_fam_flav Name
_ IfaceFamTyConFlav
IfaceOpenSynFamilyTyCon= FamTyConFlav -> IfL FamTyConFlav
forall (m :: * -> *) a. Monad m => a -> m a
return FamTyConFlav
OpenSynFamilyTyCon
     tc_fam_flav Name
_ (IfaceClosedSynFamilyTyCon Maybe (Name, [IfaceAxBranch])
mb_ax_name_branches)
       = do { Maybe (CoAxiom Branched)
ax <- ((Name, [IfaceAxBranch]) -> IfL (CoAxiom Branched))
-> Maybe (Name, [IfaceAxBranch])
-> IOEnv (Env IfGblEnv IfLclEnv) (Maybe (CoAxiom Branched))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Name -> IfL (CoAxiom Branched)
tcIfaceCoAxiom (Name -> IfL (CoAxiom Branched))
-> ((Name, [IfaceAxBranch]) -> Name)
-> (Name, [IfaceAxBranch])
-> IfL (CoAxiom Branched)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, [IfaceAxBranch]) -> Name
forall a b. (a, b) -> a
fst) Maybe (Name, [IfaceAxBranch])
mb_ax_name_branches
            ; FamTyConFlav -> IfL FamTyConFlav
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (CoAxiom Branched) -> FamTyConFlav
ClosedSynFamilyTyCon Maybe (CoAxiom Branched)
ax) }
     tc_fam_flav Name
_ IfaceFamTyConFlav
IfaceAbstractClosedSynFamilyTyCon
         = FamTyConFlav -> IfL FamTyConFlav
forall (m :: * -> *) a. Monad m => a -> m a
return FamTyConFlav
AbstractClosedSynFamilyTyCon
     tc_fam_flav Name
_ IfaceFamTyConFlav
IfaceBuiltInSynFamTyCon
         = String -> SDoc -> IfL FamTyConFlav
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tc_iface_decl"
                    (String -> SDoc
text String
"IfaceBuiltInSynFamTyCon in interface file")

tc_iface_decl Maybe Class
_parent Bool
_ignore_prags
            (IfaceClass {ifName :: IfaceDecl -> Name
ifName = Name
tc_name,
                         ifRoles :: IfaceDecl -> [Role]
ifRoles = [Role]
roles,
                         ifBinders :: IfaceDecl -> [IfaceTyConBinder]
ifBinders = [IfaceTyConBinder]
binders,
                         ifFDs :: IfaceDecl -> [FunDep IfLclName]
ifFDs = [FunDep IfLclName]
rdr_fds,
                         ifBody :: IfaceDecl -> IfaceClassBody
ifBody = IfaceClassBody
IfAbstractClass})
  = [IfaceTyConBinder] -> ([TyConBinder] -> IfL TyThing) -> IfL TyThing
forall a. [IfaceTyConBinder] -> ([TyConBinder] -> IfL a) -> IfL a
bindIfaceTyConBinders [IfaceTyConBinder]
binders (([TyConBinder] -> IfL TyThing) -> IfL TyThing)
-> ([TyConBinder] -> IfL TyThing) -> IfL TyThing
forall a b. (a -> b) -> a -> b
$ \ [TyConBinder]
binders' -> do
    { [FunDep Id]
fds  <- (FunDep IfLclName -> IOEnv (Env IfGblEnv IfLclEnv) (FunDep Id))
-> [FunDep IfLclName] -> IOEnv (Env IfGblEnv IfLclEnv) [FunDep Id]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FunDep IfLclName -> IOEnv (Env IfGblEnv IfLclEnv) (FunDep Id)
tc_fd [FunDep IfLclName]
rdr_fds
    ; Class
cls  <- Name
-> [TyConBinder]
-> [Role]
-> [FunDep Id]
-> Maybe
     (ThetaType, [ClassATItem], [KnotTied MethInfo], ClassMinimalDef)
-> TcRnIf IfGblEnv IfLclEnv Class
forall m n.
Name
-> [TyConBinder]
-> [Role]
-> [FunDep Id]
-> Maybe
     (ThetaType, [ClassATItem], [KnotTied MethInfo], ClassMinimalDef)
-> TcRnIf m n Class
buildClass Name
tc_name [TyConBinder]
binders' [Role]
roles [FunDep Id]
fds Maybe
  (ThetaType, [ClassATItem], [KnotTied MethInfo], ClassMinimalDef)
forall a. Maybe a
Nothing
    ; TyThing -> IfL TyThing
forall (m :: * -> *) a. Monad m => a -> m a
return (TyCon -> TyThing
ATyCon (Class -> TyCon
classTyCon Class
cls)) }

tc_iface_decl Maybe Class
_parent Bool
ignore_prags
            (IfaceClass {ifName :: IfaceDecl -> Name
ifName = Name
tc_name,
                         ifRoles :: IfaceDecl -> [Role]
ifRoles = [Role]
roles,
                         ifBinders :: IfaceDecl -> [IfaceTyConBinder]
ifBinders = [IfaceTyConBinder]
binders,
                         ifFDs :: IfaceDecl -> [FunDep IfLclName]
ifFDs = [FunDep IfLclName]
rdr_fds,
                         ifBody :: IfaceDecl -> IfaceClassBody
ifBody = IfConcreteClass {
                             ifClassCtxt :: IfaceClassBody -> IfaceContext
ifClassCtxt = IfaceContext
rdr_ctxt,
                             ifATs :: IfaceClassBody -> [IfaceAT]
ifATs = [IfaceAT]
rdr_ats, ifSigs :: IfaceClassBody -> [IfaceClassOp]
ifSigs = [IfaceClassOp]
rdr_sigs,
                             ifMinDef :: IfaceClassBody -> BooleanFormula IfLclName
ifMinDef = BooleanFormula IfLclName
mindef_occ
                         }})
  = [IfaceTyConBinder] -> ([TyConBinder] -> IfL TyThing) -> IfL TyThing
forall a. [IfaceTyConBinder] -> ([TyConBinder] -> IfL a) -> IfL a
bindIfaceTyConBinders [IfaceTyConBinder]
binders (([TyConBinder] -> IfL TyThing) -> IfL TyThing)
-> ([TyConBinder] -> IfL TyThing) -> IfL TyThing
forall a b. (a -> b) -> a -> b
$ \ [TyConBinder]
binders' -> do
    { SDoc -> TcRnIf IfGblEnv IfLclEnv ()
forall m n. SDoc -> TcRnIf m n ()
traceIf (String -> SDoc
text String
"tc-iface-class1" SDoc -> SDoc -> SDoc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
tc_name)
    ; ThetaType
ctxt <- (IfaceType -> IfL Type) -> IfaceContext -> IfL ThetaType
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceType -> IfL Type
tc_sc IfaceContext
rdr_ctxt
    ; SDoc -> TcRnIf IfGblEnv IfLclEnv ()
forall m n. SDoc -> TcRnIf m n ()
traceIf (String -> SDoc
text String
"tc-iface-class2" SDoc -> SDoc -> SDoc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
tc_name)
    ; [KnotTied MethInfo]
sigs <- (IfaceClassOp -> IOEnv (Env IfGblEnv IfLclEnv) (KnotTied MethInfo))
-> [IfaceClassOp]
-> IOEnv (Env IfGblEnv IfLclEnv) [KnotTied MethInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceClassOp -> IOEnv (Env IfGblEnv IfLclEnv) (KnotTied MethInfo)
tc_sig [IfaceClassOp]
rdr_sigs
    ; [FunDep Id]
fds  <- (FunDep IfLclName -> IOEnv (Env IfGblEnv IfLclEnv) (FunDep Id))
-> [FunDep IfLclName] -> IOEnv (Env IfGblEnv IfLclEnv) [FunDep Id]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FunDep IfLclName -> IOEnv (Env IfGblEnv IfLclEnv) (FunDep Id)
tc_fd [FunDep IfLclName]
rdr_fds
    ; SDoc -> TcRnIf IfGblEnv IfLclEnv ()
forall m n. SDoc -> TcRnIf m n ()
traceIf (String -> SDoc
text String
"tc-iface-class3" SDoc -> SDoc -> SDoc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
tc_name)
    ; ClassMinimalDef
mindef <- (IfLclName -> TcRnIf IfGblEnv IfLclEnv Name)
-> BooleanFormula IfLclName
-> IOEnv (Env IfGblEnv IfLclEnv) ClassMinimalDef
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (OccName -> TcRnIf IfGblEnv IfLclEnv Name
lookupIfaceTop (OccName -> TcRnIf IfGblEnv IfLclEnv Name)
-> (IfLclName -> OccName)
-> IfLclName
-> TcRnIf IfGblEnv IfLclEnv Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IfLclName -> OccName
mkVarOccFS) BooleanFormula IfLclName
mindef_occ
    ; Class
cls  <- (Class -> TcRnIf IfGblEnv IfLclEnv Class)
-> TcRnIf IfGblEnv IfLclEnv Class
forall a env. (a -> IOEnv env a) -> IOEnv env a
fixM ((Class -> TcRnIf IfGblEnv IfLclEnv Class)
 -> TcRnIf IfGblEnv IfLclEnv Class)
-> (Class -> TcRnIf IfGblEnv IfLclEnv Class)
-> TcRnIf IfGblEnv IfLclEnv Class
forall a b. (a -> b) -> a -> b
$ \ Class
cls -> do
              { [ClassATItem]
ats  <- (IfaceAT -> IOEnv (Env IfGblEnv IfLclEnv) ClassATItem)
-> [IfaceAT] -> IOEnv (Env IfGblEnv IfLclEnv) [ClassATItem]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Class -> IfaceAT -> IOEnv (Env IfGblEnv IfLclEnv) ClassATItem
tc_at Class
cls) [IfaceAT]
rdr_ats
              ; SDoc -> TcRnIf IfGblEnv IfLclEnv ()
forall m n. SDoc -> TcRnIf m n ()
traceIf (String -> SDoc
text String
"tc-iface-class4" SDoc -> SDoc -> SDoc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
tc_name)
              ; Name
-> [TyConBinder]
-> [Role]
-> [FunDep Id]
-> Maybe
     (ThetaType, [ClassATItem], [KnotTied MethInfo], ClassMinimalDef)
-> TcRnIf IfGblEnv IfLclEnv Class
forall m n.
Name
-> [TyConBinder]
-> [Role]
-> [FunDep Id]
-> Maybe
     (ThetaType, [ClassATItem], [KnotTied MethInfo], ClassMinimalDef)
-> TcRnIf m n Class
buildClass Name
tc_name [TyConBinder]
binders' [Role]
roles [FunDep Id]
fds ((ThetaType, [ClassATItem], [KnotTied MethInfo], ClassMinimalDef)
-> Maybe
     (ThetaType, [ClassATItem], [KnotTied MethInfo], ClassMinimalDef)
forall a. a -> Maybe a
Just (ThetaType
ctxt, [ClassATItem]
ats, [KnotTied MethInfo]
sigs, ClassMinimalDef
mindef)) }
    ; TyThing -> IfL TyThing
forall (m :: * -> *) a. Monad m => a -> m a
return (TyCon -> TyThing
ATyCon (Class -> TyCon
classTyCon Class
cls)) }
  where
   tc_sc :: IfaceType -> IfL Type
tc_sc IfaceType
pred = SDoc -> IfL Type -> IfL Type
forall a. SDoc -> IfL a -> IfL a
forkM (IfaceType -> SDoc
forall a. Outputable a => a -> SDoc
mk_sc_doc IfaceType
pred) (IfaceType -> IfL Type
tcIfaceType IfaceType
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 #5970

   tc_sig :: IfaceClassOp -> IfL TcMethInfo
   tc_sig :: IfaceClassOp -> IOEnv (Env IfGblEnv IfLclEnv) (KnotTied MethInfo)
tc_sig (IfaceClassOp Name
op_name IfaceType
rdr_ty Maybe (DefMethSpec IfaceType)
dm)
     = do { let doc :: SDoc
doc = Name -> IfaceType -> SDoc
forall a a. (Outputable a, Outputable a) => a -> a -> SDoc
mk_op_doc Name
op_name IfaceType
rdr_ty
          ; Type
op_ty <- SDoc -> IfL Type -> IfL Type
forall a. SDoc -> IfL a -> IfL a
forkM (SDoc
doc SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"ty") (IfL Type -> IfL Type) -> IfL Type -> IfL Type
forall a b. (a -> b) -> a -> b
$ IfaceType -> IfL Type
tcIfaceType IfaceType
rdr_ty
                -- Must be done lazily for just the same reason as the
                -- type of a data con; to avoid sucking in types that
                -- it mentions unless it's necessary to do so
          ; Maybe (DefMethSpec (SrcSpan, Type))
dm'   <- SDoc
-> Maybe (DefMethSpec IfaceType)
-> IfL (Maybe (DefMethSpec (SrcSpan, Type)))
tc_dm SDoc
doc Maybe (DefMethSpec IfaceType)
dm
          ; KnotTied MethInfo
-> IOEnv (Env IfGblEnv IfLclEnv) (KnotTied MethInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
op_name, Type
op_ty, Maybe (DefMethSpec (SrcSpan, Type))
dm') }

   tc_dm :: SDoc
         -> Maybe (DefMethSpec IfaceType)
         -> IfL (Maybe (DefMethSpec (SrcSpan, Type)))
   tc_dm :: SDoc
-> Maybe (DefMethSpec IfaceType)
-> IfL (Maybe (DefMethSpec (SrcSpan, Type)))
tc_dm SDoc
_   Maybe (DefMethSpec IfaceType)
Nothing               = Maybe (DefMethSpec (SrcSpan, Type))
-> IfL (Maybe (DefMethSpec (SrcSpan, Type)))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (DefMethSpec (SrcSpan, Type))
forall a. Maybe a
Nothing
   tc_dm SDoc
_   (Just DefMethSpec IfaceType
VanillaDM)      = Maybe (DefMethSpec (SrcSpan, Type))
-> IfL (Maybe (DefMethSpec (SrcSpan, Type)))
forall (m :: * -> *) a. Monad m => a -> m a
return (DefMethSpec (SrcSpan, Type) -> Maybe (DefMethSpec (SrcSpan, Type))
forall a. a -> Maybe a
Just DefMethSpec (SrcSpan, Type)
forall ty. DefMethSpec ty
VanillaDM)
   tc_dm SDoc
doc (Just (GenericDM IfaceType
ty))
        = do { -- Must be done lazily to avoid sucking in types
             ; Type
ty' <- SDoc -> IfL Type -> IfL Type
forall a. SDoc -> IfL a -> IfL a
forkM (SDoc
doc SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"dm") (IfL Type -> IfL Type) -> IfL Type -> IfL Type
forall a b. (a -> b) -> a -> b
$ IfaceType -> IfL Type
tcIfaceType IfaceType
ty
             ; Maybe (DefMethSpec (SrcSpan, Type))
-> IfL (Maybe (DefMethSpec (SrcSpan, Type)))
forall (m :: * -> *) a. Monad m => a -> m a
return (DefMethSpec (SrcSpan, Type) -> Maybe (DefMethSpec (SrcSpan, Type))
forall a. a -> Maybe a
Just ((SrcSpan, Type) -> DefMethSpec (SrcSpan, Type)
forall ty. ty -> DefMethSpec ty
GenericDM (SrcSpan
noSrcSpan, Type
ty'))) }

   tc_at :: Class -> IfaceAT -> IOEnv (Env IfGblEnv IfLclEnv) ClassATItem
tc_at Class
cls (IfaceAT IfaceDecl
tc_decl Maybe IfaceType
if_def)
     = do ATyCon TyCon
tc <- Maybe Class -> Bool -> IfaceDecl -> IfL TyThing
tc_iface_decl (Class -> Maybe Class
forall a. a -> Maybe a
Just Class
cls) Bool
ignore_prags IfaceDecl
tc_decl
          Maybe (Type, SrcSpan)
mb_def <- case Maybe IfaceType
if_def of
                      Maybe IfaceType
Nothing  -> Maybe (Type, SrcSpan)
-> IOEnv (Env IfGblEnv IfLclEnv) (Maybe (Type, SrcSpan))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Type, SrcSpan)
forall a. Maybe a
Nothing
                      Just IfaceType
def -> SDoc
-> IOEnv (Env IfGblEnv IfLclEnv) (Maybe (Type, SrcSpan))
-> IOEnv (Env IfGblEnv IfLclEnv) (Maybe (Type, SrcSpan))
forall a. SDoc -> IfL a -> IfL a
forkM (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
mk_at_doc TyCon
tc)                 (IOEnv (Env IfGblEnv IfLclEnv) (Maybe (Type, SrcSpan))
 -> IOEnv (Env IfGblEnv IfLclEnv) (Maybe (Type, SrcSpan)))
-> IOEnv (Env IfGblEnv IfLclEnv) (Maybe (Type, SrcSpan))
-> IOEnv (Env IfGblEnv IfLclEnv) (Maybe (Type, SrcSpan))
forall a b. (a -> b) -> a -> b
$
                                  [Id]
-> IOEnv (Env IfGblEnv IfLclEnv) (Maybe (Type, SrcSpan))
-> IOEnv (Env IfGblEnv IfLclEnv) (Maybe (Type, SrcSpan))
forall a. [Id] -> IfL a -> IfL a
extendIfaceTyVarEnv (TyCon -> [Id]
tyConTyVars TyCon
tc) (IOEnv (Env IfGblEnv IfLclEnv) (Maybe (Type, SrcSpan))
 -> IOEnv (Env IfGblEnv IfLclEnv) (Maybe (Type, SrcSpan)))
-> IOEnv (Env IfGblEnv IfLclEnv) (Maybe (Type, SrcSpan))
-> IOEnv (Env IfGblEnv IfLclEnv) (Maybe (Type, SrcSpan))
forall a b. (a -> b) -> a -> b
$
                                  do { Type
tc_def <- IfaceType -> IfL Type
tcIfaceType IfaceType
def
                                     ; Maybe (Type, SrcSpan)
-> IOEnv (Env IfGblEnv IfLclEnv) (Maybe (Type, SrcSpan))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Type, SrcSpan) -> Maybe (Type, SrcSpan)
forall a. a -> Maybe a
Just (Type
tc_def, SrcSpan
noSrcSpan)) }
                  -- 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]   #8002
          ClassATItem -> IOEnv (Env IfGblEnv IfLclEnv) ClassATItem
forall (m :: * -> *) a. Monad m => a -> m a
return (TyCon -> Maybe (Type, SrcSpan) -> ClassATItem
ATI TyCon
tc Maybe (Type, SrcSpan)
mb_def)

   mk_sc_doc :: a -> SDoc
mk_sc_doc a
pred = String -> SDoc
text String
"Superclass" SDoc -> SDoc -> SDoc
<+> a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
pred
   mk_at_doc :: a -> SDoc
mk_at_doc a
tc = String -> SDoc
text String
"Associated type" SDoc -> SDoc -> SDoc
<+> a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
tc
   mk_op_doc :: a -> a -> SDoc
mk_op_doc a
op_name a
op_ty = String -> SDoc
text String
"Class op" SDoc -> SDoc -> SDoc
<+> [SDoc] -> SDoc
sep [a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
op_name, a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
op_ty]

tc_iface_decl Maybe Class
_ Bool
_ (IfaceAxiom { ifName :: IfaceDecl -> Name
ifName = Name
tc_name, ifTyCon :: IfaceDecl -> IfaceTyCon
ifTyCon = IfaceTyCon
tc
                              , ifAxBranches :: IfaceDecl -> [IfaceAxBranch]
ifAxBranches = [IfaceAxBranch]
branches, ifRole :: IfaceDecl -> Role
ifRole = Role
role })
  = do { TyCon
tc_tycon    <- IfaceTyCon -> IOEnv (Env IfGblEnv IfLclEnv) TyCon
tcIfaceTyCon IfaceTyCon
tc
       -- 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 #13803
       ; [CoAxBranch]
tc_branches <- SDoc -> IfL [CoAxBranch] -> IfL [CoAxBranch]
forall a. SDoc -> IfL a -> IfL a
forkM (String -> SDoc
text String
"Axiom branches" SDoc -> SDoc -> SDoc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
tc_name)
                      (IfL [CoAxBranch] -> IfL [CoAxBranch])
-> IfL [CoAxBranch] -> IfL [CoAxBranch]
forall a b. (a -> b) -> a -> b
$ [IfaceAxBranch] -> IfL [CoAxBranch]
tc_ax_branches [IfaceAxBranch]
branches
       ; let axiom :: CoAxiom Branched
axiom = CoAxiom :: forall (br :: BranchFlag).
Unique
-> Name -> Role -> TyCon -> Branches br -> Bool -> CoAxiom br
CoAxiom { co_ax_unique :: Unique
co_ax_unique   = Name -> Unique
nameUnique Name
tc_name
                             , co_ax_name :: Name
co_ax_name     = Name
tc_name
                             , co_ax_tc :: TyCon
co_ax_tc       = TyCon
tc_tycon
                             , co_ax_role :: Role
co_ax_role     = Role
role
                             , co_ax_branches :: Branches Branched
co_ax_branches = [CoAxBranch] -> Branches Branched
manyBranches [CoAxBranch]
tc_branches
                             , co_ax_implicit :: Bool
co_ax_implicit = Bool
False }
       ; TyThing -> IfL TyThing
forall (m :: * -> *) a. Monad m => a -> m a
return (CoAxiom Branched -> TyThing
ACoAxiom CoAxiom Branched
axiom) }

tc_iface_decl Maybe Class
_ Bool
_ (IfacePatSyn{ ifName :: IfaceDecl -> Name
ifName = Name
name
                              , ifPatMatcher :: IfaceDecl -> (Name, Bool)
ifPatMatcher = (Name, Bool)
if_matcher
                              , ifPatBuilder :: IfaceDecl -> Maybe (Name, Bool)
ifPatBuilder = Maybe (Name, Bool)
if_builder
                              , ifPatIsInfix :: IfaceDecl -> Bool
ifPatIsInfix = Bool
is_infix
                              , ifPatUnivBndrs :: IfaceDecl -> [IfaceForAllBndr]
ifPatUnivBndrs = [IfaceForAllBndr]
univ_bndrs
                              , ifPatExBndrs :: IfaceDecl -> [IfaceForAllBndr]
ifPatExBndrs = [IfaceForAllBndr]
ex_bndrs
                              , ifPatProvCtxt :: IfaceDecl -> IfaceContext
ifPatProvCtxt = IfaceContext
prov_ctxt
                              , ifPatReqCtxt :: IfaceDecl -> IfaceContext
ifPatReqCtxt = IfaceContext
req_ctxt
                              , ifPatArgs :: IfaceDecl -> IfaceContext
ifPatArgs = IfaceContext
args
                              , ifPatTy :: IfaceDecl -> IfaceType
ifPatTy = IfaceType
pat_ty
                              , ifFieldLabels :: IfaceDecl -> [FieldLabel]
ifFieldLabels = [FieldLabel]
field_labels })
  = do { SDoc -> TcRnIf IfGblEnv IfLclEnv ()
forall m n. SDoc -> TcRnIf m n ()
traceIf (String -> SDoc
text String
"tc_iface_decl" SDoc -> SDoc -> SDoc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name)
       ; (Id, Bool)
matcher <- (Name, Bool) -> IfL (Id, Bool)
tc_pr (Name, Bool)
if_matcher
       ; Maybe (Id, Bool)
builder <- ((Name, Bool) -> IfL (Id, Bool))
-> Maybe (Name, Bool)
-> IOEnv (Env IfGblEnv IfLclEnv) (Maybe (Id, Bool))
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
fmapMaybeM (Name, Bool) -> IfL (Id, Bool)
tc_pr Maybe (Name, Bool)
if_builder
       ; [IfaceForAllBndr]
-> ([TyCoVarBinder] -> IfL TyThing) -> IfL TyThing
forall a. [IfaceForAllBndr] -> ([TyCoVarBinder] -> IfL a) -> IfL a
bindIfaceForAllBndrs [IfaceForAllBndr]
univ_bndrs (([TyCoVarBinder] -> IfL TyThing) -> IfL TyThing)
-> ([TyCoVarBinder] -> IfL TyThing) -> IfL TyThing
forall a b. (a -> b) -> a -> b
$ \[TyCoVarBinder]
univ_tvs -> do
       { [IfaceForAllBndr]
-> ([TyCoVarBinder] -> IfL TyThing) -> IfL TyThing
forall a. [IfaceForAllBndr] -> ([TyCoVarBinder] -> IfL a) -> IfL a
bindIfaceForAllBndrs [IfaceForAllBndr]
ex_bndrs (([TyCoVarBinder] -> IfL TyThing) -> IfL TyThing)
-> ([TyCoVarBinder] -> IfL TyThing) -> IfL TyThing
forall a b. (a -> b) -> a -> b
$ \[TyCoVarBinder]
ex_tvs -> do
       { PatSyn
patsyn <- SDoc -> IfL PatSyn -> IfL PatSyn
forall a. SDoc -> IfL a -> IfL a
forkM (Name -> SDoc
forall a. Outputable a => a -> SDoc
mk_doc Name
name) (IfL PatSyn -> IfL PatSyn) -> IfL PatSyn -> IfL PatSyn
forall a b. (a -> b) -> a -> b
$
             do { ThetaType
prov_theta <- IfaceContext -> IfL ThetaType
tcIfaceCtxt IfaceContext
prov_ctxt
                ; ThetaType
req_theta  <- IfaceContext -> IfL ThetaType
tcIfaceCtxt IfaceContext
req_ctxt
                ; Type
pat_ty     <- IfaceType -> IfL Type
tcIfaceType IfaceType
pat_ty
                ; ThetaType
arg_tys    <- (IfaceType -> IfL Type) -> IfaceContext -> IfL ThetaType
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceType -> IfL Type
tcIfaceType IfaceContext
args
                ; PatSyn -> IfL PatSyn
forall (m :: * -> *) a. Monad m => a -> m a
return (PatSyn -> IfL PatSyn) -> PatSyn -> IfL PatSyn
forall a b. (a -> b) -> a -> b
$ Name
-> Bool
-> (Id, Bool)
-> Maybe (Id, Bool)
-> ([TyCoVarBinder], ThetaType)
-> ([TyCoVarBinder], ThetaType)
-> ThetaType
-> Type
-> [FieldLabel]
-> PatSyn
buildPatSyn Name
name Bool
is_infix (Id, Bool)
matcher Maybe (Id, Bool)
builder
                                       ([TyCoVarBinder]
univ_tvs, ThetaType
req_theta)
                                       ([TyCoVarBinder]
ex_tvs, ThetaType
prov_theta)
                                       ThetaType
arg_tys Type
pat_ty [FieldLabel]
field_labels }
       ; TyThing -> IfL TyThing
forall (m :: * -> *) a. Monad m => a -> m a
return (TyThing -> IfL TyThing) -> TyThing -> IfL TyThing
forall a b. (a -> b) -> a -> b
$ ConLike -> TyThing
AConLike (ConLike -> TyThing) -> (PatSyn -> ConLike) -> PatSyn -> TyThing
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatSyn -> ConLike
PatSynCon (PatSyn -> TyThing) -> PatSyn -> TyThing
forall a b. (a -> b) -> a -> b
$ PatSyn
patsyn }}}
  where
     mk_doc :: a -> SDoc
mk_doc a
n = String -> SDoc
text String
"Pattern synonym" SDoc -> SDoc -> SDoc
<+> a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
n
     tc_pr :: (IfExtName, Bool) -> IfL (Id, Bool)
     tc_pr :: (Name, Bool) -> IfL (Id, Bool)
tc_pr (Name
nm, Bool
b) = do { Id
id <- SDoc -> IfL Id -> IfL Id
forall a. SDoc -> IfL a -> IfL a
forkM (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
nm) (Name -> IfL Id
tcIfaceExtId Name
nm)
                        ; (Id, Bool) -> IfL (Id, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Id
id, Bool
b) }

tc_fd :: FunDep IfLclName -> IfL (FunDep TyVar)
tc_fd :: FunDep IfLclName -> IOEnv (Env IfGblEnv IfLclEnv) (FunDep Id)
tc_fd ([IfLclName]
tvs1, [IfLclName]
tvs2) = do { [Id]
tvs1' <- (IfLclName -> IfL Id)
-> [IfLclName] -> IOEnv (Env IfGblEnv IfLclEnv) [Id]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfLclName -> IfL Id
tcIfaceTyVar [IfLclName]
tvs1
                        ; [Id]
tvs2' <- (IfLclName -> IfL Id)
-> [IfLclName] -> IOEnv (Env IfGblEnv IfLclEnv) [Id]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfLclName -> IfL Id
tcIfaceTyVar [IfLclName]
tvs2
                        ; FunDep Id -> IOEnv (Env IfGblEnv IfLclEnv) (FunDep Id)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Id]
tvs1', [Id]
tvs2') }

tc_ax_branches :: [IfaceAxBranch] -> IfL [CoAxBranch]
tc_ax_branches :: [IfaceAxBranch] -> IfL [CoAxBranch]
tc_ax_branches [IfaceAxBranch]
if_branches = ([CoAxBranch] -> IfaceAxBranch -> IfL [CoAxBranch])
-> [CoAxBranch] -> [IfaceAxBranch] -> IfL [CoAxBranch]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM [CoAxBranch] -> IfaceAxBranch -> IfL [CoAxBranch]
tc_ax_branch [] [IfaceAxBranch]
if_branches

tc_ax_branch :: [CoAxBranch] -> IfaceAxBranch -> IfL [CoAxBranch]
tc_ax_branch :: [CoAxBranch] -> IfaceAxBranch -> IfL [CoAxBranch]
tc_ax_branch [CoAxBranch]
prev_branches
             (IfaceAxBranch { ifaxbTyVars :: IfaceAxBranch -> [IfaceTvBndr]
ifaxbTyVars = [IfaceTvBndr]
tv_bndrs
                            , ifaxbEtaTyVars :: IfaceAxBranch -> [IfaceTvBndr]
ifaxbEtaTyVars = [IfaceTvBndr]
eta_tv_bndrs
                            , ifaxbCoVars :: IfaceAxBranch -> [IfaceTvBndr]
ifaxbCoVars = [IfaceTvBndr]
cv_bndrs
                            , ifaxbLHS :: IfaceAxBranch -> IfaceAppArgs
ifaxbLHS = IfaceAppArgs
lhs, ifaxbRHS :: IfaceAxBranch -> IfaceType
ifaxbRHS = IfaceType
rhs
                            , ifaxbRoles :: IfaceAxBranch -> [Role]
ifaxbRoles = [Role]
roles, ifaxbIncomps :: IfaceAxBranch -> [Int]
ifaxbIncomps = [Int]
incomps })
  = [IfaceTyConBinder]
-> ([TyConBinder] -> IfL [CoAxBranch]) -> IfL [CoAxBranch]
forall a. [IfaceTyConBinder] -> ([TyConBinder] -> IfL a) -> IfL a
bindIfaceTyConBinders_AT
      ((IfaceTvBndr -> IfaceTyConBinder)
-> [IfaceTvBndr] -> [IfaceTyConBinder]
forall a b. (a -> b) -> [a] -> [b]
map (\IfaceTvBndr
b -> IfaceBndr -> TyConBndrVis -> IfaceTyConBinder
forall var argf. var -> argf -> VarBndr var argf
Bndr (IfaceTvBndr -> IfaceBndr
IfaceTvBndr IfaceTvBndr
b) (ArgFlag -> TyConBndrVis
NamedTCB ArgFlag
Inferred)) [IfaceTvBndr]
tv_bndrs) (([TyConBinder] -> IfL [CoAxBranch]) -> IfL [CoAxBranch])
-> ([TyConBinder] -> IfL [CoAxBranch]) -> IfL [CoAxBranch]
forall a b. (a -> b) -> a -> b
$ \ [TyConBinder]
tvs ->
         -- The _AT variant is needed here; see Note [CoAxBranch type variables] in CoAxiom
    [IfaceTvBndr] -> ([Id] -> IfL [CoAxBranch]) -> IfL [CoAxBranch]
forall a. [IfaceTvBndr] -> ([Id] -> IfL a) -> IfL a
bindIfaceIds [IfaceTvBndr]
cv_bndrs (([Id] -> IfL [CoAxBranch]) -> IfL [CoAxBranch])
-> ([Id] -> IfL [CoAxBranch]) -> IfL [CoAxBranch]
forall a b. (a -> b) -> a -> b
$ \ [Id]
cvs -> do
    { ThetaType
tc_lhs   <- IfaceAppArgs -> IfL ThetaType
tcIfaceAppArgs IfaceAppArgs
lhs
    ; Type
tc_rhs   <- IfaceType -> IfL Type
tcIfaceType IfaceType
rhs
    ; [Id]
eta_tvs  <- [IfaceTvBndr]
-> ([Id] -> IOEnv (Env IfGblEnv IfLclEnv) [Id])
-> IOEnv (Env IfGblEnv IfLclEnv) [Id]
forall a. [IfaceTvBndr] -> ([Id] -> IfL a) -> IfL a
bindIfaceTyVars [IfaceTvBndr]
eta_tv_bndrs [Id] -> IOEnv (Env IfGblEnv IfLclEnv) [Id]
forall (m :: * -> *) a. Monad m => a -> m a
return
    ; Module
this_mod <- IfL Module
getIfModule
    ; let loc :: SrcSpan
loc = IfLclName -> SrcSpan
mkGeneralSrcSpan (String -> IfLclName
fsLit String
"module " IfLclName -> IfLclName -> IfLclName
`appendFS`
                                  ModuleName -> IfLclName
moduleNameFS (Module -> ModuleName
moduleName Module
this_mod))
          br :: CoAxBranch
br = CoAxBranch :: SrcSpan
-> [Id]
-> [Id]
-> [Id]
-> [Role]
-> ThetaType
-> Type
-> [CoAxBranch]
-> CoAxBranch
CoAxBranch { cab_loc :: SrcSpan
cab_loc     = SrcSpan
loc
                          , cab_tvs :: [Id]
cab_tvs     = [TyConBinder] -> [Id]
forall tv argf. [VarBndr tv argf] -> [tv]
binderVars [TyConBinder]
tvs
                          , cab_eta_tvs :: [Id]
cab_eta_tvs = [Id]
eta_tvs
                          , cab_cvs :: [Id]
cab_cvs     = [Id]
cvs
                          , cab_lhs :: ThetaType
cab_lhs     = ThetaType
tc_lhs
                          , cab_roles :: [Role]
cab_roles   = [Role]
roles
                          , cab_rhs :: Type
cab_rhs     = Type
tc_rhs
                          , cab_incomps :: [CoAxBranch]
cab_incomps = (Int -> CoAxBranch) -> [Int] -> [CoAxBranch]
forall a b. (a -> b) -> [a] -> [b]
map ([CoAxBranch]
prev_branches [CoAxBranch] -> Int -> CoAxBranch
forall a. Outputable a => [a] -> Int -> a
`getNth`) [Int]
incomps }
    ; [CoAxBranch] -> IfL [CoAxBranch]
forall (m :: * -> *) a. Monad m => a -> m a
return ([CoAxBranch]
prev_branches [CoAxBranch] -> [CoAxBranch] -> [CoAxBranch]
forall a. [a] -> [a] -> [a]
++ [CoAxBranch
br]) }

tcIfaceDataCons :: Name -> TyCon -> [TyConBinder] -> IfaceConDecls -> IfL AlgTyConRhs
tcIfaceDataCons :: Name -> TyCon -> [TyConBinder] -> IfaceConDecls -> IfL AlgTyConRhs
tcIfaceDataCons Name
tycon_name TyCon
tycon [TyConBinder]
tc_tybinders IfaceConDecls
if_cons
  = case IfaceConDecls
if_cons of
        IfaceConDecls
IfAbstractTyCon  -> AlgTyConRhs -> IfL AlgTyConRhs
forall (m :: * -> *) a. Monad m => a -> m a
return AlgTyConRhs
AbstractTyCon
        IfDataTyCon [IfaceConDecl]
cons -> do  { [DataCon]
data_cons  <- (IfaceConDecl -> IOEnv (Env IfGblEnv IfLclEnv) DataCon)
-> [IfaceConDecl] -> IOEnv (Env IfGblEnv IfLclEnv) [DataCon]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceConDecl -> IOEnv (Env IfGblEnv IfLclEnv) DataCon
tc_con_decl [IfaceConDecl]
cons
                                ; AlgTyConRhs -> IfL AlgTyConRhs
forall (m :: * -> *) a. Monad m => a -> m a
return ([DataCon] -> AlgTyConRhs
mkDataTyConRhs [DataCon]
data_cons) }
        IfNewTyCon  IfaceConDecl
con  -> do  { DataCon
data_con  <- IfaceConDecl -> IOEnv (Env IfGblEnv IfLclEnv) DataCon
tc_con_decl IfaceConDecl
con
                                ; Name -> TyCon -> DataCon -> IfL AlgTyConRhs
forall m n. Name -> TyCon -> DataCon -> TcRnIf m n AlgTyConRhs
mkNewTyConRhs Name
tycon_name TyCon
tycon DataCon
data_con }
  where
    univ_tvs :: [TyVar]
    univ_tvs :: [Id]
univ_tvs = [TyCoVarBinder] -> [Id]
forall tv argf. [VarBndr tv argf] -> [tv]
binderVars ([TyConBinder] -> [TyCoVarBinder]
tyConTyVarBinders [TyConBinder]
tc_tybinders)

    tag_map :: NameEnv ConTag
    tag_map :: NameEnv Int
tag_map = TyCon -> NameEnv Int
mkTyConTagMap TyCon
tycon

    tc_con_decl :: IfaceConDecl -> IOEnv (Env IfGblEnv IfLclEnv) DataCon
tc_con_decl (IfCon { ifConInfix :: IfaceConDecl -> Bool
ifConInfix = Bool
is_infix,
                         ifConExTCvs :: IfaceConDecl -> [IfaceBndr]
ifConExTCvs = [IfaceBndr]
ex_bndrs,
                         ifConUserTvBinders :: IfaceConDecl -> [IfaceForAllBndr]
ifConUserTvBinders = [IfaceForAllBndr]
user_bndrs,
                         ifConName :: IfaceConDecl -> Name
ifConName = Name
dc_name,
                         ifConCtxt :: IfaceConDecl -> IfaceContext
ifConCtxt = IfaceContext
ctxt, ifConEqSpec :: IfaceConDecl -> [IfaceTvBndr]
ifConEqSpec = [IfaceTvBndr]
spec,
                         ifConArgTys :: IfaceConDecl -> IfaceContext
ifConArgTys = IfaceContext
args, ifConFields :: IfaceConDecl -> [FieldLabel]
ifConFields = [FieldLabel]
lbl_names,
                         ifConStricts :: IfaceConDecl -> [IfaceBang]
ifConStricts = [IfaceBang]
if_stricts,
                         ifConSrcStricts :: IfaceConDecl -> [IfaceSrcBang]
ifConSrcStricts = [IfaceSrcBang]
if_src_stricts})
     = -- Universally-quantified tyvars are shared with
       -- parent TyCon, and are already in scope
       [IfaceBndr]
-> ([Id] -> IOEnv (Env IfGblEnv IfLclEnv) DataCon)
-> IOEnv (Env IfGblEnv IfLclEnv) DataCon
forall a. [IfaceBndr] -> ([Id] -> IfL a) -> IfL a
bindIfaceBndrs [IfaceBndr]
ex_bndrs    (([Id] -> IOEnv (Env IfGblEnv IfLclEnv) DataCon)
 -> IOEnv (Env IfGblEnv IfLclEnv) DataCon)
-> ([Id] -> IOEnv (Env IfGblEnv IfLclEnv) DataCon)
-> IOEnv (Env IfGblEnv IfLclEnv) DataCon
forall a b. (a -> b) -> a -> b
$ \ [Id]
ex_tvs -> do
        { SDoc -> TcRnIf IfGblEnv IfLclEnv ()
forall m n. SDoc -> TcRnIf m n ()
traceIf (String -> SDoc
text String
"Start interface-file tc_con_decl" SDoc -> SDoc -> SDoc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
dc_name)

          -- By this point, we have bound every universal and existential
          -- tyvar. Because of the dcUserTyVarBinders invariant
          -- (see Note [DataCon user type variable binders]), *every* tyvar in
          -- ifConUserTvBinders has a matching counterpart somewhere in the
          -- bound universals/existentials. As a result, calling tcIfaceTyVar
          -- below is always guaranteed to succeed.
        ; [TyCoVarBinder]
user_tv_bndrs <- (IfaceForAllBndr -> IOEnv (Env IfGblEnv IfLclEnv) TyCoVarBinder)
-> [IfaceForAllBndr]
-> IOEnv (Env IfGblEnv IfLclEnv) [TyCoVarBinder]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(Bndr IfaceBndr
bd ArgFlag
vis) ->
                                   case IfaceBndr
bd of
                                     IfaceIdBndr (IfLclName
name, IfaceType
_) ->
                                       Id -> ArgFlag -> TyCoVarBinder
forall var argf. var -> argf -> VarBndr var argf
Bndr (Id -> ArgFlag -> TyCoVarBinder)
-> IfL Id
-> IOEnv (Env IfGblEnv IfLclEnv) (ArgFlag -> TyCoVarBinder)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfLclName -> IfL Id
tcIfaceLclId IfLclName
name IOEnv (Env IfGblEnv IfLclEnv) (ArgFlag -> TyCoVarBinder)
-> IOEnv (Env IfGblEnv IfLclEnv) ArgFlag
-> IOEnv (Env IfGblEnv IfLclEnv) TyCoVarBinder
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ArgFlag -> IOEnv (Env IfGblEnv IfLclEnv) ArgFlag
forall (f :: * -> *) a. Applicative f => a -> f a
pure ArgFlag
vis
                                     IfaceTvBndr (IfLclName
name, IfaceType
_) ->
                                       Id -> ArgFlag -> TyCoVarBinder
forall var argf. var -> argf -> VarBndr var argf
Bndr (Id -> ArgFlag -> TyCoVarBinder)
-> IfL Id
-> IOEnv (Env IfGblEnv IfLclEnv) (ArgFlag -> TyCoVarBinder)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfLclName -> IfL Id
tcIfaceTyVar IfLclName
name IOEnv (Env IfGblEnv IfLclEnv) (ArgFlag -> TyCoVarBinder)
-> IOEnv (Env IfGblEnv IfLclEnv) ArgFlag
-> IOEnv (Env IfGblEnv IfLclEnv) TyCoVarBinder
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ArgFlag -> IOEnv (Env IfGblEnv IfLclEnv) ArgFlag
forall (f :: * -> *) a. Applicative f => a -> f a
pure ArgFlag
vis)
                                [IfaceForAllBndr]
user_bndrs

        -- Read the context and argument types, but lazily for two reasons
        -- (a) to avoid looking tugging on a recursive use of
        --     the type itself, which is knot-tied
        -- (b) to avoid faulting in the component types unless
        --     they are really needed
        ; ~([EqSpec]
eq_spec, ThetaType
theta, ThetaType
arg_tys, [HsImplBang]
stricts) <- SDoc
-> IfL ([EqSpec], ThetaType, ThetaType, [HsImplBang])
-> IfL ([EqSpec], ThetaType, ThetaType, [HsImplBang])
forall a. SDoc -> IfL a -> IfL a
forkM (Name -> SDoc
forall a. Outputable a => a -> SDoc
mk_doc Name
dc_name) (IfL ([EqSpec], ThetaType, ThetaType, [HsImplBang])
 -> IfL ([EqSpec], ThetaType, ThetaType, [HsImplBang]))
-> IfL ([EqSpec], ThetaType, ThetaType, [HsImplBang])
-> IfL ([EqSpec], ThetaType, ThetaType, [HsImplBang])
forall a b. (a -> b) -> a -> b
$
             do { [EqSpec]
eq_spec <- [IfaceTvBndr] -> IfL [EqSpec]
tcIfaceEqSpec [IfaceTvBndr]
spec
                ; ThetaType
theta   <- IfaceContext -> IfL ThetaType
tcIfaceCtxt IfaceContext
ctxt
                -- This fixes #13710.  The enclosing lazy thunk gets
                -- forced when typechecking record wildcard pattern
                -- matching (it's not completely clear why this
                -- tuple is needed), which causes trouble if one of
                -- the argument types was recursively defined.
                -- See also Note [Tying the knot]
                ; ThetaType
arg_tys <- SDoc -> IfL ThetaType -> IfL ThetaType
forall a. SDoc -> IfL a -> IfL a
forkM (Name -> SDoc
forall a. Outputable a => a -> SDoc
mk_doc Name
dc_name SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"arg_tys")
                           (IfL ThetaType -> IfL ThetaType) -> IfL ThetaType -> IfL ThetaType
forall a b. (a -> b) -> a -> b
$ (IfaceType -> IfL Type) -> IfaceContext -> IfL ThetaType
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceType -> IfL Type
tcIfaceType IfaceContext
args
                ; [HsImplBang]
stricts <- (IfaceBang -> IOEnv (Env IfGblEnv IfLclEnv) HsImplBang)
-> [IfaceBang] -> IOEnv (Env IfGblEnv IfLclEnv) [HsImplBang]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceBang -> IOEnv (Env IfGblEnv IfLclEnv) HsImplBang
tc_strict [IfaceBang]
if_stricts
                        -- The IfBang field can mention
                        -- the type itself; hence inside forkM
                ; ([EqSpec], ThetaType, ThetaType, [HsImplBang])
-> IfL ([EqSpec], ThetaType, ThetaType, [HsImplBang])
forall (m :: * -> *) a. Monad m => a -> m a
return ([EqSpec]
eq_spec, ThetaType
theta, ThetaType
arg_tys, [HsImplBang]
stricts) }

        -- Remember, tycon is the representation tycon
        ; let orig_res_ty :: Type
orig_res_ty = TyCon -> ThetaType -> Type
mkFamilyTyConApp TyCon
tycon
                              (TCvSubst -> [Id] -> ThetaType
substTyCoVars ([(Id, Type)] -> TCvSubst
mkTvSubstPrs ((EqSpec -> (Id, Type)) -> [EqSpec] -> [(Id, Type)]
forall a b. (a -> b) -> [a] -> [b]
map EqSpec -> (Id, Type)
eqSpecPair [EqSpec]
eq_spec))
                                             ([TyConBinder] -> [Id]
forall tv argf. [VarBndr tv argf] -> [tv]
binderVars [TyConBinder]
tc_tybinders))

        ; Name
prom_rep_name <- Name -> TcRnIf IfGblEnv IfLclEnv Name
forall gbl lcl. Name -> TcRnIf gbl lcl Name
newTyConRepName Name
dc_name

        ; DataCon
con <- FamInstEnvs
-> Name
-> Bool
-> Name
-> [HsSrcBang]
-> Maybe [HsImplBang]
-> [FieldLabel]
-> [Id]
-> [Id]
-> [TyCoVarBinder]
-> [EqSpec]
-> ThetaType
-> ThetaType
-> Type
-> TyCon
-> NameEnv Int
-> IOEnv (Env IfGblEnv IfLclEnv) DataCon
forall m n.
FamInstEnvs
-> Name
-> Bool
-> Name
-> [HsSrcBang]
-> Maybe [HsImplBang]
-> [FieldLabel]
-> [Id]
-> [Id]
-> [TyCoVarBinder]
-> [EqSpec]
-> ThetaType
-> ThetaType
-> Type
-> TyCon
-> NameEnv Int
-> TcRnIf m n DataCon
buildDataCon (String -> SDoc -> FamInstEnvs
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tcIfaceDataCons: FamInstEnvs" (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
dc_name))
                       Name
dc_name Bool
is_infix Name
prom_rep_name
                       ((IfaceSrcBang -> HsSrcBang) -> [IfaceSrcBang] -> [HsSrcBang]
forall a b. (a -> b) -> [a] -> [b]
map IfaceSrcBang -> HsSrcBang
src_strict [IfaceSrcBang]
if_src_stricts)
                       ([HsImplBang] -> Maybe [HsImplBang]
forall a. a -> Maybe a
Just [HsImplBang]
stricts)
                       -- Pass the HsImplBangs (i.e. final
                       -- decisions) to buildDataCon; it'll use
                       -- these to guide the construction of a
                       -- worker.
                       -- See Note [Bangs on imported data constructors] in MkId
                       [FieldLabel]
lbl_names
                       [Id]
univ_tvs [Id]
ex_tvs [TyCoVarBinder]
user_tv_bndrs
                       [EqSpec]
eq_spec ThetaType
theta
                       ThetaType
arg_tys Type
orig_res_ty TyCon
tycon NameEnv Int
tag_map
        ; SDoc -> TcRnIf IfGblEnv IfLclEnv ()
forall m n. SDoc -> TcRnIf m n ()
traceIf (String -> SDoc
text String
"Done interface-file tc_con_decl" SDoc -> SDoc -> SDoc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
dc_name)
        ; DataCon -> IOEnv (Env IfGblEnv IfLclEnv) DataCon
forall (m :: * -> *) a. Monad m => a -> m a
return DataCon
con }
    mk_doc :: a -> SDoc
mk_doc a
con_name = String -> SDoc
text String
"Constructor" SDoc -> SDoc -> SDoc
<+> a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
con_name

    tc_strict :: IfaceBang -> IfL HsImplBang
    tc_strict :: IfaceBang -> IOEnv (Env IfGblEnv IfLclEnv) HsImplBang
tc_strict IfaceBang
IfNoBang = HsImplBang -> IOEnv (Env IfGblEnv IfLclEnv) HsImplBang
forall (m :: * -> *) a. Monad m => a -> m a
return (HsImplBang
HsLazy)
    tc_strict IfaceBang
IfStrict = HsImplBang -> IOEnv (Env IfGblEnv IfLclEnv) HsImplBang
forall (m :: * -> *) a. Monad m => a -> m a
return (HsImplBang
HsStrict)
    tc_strict IfaceBang
IfUnpack = HsImplBang -> IOEnv (Env IfGblEnv IfLclEnv) HsImplBang
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Coercion -> HsImplBang
HsUnpack Maybe Coercion
forall a. Maybe a
Nothing)
    tc_strict (IfUnpackCo IfaceCoercion
if_co) = do { Coercion
co <- IfaceCoercion -> IfL Coercion
tcIfaceCo IfaceCoercion
if_co
                                      ; HsImplBang -> IOEnv (Env IfGblEnv IfLclEnv) HsImplBang
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Coercion -> HsImplBang
HsUnpack (Coercion -> Maybe Coercion
forall a. a -> Maybe a
Just Coercion
co)) }

    src_strict :: IfaceSrcBang -> HsSrcBang
    src_strict :: IfaceSrcBang -> HsSrcBang
src_strict (IfSrcBang SrcUnpackedness
unpk SrcStrictness
bang) = SourceText -> SrcUnpackedness -> SrcStrictness -> HsSrcBang
HsSrcBang SourceText
NoSourceText SrcUnpackedness
unpk SrcStrictness
bang

tcIfaceEqSpec :: IfaceEqSpec -> IfL [EqSpec]
tcIfaceEqSpec :: [IfaceTvBndr] -> IfL [EqSpec]
tcIfaceEqSpec [IfaceTvBndr]
spec
  = (IfaceTvBndr -> IOEnv (Env IfGblEnv IfLclEnv) EqSpec)
-> [IfaceTvBndr] -> IfL [EqSpec]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceTvBndr -> IOEnv (Env IfGblEnv IfLclEnv) EqSpec
do_item [IfaceTvBndr]
spec
  where
    do_item :: IfaceTvBndr -> IOEnv (Env IfGblEnv IfLclEnv) EqSpec
do_item (IfLclName
occ, IfaceType
if_ty) = do { Id
tv <- IfLclName -> IfL Id
tcIfaceTyVar IfLclName
occ
                              ; Type
ty <- IfaceType -> IfL Type
tcIfaceType IfaceType
if_ty
                              ; EqSpec -> IOEnv (Env IfGblEnv IfLclEnv) EqSpec
forall (m :: * -> *) a. Monad m => a -> m a
return (Id -> Type -> EqSpec
mkEqSpec Id
tv Type
ty) }

{-
Note [Synonym kind loop]
~~~~~~~~~~~~~~~~~~~~~~~~
Notice that we eagerly grab the *kind* from the interface file, but
build a forkM thunk for the *rhs* (and family stuff).  To see why,
consider this (#2412)

M.hs:       module M where { import X; data T = MkT S }
X.hs:       module X where { import {-# SOURCE #-} M; type S = T }
M.hs-boot:  module M where { data T }

When kind-checking M.hs we need S's kind.  But we do not want to
find S's kind from (typeKind S-rhs), because we don't want to look at
S-rhs yet!  Since S is imported from X.hi, S gets just one chance to
be defined, and we must not do that until we've finished with M.T.

Solution: record S's kind in the interface file; now we can safely
look at it.

************************************************************************
*                                                                      *
                Instances
*                                                                      *
************************************************************************
-}

tcIfaceInst :: IfaceClsInst -> IfL ClsInst
tcIfaceInst :: IfaceClsInst -> IOEnv (Env IfGblEnv IfLclEnv) ClsInst
tcIfaceInst (IfaceClsInst { ifDFun :: IfaceClsInst -> Name
ifDFun = Name
dfun_name, ifOFlag :: IfaceClsInst -> OverlapFlag
ifOFlag = OverlapFlag
oflag
                          , ifInstCls :: IfaceClsInst -> Name
ifInstCls = Name
cls, ifInstTys :: IfaceClsInst -> [Maybe IfaceTyCon]
ifInstTys = [Maybe IfaceTyCon]
mb_tcs
                          , ifInstOrph :: IfaceClsInst -> IsOrphan
ifInstOrph = IsOrphan
orph })
  = do { Id
dfun <- SDoc -> IfL Id -> IfL Id
forall a. SDoc -> IfL a -> IfL a
forkM (String -> SDoc
text String
"Dict fun" SDoc -> SDoc -> SDoc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
dfun_name) (IfL Id -> IfL Id) -> IfL Id -> IfL Id
forall a b. (a -> b) -> a -> b
$
                    (TyThing -> Id) -> IfL TyThing -> IfL Id
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TyThing -> Id
tyThingId (Name -> IfL TyThing
tcIfaceImplicit Name
dfun_name)
       ; let mb_tcs' :: [Maybe Name]
mb_tcs' = (Maybe IfaceTyCon -> Maybe Name)
-> [Maybe IfaceTyCon] -> [Maybe Name]
forall a b. (a -> b) -> [a] -> [b]
map ((IfaceTyCon -> Name) -> Maybe IfaceTyCon -> Maybe Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IfaceTyCon -> Name
ifaceTyConName) [Maybe IfaceTyCon]
mb_tcs
       ; ClsInst -> IOEnv (Env IfGblEnv IfLclEnv) ClsInst
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
-> [Maybe Name] -> Name -> Id -> OverlapFlag -> IsOrphan -> ClsInst
mkImportedInstance Name
cls [Maybe Name]
mb_tcs' Name
dfun_name Id
dfun OverlapFlag
oflag IsOrphan
orph) }

tcIfaceFamInst :: IfaceFamInst -> IfL FamInst
tcIfaceFamInst :: IfaceFamInst -> IOEnv (Env IfGblEnv IfLclEnv) FamInst
tcIfaceFamInst (IfaceFamInst { ifFamInstFam :: IfaceFamInst -> Name
ifFamInstFam = Name
fam, ifFamInstTys :: IfaceFamInst -> [Maybe IfaceTyCon]
ifFamInstTys = [Maybe IfaceTyCon]
mb_tcs
                             , ifFamInstAxiom :: IfaceFamInst -> Name
ifFamInstAxiom = Name
axiom_name } )
    = do { CoAxiom Branched
axiom' <- SDoc -> IfL (CoAxiom Branched) -> IfL (CoAxiom Branched)
forall a. SDoc -> IfL a -> IfL a
forkM (String -> SDoc
text String
"Axiom" SDoc -> SDoc -> SDoc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
axiom_name) (IfL (CoAxiom Branched) -> IfL (CoAxiom Branched))
-> IfL (CoAxiom Branched) -> IfL (CoAxiom Branched)
forall a b. (a -> b) -> a -> b
$
                     Name -> IfL (CoAxiom Branched)
tcIfaceCoAxiom Name
axiom_name
             -- will panic if branched, but that's OK
         ; let axiom'' :: CoAxiom Unbranched
axiom'' = CoAxiom Branched -> CoAxiom Unbranched
forall (br :: BranchFlag). CoAxiom br -> CoAxiom Unbranched
toUnbranchedAxiom CoAxiom Branched
axiom'
               mb_tcs' :: [Maybe Name]
mb_tcs' = (Maybe IfaceTyCon -> Maybe Name)
-> [Maybe IfaceTyCon] -> [Maybe Name]
forall a b. (a -> b) -> [a] -> [b]
map ((IfaceTyCon -> Name) -> Maybe IfaceTyCon -> Maybe Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IfaceTyCon -> Name
ifaceTyConName) [Maybe IfaceTyCon]
mb_tcs
         ; FamInst -> IOEnv (Env IfGblEnv IfLclEnv) FamInst
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> [Maybe Name] -> CoAxiom Unbranched -> FamInst
mkImportedFamInst Name
fam [Maybe Name]
mb_tcs' CoAxiom Unbranched
axiom'') }

{-
************************************************************************
*                                                                      *
                Rules
*                                                                      *
************************************************************************

We move a IfaceRule from eps_rules to eps_rule_base when all its LHS free vars
are in the type environment.  However, remember that typechecking a Rule may
(as a side effect) augment the type envt, and so we may need to iterate the process.
-}

tcIfaceRules :: Bool            -- True <=> ignore rules
             -> [IfaceRule]
             -> IfL [CoreRule]
tcIfaceRules :: Bool -> [IfaceRule] -> IfL [CoreRule]
tcIfaceRules Bool
ignore_prags [IfaceRule]
if_rules
  | Bool
ignore_prags = [CoreRule] -> IfL [CoreRule]
forall (m :: * -> *) a. Monad m => a -> m a
return []
  | Bool
otherwise    = (IfaceRule -> IOEnv (Env IfGblEnv IfLclEnv) CoreRule)
-> [IfaceRule] -> IfL [CoreRule]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceRule -> IOEnv (Env IfGblEnv IfLclEnv) CoreRule
tcIfaceRule [IfaceRule]
if_rules

tcIfaceRule :: IfaceRule -> IfL CoreRule
tcIfaceRule :: IfaceRule -> IOEnv (Env IfGblEnv IfLclEnv) CoreRule
tcIfaceRule (IfaceRule {ifRuleName :: IfaceRule -> IfLclName
ifRuleName = IfLclName
name, ifActivation :: IfaceRule -> Activation
ifActivation = Activation
act, ifRuleBndrs :: IfaceRule -> [IfaceBndr]
ifRuleBndrs = [IfaceBndr]
bndrs,
                        ifRuleHead :: IfaceRule -> Name
ifRuleHead = Name
fn, ifRuleArgs :: IfaceRule -> [IfaceExpr]
ifRuleArgs = [IfaceExpr]
args, ifRuleRhs :: IfaceRule -> IfaceExpr
ifRuleRhs = IfaceExpr
rhs,
                        ifRuleAuto :: IfaceRule -> Bool
ifRuleAuto = Bool
auto, ifRuleOrph :: IfaceRule -> IsOrphan
ifRuleOrph = IsOrphan
orph })
  = do  { ~([Id]
bndrs', [CoreExpr]
args', CoreExpr
rhs') <-
                -- Typecheck the payload lazily, in the hope it'll never be looked at
                SDoc
-> IfL ([Id], [CoreExpr], CoreExpr)
-> IfL ([Id], [CoreExpr], CoreExpr)
forall a. SDoc -> IfL a -> IfL a
forkM (String -> SDoc
text String
"Rule" SDoc -> SDoc -> SDoc
<+> IfLclName -> SDoc
pprRuleName IfLclName
name) (IfL ([Id], [CoreExpr], CoreExpr)
 -> IfL ([Id], [CoreExpr], CoreExpr))
-> IfL ([Id], [CoreExpr], CoreExpr)
-> IfL ([Id], [CoreExpr], CoreExpr)
forall a b. (a -> b) -> a -> b
$
                [IfaceBndr]
-> ([Id] -> IfL ([Id], [CoreExpr], CoreExpr))
-> IfL ([Id], [CoreExpr], CoreExpr)
forall a. [IfaceBndr] -> ([Id] -> IfL a) -> IfL a
bindIfaceBndrs [IfaceBndr]
bndrs                      (([Id] -> IfL ([Id], [CoreExpr], CoreExpr))
 -> IfL ([Id], [CoreExpr], CoreExpr))
-> ([Id] -> IfL ([Id], [CoreExpr], CoreExpr))
-> IfL ([Id], [CoreExpr], CoreExpr)
forall a b. (a -> b) -> a -> b
$ \ [Id]
bndrs' ->
                do { [CoreExpr]
args' <- (IfaceExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr)
-> [IfaceExpr] -> IOEnv (Env IfGblEnv IfLclEnv) [CoreExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
tcIfaceExpr [IfaceExpr]
args
                   ; CoreExpr
rhs'  <- IfaceExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
tcIfaceExpr IfaceExpr
rhs
                   ; ([Id], [CoreExpr], CoreExpr) -> IfL ([Id], [CoreExpr], CoreExpr)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Id]
bndrs', [CoreExpr]
args', CoreExpr
rhs') }
        ; let mb_tcs :: [Maybe Name]
mb_tcs = (IfaceExpr -> Maybe Name) -> [IfaceExpr] -> [Maybe Name]
forall a b. (a -> b) -> [a] -> [b]
map IfaceExpr -> Maybe Name
ifTopFreeName [IfaceExpr]
args
        ; Module
this_mod <- IfL Module
getIfModule
        ; CoreRule -> IOEnv (Env IfGblEnv IfLclEnv) CoreRule
forall (m :: * -> *) a. Monad m => a -> m a
return (Rule :: IfLclName
-> Activation
-> Name
-> [Maybe Name]
-> [Id]
-> [CoreExpr]
-> CoreExpr
-> Bool
-> Module
-> IsOrphan
-> Bool
-> CoreRule
Rule { ru_name :: IfLclName
ru_name = IfLclName
name, ru_fn :: Name
ru_fn = Name
fn, ru_act :: Activation
ru_act = Activation
act,
                          ru_bndrs :: [Id]
ru_bndrs = [Id]
bndrs', ru_args :: [CoreExpr]
ru_args = [CoreExpr]
args',
                          ru_rhs :: CoreExpr
ru_rhs = CoreExpr -> CoreExpr
occurAnalyseExpr CoreExpr
rhs',
                          ru_rough :: [Maybe Name]
ru_rough = [Maybe Name]
mb_tcs,
                          ru_origin :: Module
ru_origin = Module
this_mod,
                          ru_orphan :: IsOrphan
ru_orphan = IsOrphan
orph,
                          ru_auto :: Bool
ru_auto = Bool
auto,
                          ru_local :: Bool
ru_local = Bool
False }) } -- An imported RULE is never for a local Id
                                                -- or, even if it is (module loop, perhaps)
                                                -- we'll just leave it in the non-local set
  where
        -- This function *must* mirror exactly what Rules.roughTopNames does
        -- We could have stored the ru_rough field in the iface file
        -- but that would be redundant, I think.
        -- The only wrinkle is that we must not be deceived by
        -- type synonyms at the top of a type arg.  Since
        -- we can't tell at this point, we are careful not
        -- to write them out in coreRuleToIfaceRule
    ifTopFreeName :: IfaceExpr -> Maybe Name
    ifTopFreeName :: IfaceExpr -> Maybe Name
ifTopFreeName (IfaceType (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
_ )) = Name -> Maybe Name
forall a. a -> Maybe a
Just (IfaceTyCon -> Name
ifaceTyConName IfaceTyCon
tc)
    ifTopFreeName (IfaceType (IfaceTupleTy TupleSort
s PromotionFlag
_ IfaceAppArgs
ts)) = Name -> Maybe Name
forall a. a -> Maybe a
Just (TupleSort -> Int -> Name
tupleTyConName TupleSort
s (IfaceContext -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (IfaceAppArgs -> IfaceContext
appArgsIfaceTypes IfaceAppArgs
ts)))
    ifTopFreeName (IfaceApp IfaceExpr
f IfaceExpr
_)                    = IfaceExpr -> Maybe Name
ifTopFreeName IfaceExpr
f
    ifTopFreeName (IfaceExt Name
n)                      = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n
    ifTopFreeName IfaceExpr
_                                 = Maybe Name
forall a. Maybe a
Nothing

{-
************************************************************************
*                                                                      *
                Annotations
*                                                                      *
************************************************************************
-}

tcIfaceAnnotations :: [IfaceAnnotation] -> IfL [Annotation]
tcIfaceAnnotations :: [IfaceAnnotation] -> IfL [Annotation]
tcIfaceAnnotations = (IfaceAnnotation -> IOEnv (Env IfGblEnv IfLclEnv) Annotation)
-> [IfaceAnnotation] -> IfL [Annotation]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceAnnotation -> IOEnv (Env IfGblEnv IfLclEnv) Annotation
tcIfaceAnnotation

tcIfaceAnnotation :: IfaceAnnotation -> IfL Annotation
tcIfaceAnnotation :: IfaceAnnotation -> IOEnv (Env IfGblEnv IfLclEnv) Annotation
tcIfaceAnnotation (IfaceAnnotation IfaceAnnTarget
target AnnPayload
serialized) = do
    AnnTarget Name
target' <- IfaceAnnTarget -> IfL (AnnTarget Name)
tcIfaceAnnTarget IfaceAnnTarget
target
    Annotation -> IOEnv (Env IfGblEnv IfLclEnv) Annotation
forall (m :: * -> *) a. Monad m => a -> m a
return (Annotation -> IOEnv (Env IfGblEnv IfLclEnv) Annotation)
-> Annotation -> IOEnv (Env IfGblEnv IfLclEnv) Annotation
forall a b. (a -> b) -> a -> b
$ Annotation :: AnnTarget Name -> AnnPayload -> Annotation
Annotation {
        ann_target :: AnnTarget Name
ann_target = AnnTarget Name
target',
        ann_value :: AnnPayload
ann_value = AnnPayload
serialized
    }

tcIfaceAnnTarget :: IfaceAnnTarget -> IfL (AnnTarget Name)
tcIfaceAnnTarget :: IfaceAnnTarget -> IfL (AnnTarget Name)
tcIfaceAnnTarget (NamedTarget OccName
occ) = do
    Name
name <- OccName -> TcRnIf IfGblEnv IfLclEnv Name
lookupIfaceTop OccName
occ
    AnnTarget Name -> IfL (AnnTarget Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (AnnTarget Name -> IfL (AnnTarget Name))
-> AnnTarget Name -> IfL (AnnTarget Name)
forall a b. (a -> b) -> a -> b
$ Name -> AnnTarget Name
forall name. name -> AnnTarget name
NamedTarget Name
name
tcIfaceAnnTarget (ModuleTarget Module
mod) = do
    AnnTarget Name -> IfL (AnnTarget Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (AnnTarget Name -> IfL (AnnTarget Name))
-> AnnTarget Name -> IfL (AnnTarget Name)
forall a b. (a -> b) -> a -> b
$ Module -> AnnTarget Name
forall name. Module -> AnnTarget name
ModuleTarget Module
mod

{-
************************************************************************
*                                                                      *
                Complete Match Pragmas
*                                                                      *
************************************************************************
-}

tcIfaceCompleteSigs :: [IfaceCompleteMatch] -> IfL [CompleteMatch]
tcIfaceCompleteSigs :: [IfaceCompleteMatch] -> IfL [CompleteMatch]
tcIfaceCompleteSigs = (IfaceCompleteMatch -> IOEnv (Env IfGblEnv IfLclEnv) CompleteMatch)
-> [IfaceCompleteMatch] -> IfL [CompleteMatch]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceCompleteMatch -> IOEnv (Env IfGblEnv IfLclEnv) CompleteMatch
tcIfaceCompleteSig

tcIfaceCompleteSig :: IfaceCompleteMatch -> IfL CompleteMatch
tcIfaceCompleteSig :: IfaceCompleteMatch -> IOEnv (Env IfGblEnv IfLclEnv) CompleteMatch
tcIfaceCompleteSig (IfaceCompleteMatch [Name]
ms Name
t) = CompleteMatch -> IOEnv (Env IfGblEnv IfLclEnv) CompleteMatch
forall (m :: * -> *) a. Monad m => a -> m a
return ([Name] -> Name -> CompleteMatch
CompleteMatch [Name]
ms Name
t)

{-
************************************************************************
*                                                                      *
                        Types
*                                                                      *
************************************************************************
-}

tcIfaceType :: IfaceType -> IfL Type
tcIfaceType :: IfaceType -> IfL Type
tcIfaceType = IfaceType -> IfL Type
go
  where
    go :: IfaceType -> IfL Type
go (IfaceTyVar IfLclName
n)          = Id -> Type
TyVarTy (Id -> Type) -> IfL Id -> IfL Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfLclName -> IfL Id
tcIfaceTyVar IfLclName
n
    go (IfaceFreeTyVar Id
n)      = String -> SDoc -> IfL Type
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tcIfaceType:IfaceFreeTyVar" (Id -> SDoc
forall a. Outputable a => a -> SDoc
ppr Id
n)
    go (IfaceLitTy IfaceTyLit
l)          = TyLit -> Type
LitTy (TyLit -> Type) -> IOEnv (Env IfGblEnv IfLclEnv) TyLit -> IfL Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceTyLit -> IOEnv (Env IfGblEnv IfLclEnv) TyLit
tcIfaceTyLit IfaceTyLit
l
    go (IfaceFunTy AnonArgFlag
flag IfaceType
t1 IfaceType
t2) = AnonArgFlag -> Type -> Type -> Type
FunTy AnonArgFlag
flag (Type -> Type -> Type)
-> IfL Type -> IOEnv (Env IfGblEnv IfLclEnv) (Type -> Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceType -> IfL Type
go IfaceType
t1 IOEnv (Env IfGblEnv IfLclEnv) (Type -> Type)
-> IfL Type -> IfL Type
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IfaceType -> IfL Type
go IfaceType
t2
    go (IfaceTupleTy TupleSort
s PromotionFlag
i IfaceAppArgs
tks)  = TupleSort -> PromotionFlag -> IfaceAppArgs -> IfL Type
tcIfaceTupleTy TupleSort
s PromotionFlag
i IfaceAppArgs
tks
    go (IfaceAppTy IfaceType
t IfaceAppArgs
ts)
      = do { Type
t'  <- IfaceType -> IfL Type
go IfaceType
t
           ; ThetaType
ts' <- (IfaceType -> IfL Type) -> IfaceContext -> IfL ThetaType
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse IfaceType -> IfL Type
go (IfaceAppArgs -> IfaceContext
appArgsIfaceTypes IfaceAppArgs
ts)
           ; Type -> IfL Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Type -> Type -> Type) -> Type -> ThetaType -> Type
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Type -> Type -> Type
AppTy Type
t' ThetaType
ts') }
    go (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
tks)
      = do { TyCon
tc' <- IfaceTyCon -> IOEnv (Env IfGblEnv IfLclEnv) TyCon
tcIfaceTyCon IfaceTyCon
tc
           ; ThetaType
tks' <- (IfaceType -> IfL Type) -> IfaceContext -> IfL ThetaType
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceType -> IfL Type
go (IfaceAppArgs -> IfaceContext
appArgsIfaceTypes IfaceAppArgs
tks)
           ; Type -> IfL Type
forall (m :: * -> *) a. Monad m => a -> m a
return (TyCon -> ThetaType -> Type
mkTyConApp TyCon
tc' ThetaType
tks') }
    go (IfaceForAllTy IfaceForAllBndr
bndr IfaceType
t)
      = IfaceForAllBndr -> (Id -> ArgFlag -> IfL Type) -> IfL Type
forall a. IfaceForAllBndr -> (Id -> ArgFlag -> IfL a) -> IfL a
bindIfaceForAllBndr IfaceForAllBndr
bndr ((Id -> ArgFlag -> IfL Type) -> IfL Type)
-> (Id -> ArgFlag -> IfL Type) -> IfL Type
forall a b. (a -> b) -> a -> b
$ \ Id
tv' ArgFlag
vis ->
        TyCoVarBinder -> Type -> Type
ForAllTy (Id -> ArgFlag -> TyCoVarBinder
forall var argf. var -> argf -> VarBndr var argf
Bndr Id
tv' ArgFlag
vis) (Type -> Type) -> IfL Type -> IfL Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceType -> IfL Type
go IfaceType
t
    go (IfaceCastTy IfaceType
ty IfaceCoercion
co)   = Type -> Coercion -> Type
CastTy (Type -> Coercion -> Type)
-> IfL Type -> IOEnv (Env IfGblEnv IfLclEnv) (Coercion -> Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceType -> IfL Type
go IfaceType
ty IOEnv (Env IfGblEnv IfLclEnv) (Coercion -> Type)
-> IfL Coercion -> IfL Type
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IfaceCoercion -> IfL Coercion
tcIfaceCo IfaceCoercion
co
    go (IfaceCoercionTy IfaceCoercion
co)  = Coercion -> Type
CoercionTy (Coercion -> Type) -> IfL Coercion -> IfL Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceCoercion -> IfL Coercion
tcIfaceCo IfaceCoercion
co

tcIfaceTupleTy :: TupleSort -> PromotionFlag -> IfaceAppArgs -> IfL Type
tcIfaceTupleTy :: TupleSort -> PromotionFlag -> IfaceAppArgs -> IfL Type
tcIfaceTupleTy TupleSort
sort PromotionFlag
is_promoted IfaceAppArgs
args
 = do { ThetaType
args' <- IfaceAppArgs -> IfL ThetaType
tcIfaceAppArgs IfaceAppArgs
args
      ; let arity :: Int
arity = ThetaType -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ThetaType
args'
      ; TyCon
base_tc <- Bool -> TupleSort -> Int -> IOEnv (Env IfGblEnv IfLclEnv) TyCon
tcTupleTyCon Bool
True TupleSort
sort Int
arity
      ; case PromotionFlag
is_promoted of
          PromotionFlag
NotPromoted
            -> Type -> IfL Type
forall (m :: * -> *) a. Monad m => a -> m a
return (TyCon -> ThetaType -> Type
mkTyConApp TyCon
base_tc ThetaType
args')

          PromotionFlag
IsPromoted
            -> do { let tc :: TyCon
tc        = DataCon -> TyCon
promoteDataCon (TyCon -> DataCon
tyConSingleDataCon TyCon
base_tc)
                        kind_args :: ThetaType
kind_args = (Type -> Type) -> ThetaType -> ThetaType
forall a b. (a -> b) -> [a] -> [b]
map HasDebugCallStack => Type -> Type
Type -> Type
typeKind ThetaType
args'
                  ; Type -> IfL Type
forall (m :: * -> *) a. Monad m => a -> m a
return (TyCon -> ThetaType -> Type
mkTyConApp TyCon
tc (ThetaType
kind_args ThetaType -> ThetaType -> ThetaType
forall a. [a] -> [a] -> [a]
++ ThetaType
args')) } }

-- See Note [Unboxed tuple RuntimeRep vars] in TyCon
tcTupleTyCon :: Bool    -- True <=> typechecking a *type* (vs. an expr)
             -> TupleSort
             -> Arity   -- the number of args. *not* the tuple arity.
             -> IfL TyCon
tcTupleTyCon :: Bool -> TupleSort -> Int -> IOEnv (Env IfGblEnv IfLclEnv) TyCon
tcTupleTyCon Bool
in_type TupleSort
sort Int
arity
  = case TupleSort
sort of
      TupleSort
ConstraintTuple -> do { TyThing
thing <- Name -> IfL TyThing
tcIfaceGlobal (Int -> Name
cTupleTyConName Int
arity)
                            ; TyCon -> IOEnv (Env IfGblEnv IfLclEnv) TyCon
forall (m :: * -> *) a. Monad m => a -> m a
return (TyThing -> TyCon
tyThingTyCon TyThing
thing) }
      TupleSort
BoxedTuple   -> TyCon -> IOEnv (Env IfGblEnv IfLclEnv) TyCon
forall (m :: * -> *) a. Monad m => a -> m a
return (Boxity -> Int -> TyCon
tupleTyCon Boxity
Boxed   Int
arity)
      TupleSort
UnboxedTuple -> TyCon -> IOEnv (Env IfGblEnv IfLclEnv) TyCon
forall (m :: * -> *) a. Monad m => a -> m a
return (Boxity -> Int -> TyCon
tupleTyCon Boxity
Unboxed Int
arity')
        where arity' :: Int
arity' | Bool
in_type   = Int
arity Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
                     | Bool
otherwise = Int
arity
                      -- in expressions, we only have term args

tcIfaceAppArgs :: IfaceAppArgs -> IfL [Type]
tcIfaceAppArgs :: IfaceAppArgs -> IfL ThetaType
tcIfaceAppArgs = (IfaceType -> IfL Type) -> IfaceContext -> IfL ThetaType
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceType -> IfL Type
tcIfaceType (IfaceContext -> IfL ThetaType)
-> (IfaceAppArgs -> IfaceContext) -> IfaceAppArgs -> IfL ThetaType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IfaceAppArgs -> IfaceContext
appArgsIfaceTypes

-----------------------------------------
tcIfaceCtxt :: IfaceContext -> IfL ThetaType
tcIfaceCtxt :: IfaceContext -> IfL ThetaType
tcIfaceCtxt IfaceContext
sts = (IfaceType -> IfL Type) -> IfaceContext -> IfL ThetaType
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceType -> IfL Type
tcIfaceType IfaceContext
sts

-----------------------------------------
tcIfaceTyLit :: IfaceTyLit -> IfL TyLit
tcIfaceTyLit :: IfaceTyLit -> IOEnv (Env IfGblEnv IfLclEnv) TyLit
tcIfaceTyLit (IfaceNumTyLit Integer
n) = TyLit -> IOEnv (Env IfGblEnv IfLclEnv) TyLit
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> TyLit
NumTyLit Integer
n)
tcIfaceTyLit (IfaceStrTyLit IfLclName
n) = TyLit -> IOEnv (Env IfGblEnv IfLclEnv) TyLit
forall (m :: * -> *) a. Monad m => a -> m a
return (IfLclName -> TyLit
StrTyLit IfLclName
n)

{-
%************************************************************************
%*                                                                      *
                        Coercions
*                                                                      *
************************************************************************
-}

tcIfaceCo :: IfaceCoercion -> IfL Coercion
tcIfaceCo :: IfaceCoercion -> IfL Coercion
tcIfaceCo = IfaceCoercion -> IfL Coercion
go
  where
    go_mco :: IfaceMCoercion -> IOEnv (Env IfGblEnv IfLclEnv) MCoercion
go_mco IfaceMCoercion
IfaceMRefl    = MCoercion -> IOEnv (Env IfGblEnv IfLclEnv) MCoercion
forall (f :: * -> *) a. Applicative f => a -> f a
pure MCoercion
MRefl
    go_mco (IfaceMCo IfaceCoercion
co) = Coercion -> MCoercion
MCo (Coercion -> MCoercion)
-> IfL Coercion -> IOEnv (Env IfGblEnv IfLclEnv) MCoercion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IfaceCoercion -> IfL Coercion
go IfaceCoercion
co)

    go :: IfaceCoercion -> IfL Coercion
go (IfaceReflCo IfaceType
t)           = Type -> Coercion
Refl (Type -> Coercion) -> IfL Type -> IfL Coercion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceType -> IfL Type
tcIfaceType IfaceType
t
    go (IfaceGReflCo Role
r IfaceType
t IfaceMCoercion
mco)    = Role -> Type -> MCoercion -> Coercion
GRefl Role
r (Type -> MCoercion -> Coercion)
-> IfL Type
-> IOEnv (Env IfGblEnv IfLclEnv) (MCoercion -> Coercion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceType -> IfL Type
tcIfaceType IfaceType
t IOEnv (Env IfGblEnv IfLclEnv) (MCoercion -> Coercion)
-> IOEnv (Env IfGblEnv IfLclEnv) MCoercion -> IfL Coercion
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IfaceMCoercion -> IOEnv (Env IfGblEnv IfLclEnv) MCoercion
go_mco IfaceMCoercion
mco
    go (IfaceFunCo Role
r IfaceCoercion
c1 IfaceCoercion
c2)      = Role -> Coercion -> Coercion -> Coercion
mkFunCo Role
r (Coercion -> Coercion -> Coercion)
-> IfL Coercion
-> IOEnv (Env IfGblEnv IfLclEnv) (Coercion -> Coercion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceCoercion -> IfL Coercion
go IfaceCoercion
c1 IOEnv (Env IfGblEnv IfLclEnv) (Coercion -> Coercion)
-> IfL Coercion -> IfL Coercion
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IfaceCoercion -> IfL Coercion
go IfaceCoercion
c2
    go (IfaceTyConAppCo Role
r IfaceTyCon
tc [IfaceCoercion]
cs)
      = Role -> TyCon -> [Coercion] -> Coercion
TyConAppCo Role
r (TyCon -> [Coercion] -> Coercion)
-> IOEnv (Env IfGblEnv IfLclEnv) TyCon
-> IOEnv (Env IfGblEnv IfLclEnv) ([Coercion] -> Coercion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceTyCon -> IOEnv (Env IfGblEnv IfLclEnv) TyCon
tcIfaceTyCon IfaceTyCon
tc IOEnv (Env IfGblEnv IfLclEnv) ([Coercion] -> Coercion)
-> IOEnv (Env IfGblEnv IfLclEnv) [Coercion] -> IfL Coercion
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (IfaceCoercion -> IfL Coercion)
-> [IfaceCoercion] -> IOEnv (Env IfGblEnv IfLclEnv) [Coercion]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceCoercion -> IfL Coercion
go [IfaceCoercion]
cs
    go (IfaceAppCo IfaceCoercion
c1 IfaceCoercion
c2)        = Coercion -> Coercion -> Coercion
AppCo (Coercion -> Coercion -> Coercion)
-> IfL Coercion
-> IOEnv (Env IfGblEnv IfLclEnv) (Coercion -> Coercion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceCoercion -> IfL Coercion
go IfaceCoercion
c1 IOEnv (Env IfGblEnv IfLclEnv) (Coercion -> Coercion)
-> IfL Coercion -> IfL Coercion
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IfaceCoercion -> IfL Coercion
go IfaceCoercion
c2
    go (IfaceForAllCo IfaceBndr
tv IfaceCoercion
k IfaceCoercion
c)  = do { Coercion
k' <- IfaceCoercion -> IfL Coercion
go IfaceCoercion
k
                                      ; IfaceBndr -> (Id -> IfL Coercion) -> IfL Coercion
forall a. IfaceBndr -> (Id -> IfL a) -> IfL a
bindIfaceBndr IfaceBndr
tv ((Id -> IfL Coercion) -> IfL Coercion)
-> (Id -> IfL Coercion) -> IfL Coercion
forall a b. (a -> b) -> a -> b
$ \ Id
tv' ->
                                        Id -> Coercion -> Coercion -> Coercion
ForAllCo Id
tv' Coercion
k' (Coercion -> Coercion) -> IfL Coercion -> IfL Coercion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceCoercion -> IfL Coercion
go IfaceCoercion
c }
    go (IfaceCoVarCo IfLclName
n)          = Id -> Coercion
CoVarCo (Id -> Coercion) -> IfL Id -> IfL Coercion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfLclName -> IfL Id
go_var IfLclName
n
    go (IfaceAxiomInstCo Name
n Int
i [IfaceCoercion]
cs) = CoAxiom Branched -> Int -> [Coercion] -> Coercion
AxiomInstCo (CoAxiom Branched -> Int -> [Coercion] -> Coercion)
-> IfL (CoAxiom Branched)
-> IOEnv (Env IfGblEnv IfLclEnv) (Int -> [Coercion] -> Coercion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> IfL (CoAxiom Branched)
tcIfaceCoAxiom Name
n IOEnv (Env IfGblEnv IfLclEnv) (Int -> [Coercion] -> Coercion)
-> IOEnv (Env IfGblEnv IfLclEnv) Int
-> IOEnv (Env IfGblEnv IfLclEnv) ([Coercion] -> Coercion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> IOEnv (Env IfGblEnv IfLclEnv) Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
i IOEnv (Env IfGblEnv IfLclEnv) ([Coercion] -> Coercion)
-> IOEnv (Env IfGblEnv IfLclEnv) [Coercion] -> IfL Coercion
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (IfaceCoercion -> IfL Coercion)
-> [IfaceCoercion] -> IOEnv (Env IfGblEnv IfLclEnv) [Coercion]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceCoercion -> IfL Coercion
go [IfaceCoercion]
cs
    go (IfaceUnivCo IfaceUnivCoProv
p Role
r IfaceType
t1 IfaceType
t2)   = UnivCoProvenance -> Role -> Type -> Type -> Coercion
UnivCo (UnivCoProvenance -> Role -> Type -> Type -> Coercion)
-> IOEnv (Env IfGblEnv IfLclEnv) UnivCoProvenance
-> IOEnv (Env IfGblEnv IfLclEnv) (Role -> Type -> Type -> Coercion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceUnivCoProv -> IOEnv (Env IfGblEnv IfLclEnv) UnivCoProvenance
tcIfaceUnivCoProv IfaceUnivCoProv
p IOEnv (Env IfGblEnv IfLclEnv) (Role -> Type -> Type -> Coercion)
-> IOEnv (Env IfGblEnv IfLclEnv) Role
-> IOEnv (Env IfGblEnv IfLclEnv) (Type -> Type -> Coercion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Role -> IOEnv (Env IfGblEnv IfLclEnv) Role
forall (f :: * -> *) a. Applicative f => a -> f a
pure Role
r
                                          IOEnv (Env IfGblEnv IfLclEnv) (Type -> Type -> Coercion)
-> IfL Type -> IOEnv (Env IfGblEnv IfLclEnv) (Type -> Coercion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IfaceType -> IfL Type
tcIfaceType IfaceType
t1 IOEnv (Env IfGblEnv IfLclEnv) (Type -> Coercion)
-> IfL Type -> IfL Coercion
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IfaceType -> IfL Type
tcIfaceType IfaceType
t2
    go (IfaceSymCo IfaceCoercion
c)            = Coercion -> Coercion
SymCo    (Coercion -> Coercion) -> IfL Coercion -> IfL Coercion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceCoercion -> IfL Coercion
go IfaceCoercion
c
    go (IfaceTransCo IfaceCoercion
c1 IfaceCoercion
c2)      = Coercion -> Coercion -> Coercion
TransCo  (Coercion -> Coercion -> Coercion)
-> IfL Coercion
-> IOEnv (Env IfGblEnv IfLclEnv) (Coercion -> Coercion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceCoercion -> IfL Coercion
go IfaceCoercion
c1
                                            IOEnv (Env IfGblEnv IfLclEnv) (Coercion -> Coercion)
-> IfL Coercion -> IfL Coercion
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IfaceCoercion -> IfL Coercion
go IfaceCoercion
c2
    go (IfaceInstCo IfaceCoercion
c1 IfaceCoercion
t2)       = Coercion -> Coercion -> Coercion
InstCo   (Coercion -> Coercion -> Coercion)
-> IfL Coercion
-> IOEnv (Env IfGblEnv IfLclEnv) (Coercion -> Coercion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceCoercion -> IfL Coercion
go IfaceCoercion
c1
                                            IOEnv (Env IfGblEnv IfLclEnv) (Coercion -> Coercion)
-> IfL Coercion -> IfL Coercion
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IfaceCoercion -> IfL Coercion
go IfaceCoercion
t2
    go (IfaceNthCo Int
d IfaceCoercion
c)          = do { Coercion
c' <- IfaceCoercion -> IfL Coercion
go IfaceCoercion
c
                                      ; Coercion -> IfL Coercion
forall (m :: * -> *) a. Monad m => a -> m a
return (Coercion -> IfL Coercion) -> Coercion -> IfL Coercion
forall a b. (a -> b) -> a -> b
$ HasDebugCallStack => Role -> Int -> Coercion -> Coercion
Role -> Int -> Coercion -> Coercion
mkNthCo (Int -> Coercion -> Role
nthCoRole Int
d Coercion
c') Int
d Coercion
c' }
    go (IfaceLRCo LeftOrRight
lr IfaceCoercion
c)          = LeftOrRight -> Coercion -> Coercion
LRCo LeftOrRight
lr  (Coercion -> Coercion) -> IfL Coercion -> IfL Coercion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceCoercion -> IfL Coercion
go IfaceCoercion
c
    go (IfaceKindCo IfaceCoercion
c)           = Coercion -> Coercion
KindCo   (Coercion -> Coercion) -> IfL Coercion -> IfL Coercion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceCoercion -> IfL Coercion
go IfaceCoercion
c
    go (IfaceSubCo IfaceCoercion
c)            = Coercion -> Coercion
SubCo    (Coercion -> Coercion) -> IfL Coercion -> IfL Coercion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceCoercion -> IfL Coercion
go IfaceCoercion
c
    go (IfaceAxiomRuleCo IfLclName
ax [IfaceCoercion]
cos) = CoAxiomRule -> [Coercion] -> Coercion
AxiomRuleCo (CoAxiomRule -> [Coercion] -> Coercion)
-> IOEnv (Env IfGblEnv IfLclEnv) CoAxiomRule
-> IOEnv (Env IfGblEnv IfLclEnv) ([Coercion] -> Coercion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfLclName -> IOEnv (Env IfGblEnv IfLclEnv) CoAxiomRule
tcIfaceCoAxiomRule IfLclName
ax
                                               IOEnv (Env IfGblEnv IfLclEnv) ([Coercion] -> Coercion)
-> IOEnv (Env IfGblEnv IfLclEnv) [Coercion] -> IfL Coercion
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (IfaceCoercion -> IfL Coercion)
-> [IfaceCoercion] -> IOEnv (Env IfGblEnv IfLclEnv) [Coercion]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceCoercion -> IfL Coercion
go [IfaceCoercion]
cos
    go (IfaceFreeCoVar Id
c)        = String -> SDoc -> IfL Coercion
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tcIfaceCo:IfaceFreeCoVar" (Id -> SDoc
forall a. Outputable a => a -> SDoc
ppr Id
c)
    go (IfaceHoleCo Id
c)           = String -> SDoc -> IfL Coercion
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tcIfaceCo:IfaceHoleCo"    (Id -> SDoc
forall a. Outputable a => a -> SDoc
ppr Id
c)

    go_var :: FastString -> IfL CoVar
    go_var :: IfLclName -> IfL Id
go_var = IfLclName -> IfL Id
tcIfaceLclId

tcIfaceUnivCoProv :: IfaceUnivCoProv -> IfL UnivCoProvenance
tcIfaceUnivCoProv :: IfaceUnivCoProv -> IOEnv (Env IfGblEnv IfLclEnv) UnivCoProvenance
tcIfaceUnivCoProv IfaceUnivCoProv
IfaceUnsafeCoerceProv     = UnivCoProvenance -> IOEnv (Env IfGblEnv IfLclEnv) UnivCoProvenance
forall (m :: * -> *) a. Monad m => a -> m a
return UnivCoProvenance
UnsafeCoerceProv
tcIfaceUnivCoProv (IfacePhantomProv IfaceCoercion
kco)    = Coercion -> UnivCoProvenance
PhantomProv (Coercion -> UnivCoProvenance)
-> IfL Coercion -> IOEnv (Env IfGblEnv IfLclEnv) UnivCoProvenance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceCoercion -> IfL Coercion
tcIfaceCo IfaceCoercion
kco
tcIfaceUnivCoProv (IfaceProofIrrelProv IfaceCoercion
kco) = Coercion -> UnivCoProvenance
ProofIrrelProv (Coercion -> UnivCoProvenance)
-> IfL Coercion -> IOEnv (Env IfGblEnv IfLclEnv) UnivCoProvenance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceCoercion -> IfL Coercion
tcIfaceCo IfaceCoercion
kco
tcIfaceUnivCoProv (IfacePluginProv String
str)     = UnivCoProvenance -> IOEnv (Env IfGblEnv IfLclEnv) UnivCoProvenance
forall (m :: * -> *) a. Monad m => a -> m a
return (UnivCoProvenance
 -> IOEnv (Env IfGblEnv IfLclEnv) UnivCoProvenance)
-> UnivCoProvenance
-> IOEnv (Env IfGblEnv IfLclEnv) UnivCoProvenance
forall a b. (a -> b) -> a -> b
$ String -> UnivCoProvenance
PluginProv String
str

{-
************************************************************************
*                                                                      *
                        Core
*                                                                      *
************************************************************************
-}

tcIfaceExpr :: IfaceExpr -> IfL CoreExpr
tcIfaceExpr :: IfaceExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
tcIfaceExpr (IfaceType IfaceType
ty)
  = Type -> CoreExpr
forall b. Type -> Expr b
Type (Type -> CoreExpr)
-> IfL Type -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceType -> IfL Type
tcIfaceType IfaceType
ty

tcIfaceExpr (IfaceCo IfaceCoercion
co)
  = Coercion -> CoreExpr
forall b. Coercion -> Expr b
Coercion (Coercion -> CoreExpr)
-> IfL Coercion -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceCoercion -> IfL Coercion
tcIfaceCo IfaceCoercion
co

tcIfaceExpr (IfaceCast IfaceExpr
expr IfaceCoercion
co)
  = CoreExpr -> Coercion -> CoreExpr
forall b. Expr b -> Coercion -> Expr b
Cast (CoreExpr -> Coercion -> CoreExpr)
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
-> IOEnv (Env IfGblEnv IfLclEnv) (Coercion -> CoreExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
tcIfaceExpr IfaceExpr
expr IOEnv (Env IfGblEnv IfLclEnv) (Coercion -> CoreExpr)
-> IfL Coercion -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IfaceCoercion -> IfL Coercion
tcIfaceCo IfaceCoercion
co

tcIfaceExpr (IfaceLcl IfLclName
name)
  = Id -> CoreExpr
forall b. Id -> Expr b
Var (Id -> CoreExpr)
-> IfL Id -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfLclName -> IfL Id
tcIfaceLclId IfLclName
name

tcIfaceExpr (IfaceExt Name
gbl)
  = Id -> CoreExpr
forall b. Id -> Expr b
Var (Id -> CoreExpr)
-> IfL Id -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> IfL Id
tcIfaceExtId Name
gbl

tcIfaceExpr (IfaceLit Literal
lit)
  = do Literal
lit' <- Literal -> IfL Literal
tcIfaceLit Literal
lit
       CoreExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
lit')

tcIfaceExpr (IfaceFCall ForeignCall
cc IfaceType
ty) = do
    Type
ty' <- IfaceType -> IfL Type
tcIfaceType IfaceType
ty
    Unique
u <- TcRnIf IfGblEnv IfLclEnv Unique
forall gbl lcl. TcRnIf gbl lcl Unique
newUnique
    DynFlags
dflags <- IOEnv (Env IfGblEnv IfLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
    CoreExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (Id -> CoreExpr
forall b. Id -> Expr b
Var (DynFlags -> Unique -> ForeignCall -> Type -> Id
mkFCallId DynFlags
dflags Unique
u ForeignCall
cc Type
ty'))

tcIfaceExpr (IfaceTuple TupleSort
sort [IfaceExpr]
args)
  = do { [CoreExpr]
args' <- (IfaceExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr)
-> [IfaceExpr] -> IOEnv (Env IfGblEnv IfLclEnv) [CoreExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
tcIfaceExpr [IfaceExpr]
args
       ; TyCon
tc <- Bool -> TupleSort -> Int -> IOEnv (Env IfGblEnv IfLclEnv) TyCon
tcTupleTyCon Bool
False TupleSort
sort Int
arity
       ; let con_tys :: ThetaType
con_tys = (CoreExpr -> Type) -> [CoreExpr] -> ThetaType
forall a b. (a -> b) -> [a] -> [b]
map CoreExpr -> Type
exprType [CoreExpr]
args'
             some_con_args :: [CoreExpr]
some_con_args = (Type -> CoreExpr) -> ThetaType -> [CoreExpr]
forall a b. (a -> b) -> [a] -> [b]
map Type -> CoreExpr
forall b. Type -> Expr b
Type ThetaType
con_tys [CoreExpr] -> [CoreExpr] -> [CoreExpr]
forall a. [a] -> [a] -> [a]
++ [CoreExpr]
args'
             con_args :: [CoreExpr]
con_args = case TupleSort
sort of
               TupleSort
UnboxedTuple -> (Type -> CoreExpr) -> ThetaType -> [CoreExpr]
forall a b. (a -> b) -> [a] -> [b]
map (Type -> CoreExpr
forall b. Type -> Expr b
Type (Type -> CoreExpr) -> (Type -> Type) -> Type -> CoreExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasDebugCallStack => Type -> Type
Type -> Type
getRuntimeRep) ThetaType
con_tys [CoreExpr] -> [CoreExpr] -> [CoreExpr]
forall a. [a] -> [a] -> [a]
++ [CoreExpr]
some_con_args
               TupleSort
_            -> [CoreExpr]
some_con_args
                        -- Put the missing type arguments back in
             con_id :: Id
con_id   = DataCon -> Id
dataConWorkId (TyCon -> DataCon
tyConSingleDataCon TyCon
tc)
       ; CoreExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (CoreExpr -> [CoreExpr] -> CoreExpr
forall b. Expr b -> [Expr b] -> Expr b
mkApps (Id -> CoreExpr
forall b. Id -> Expr b
Var Id
con_id) [CoreExpr]
con_args) }
  where
    arity :: Int
arity = [IfaceExpr] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [IfaceExpr]
args

tcIfaceExpr (IfaceLam (IfaceBndr
bndr, IfaceOneShot
os) IfaceExpr
body)
  = IfaceBndr
-> (Id -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr)
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall a. IfaceBndr -> (Id -> IfL a) -> IfL a
bindIfaceBndr IfaceBndr
bndr ((Id -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr)
 -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr)
-> (Id -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr)
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall a b. (a -> b) -> a -> b
$ \Id
bndr' ->
    Id -> CoreExpr -> CoreExpr
forall b. b -> Expr b -> Expr b
Lam (IfaceOneShot -> Id -> Id
tcIfaceOneShot IfaceOneShot
os Id
bndr') (CoreExpr -> CoreExpr)
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
tcIfaceExpr IfaceExpr
body
  where
    tcIfaceOneShot :: IfaceOneShot -> Id -> Id
tcIfaceOneShot IfaceOneShot
IfaceOneShot Id
b = Id -> Id
setOneShotLambda Id
b
    tcIfaceOneShot IfaceOneShot
_            Id
b = Id
b

tcIfaceExpr (IfaceApp IfaceExpr
fun IfaceExpr
arg)
  = CoreExpr -> CoreExpr -> CoreExpr
forall b. Expr b -> Expr b -> Expr b
App (CoreExpr -> CoreExpr -> CoreExpr)
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
-> IOEnv (Env IfGblEnv IfLclEnv) (CoreExpr -> CoreExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
tcIfaceExpr IfaceExpr
fun IOEnv (Env IfGblEnv IfLclEnv) (CoreExpr -> CoreExpr)
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IfaceExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
tcIfaceExpr IfaceExpr
arg

tcIfaceExpr (IfaceECase IfaceExpr
scrut IfaceType
ty)
  = do { CoreExpr
scrut' <- IfaceExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
tcIfaceExpr IfaceExpr
scrut
       ; Type
ty' <- IfaceType -> IfL Type
tcIfaceType IfaceType
ty
       ; CoreExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (CoreExpr -> Type -> CoreExpr
castBottomExpr CoreExpr
scrut' Type
ty') }

tcIfaceExpr (IfaceCase IfaceExpr
scrut IfLclName
case_bndr [IfaceAlt]
alts)  = do
    CoreExpr
scrut' <- IfaceExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
tcIfaceExpr IfaceExpr
scrut
    Name
case_bndr_name <- OccName -> TcRnIf IfGblEnv IfLclEnv Name
newIfaceName (IfLclName -> OccName
mkVarOccFS IfLclName
case_bndr)
    let
        scrut_ty :: Type
scrut_ty   = CoreExpr -> Type
exprType CoreExpr
scrut'
        case_bndr' :: Id
case_bndr' = Name -> Type -> Id
mkLocalIdOrCoVar Name
case_bndr_name Type
scrut_ty
        tc_app :: (TyCon, ThetaType)
tc_app     = Type -> (TyCon, ThetaType)
splitTyConApp Type
scrut_ty
                -- NB: Won't always succeed (polymorphic case)
                --     but won't be demanded in those cases
                -- NB: not tcSplitTyConApp; we are looking at Core here
                --     look through non-rec newtypes to find the tycon that
                --     corresponds to the datacon in this case alternative

    [Id]
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall a. [Id] -> IfL a -> IfL a
extendIfaceIdEnv [Id
case_bndr'] (IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
 -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr)
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall a b. (a -> b) -> a -> b
$ do
     [(AltCon, [Id], CoreExpr)]
alts' <- (IfaceAlt
 -> IOEnv (Env IfGblEnv IfLclEnv) (AltCon, [Id], CoreExpr))
-> [IfaceAlt]
-> IOEnv (Env IfGblEnv IfLclEnv) [(AltCon, [Id], CoreExpr)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (CoreExpr
-> (TyCon, ThetaType)
-> IfaceAlt
-> IOEnv (Env IfGblEnv IfLclEnv) (AltCon, [Id], CoreExpr)
tcIfaceAlt CoreExpr
scrut' (TyCon, ThetaType)
tc_app) [IfaceAlt]
alts
     CoreExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (CoreExpr -> Id -> Type -> [(AltCon, [Id], CoreExpr)] -> CoreExpr
forall b. Expr b -> b -> Type -> [Alt b] -> Expr b
Case CoreExpr
scrut' Id
case_bndr' ([(AltCon, [Id], CoreExpr)] -> Type
coreAltsType [(AltCon, [Id], CoreExpr)]
alts') [(AltCon, [Id], CoreExpr)]
alts')

tcIfaceExpr (IfaceLet (IfaceNonRec (IfLetBndr IfLclName
fs IfaceType
ty IfaceIdInfo
info IfaceJoinInfo
ji) IfaceExpr
rhs) IfaceExpr
body)
  = do  { Name
name    <- OccName -> TcRnIf IfGblEnv IfLclEnv Name
newIfaceName (IfLclName -> OccName
mkVarOccFS IfLclName
fs)
        ; Type
ty'     <- IfaceType -> IfL Type
tcIfaceType IfaceType
ty
        ; IdInfo
id_info <- Bool -> TopLevelFlag -> Name -> Type -> IfaceIdInfo -> IfL IdInfo
tcIdInfo Bool
False {- Don't ignore prags; we are inside one! -}
                              TopLevelFlag
NotTopLevel Name
name Type
ty' IfaceIdInfo
info
        ; let id :: Id
id = Name -> Type -> IdInfo -> Id
mkLocalIdOrCoVarWithInfo Name
name Type
ty' IdInfo
id_info
                     Id -> Maybe Int -> Id
`asJoinId_maybe` IfaceJoinInfo -> Maybe Int
tcJoinInfo IfaceJoinInfo
ji
        ; CoreExpr
rhs' <- IfaceExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
tcIfaceExpr IfaceExpr
rhs
        ; CoreExpr
body' <- [Id]
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall a. [Id] -> IfL a -> IfL a
extendIfaceIdEnv [Id
id] (IfaceExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
tcIfaceExpr IfaceExpr
body)
        ; CoreExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (Bind Id -> CoreExpr -> CoreExpr
forall b. Bind b -> Expr b -> Expr b
Let (Id -> CoreExpr -> Bind Id
forall b. b -> Expr b -> Bind b
NonRec Id
id CoreExpr
rhs') CoreExpr
body') }

tcIfaceExpr (IfaceLet (IfaceRec [(IfaceLetBndr, IfaceExpr)]
pairs) IfaceExpr
body)
  = do { [Id]
ids <- (IfaceLetBndr -> IfL Id)
-> [IfaceLetBndr] -> IOEnv (Env IfGblEnv IfLclEnv) [Id]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceLetBndr -> IfL Id
tc_rec_bndr (((IfaceLetBndr, IfaceExpr) -> IfaceLetBndr)
-> [(IfaceLetBndr, IfaceExpr)] -> [IfaceLetBndr]
forall a b. (a -> b) -> [a] -> [b]
map (IfaceLetBndr, IfaceExpr) -> IfaceLetBndr
forall a b. (a, b) -> a
fst [(IfaceLetBndr, IfaceExpr)]
pairs)
       ; [Id]
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall a. [Id] -> IfL a -> IfL a
extendIfaceIdEnv [Id]
ids (IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
 -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr)
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall a b. (a -> b) -> a -> b
$ do
       { [(Id, CoreExpr)]
pairs' <- ((IfaceLetBndr, IfaceExpr)
 -> Id -> IOEnv (Env IfGblEnv IfLclEnv) (Id, CoreExpr))
-> [(IfaceLetBndr, IfaceExpr)]
-> [Id]
-> IOEnv (Env IfGblEnv IfLclEnv) [(Id, CoreExpr)]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (IfaceLetBndr, IfaceExpr)
-> Id -> IOEnv (Env IfGblEnv IfLclEnv) (Id, CoreExpr)
tc_pair [(IfaceLetBndr, IfaceExpr)]
pairs [Id]
ids
       ; CoreExpr
body' <- IfaceExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
tcIfaceExpr IfaceExpr
body
       ; CoreExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (Bind Id -> CoreExpr -> CoreExpr
forall b. Bind b -> Expr b -> Expr b
Let ([(Id, CoreExpr)] -> Bind Id
forall b. [(b, Expr b)] -> Bind b
Rec [(Id, CoreExpr)]
pairs') CoreExpr
body') } }
 where
   tc_rec_bndr :: IfaceLetBndr -> IfL Id
tc_rec_bndr (IfLetBndr IfLclName
fs IfaceType
ty IfaceIdInfo
_ IfaceJoinInfo
ji)
     = do { Name
name <- OccName -> TcRnIf IfGblEnv IfLclEnv Name
newIfaceName (IfLclName -> OccName
mkVarOccFS IfLclName
fs)
          ; Type
ty'  <- IfaceType -> IfL Type
tcIfaceType IfaceType
ty
          ; Id -> IfL Id
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Type -> Id
mkLocalIdOrCoVar Name
name Type
ty' Id -> Maybe Int -> Id
`asJoinId_maybe` IfaceJoinInfo -> Maybe Int
tcJoinInfo IfaceJoinInfo
ji) }
   tc_pair :: (IfaceLetBndr, IfaceExpr)
-> Id -> IOEnv (Env IfGblEnv IfLclEnv) (Id, CoreExpr)
tc_pair (IfLetBndr IfLclName
_ IfaceType
_ IfaceIdInfo
info IfaceJoinInfo
_, IfaceExpr
rhs) Id
id
     = do { CoreExpr
rhs' <- IfaceExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
tcIfaceExpr IfaceExpr
rhs
          ; IdInfo
id_info <- Bool -> TopLevelFlag -> Name -> Type -> IfaceIdInfo -> IfL IdInfo
tcIdInfo Bool
False {- Don't ignore prags; we are inside one! -}
                                TopLevelFlag
NotTopLevel (Id -> Name
idName Id
id) (Id -> Type
idType Id
id) IfaceIdInfo
info
          ; (Id, CoreExpr) -> IOEnv (Env IfGblEnv IfLclEnv) (Id, CoreExpr)
forall (m :: * -> *) a. Monad m => a -> m a
return (Id -> IdInfo -> Id
setIdInfo Id
id IdInfo
id_info, CoreExpr
rhs') }

tcIfaceExpr (IfaceTick IfaceTickish
tickish IfaceExpr
expr) = do
    CoreExpr
expr' <- IfaceExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
tcIfaceExpr IfaceExpr
expr
    -- If debug flag is not set: Ignore source notes
    Int
dbgLvl <- (DynFlags -> Int)
-> IOEnv (Env IfGblEnv IfLclEnv) DynFlags
-> IOEnv (Env IfGblEnv IfLclEnv) Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DynFlags -> Int
debugLevel IOEnv (Env IfGblEnv IfLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
    case IfaceTickish
tickish of
      IfaceSource{} | Int
dbgLvl Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                    -> CoreExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
return CoreExpr
expr'
      IfaceTickish
_otherwise    -> do
        Tickish Id
tickish' <- IfaceTickish -> IfM IfLclEnv (Tickish Id)
forall lcl. IfaceTickish -> IfM lcl (Tickish Id)
tcIfaceTickish IfaceTickish
tickish
        CoreExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (Tickish Id -> CoreExpr -> CoreExpr
forall b. Tickish Id -> Expr b -> Expr b
Tick Tickish Id
tickish' CoreExpr
expr')

-------------------------
tcIfaceTickish :: IfaceTickish -> IfM lcl (Tickish Id)
tcIfaceTickish :: IfaceTickish -> IfM lcl (Tickish Id)
tcIfaceTickish (IfaceHpcTick Module
modl Int
ix)   = Tickish Id -> IfM lcl (Tickish Id)
forall (m :: * -> *) a. Monad m => a -> m a
return (Module -> Int -> Tickish Id
forall id. Module -> Int -> Tickish id
HpcTick Module
modl Int
ix)
tcIfaceTickish (IfaceSCC  CostCentre
cc Bool
tick Bool
push) = Tickish Id -> IfM lcl (Tickish Id)
forall (m :: * -> *) a. Monad m => a -> m a
return (CostCentre -> Bool -> Bool -> Tickish Id
forall id. CostCentre -> Bool -> Bool -> Tickish id
ProfNote CostCentre
cc Bool
tick Bool
push)
tcIfaceTickish (IfaceSource RealSrcSpan
src String
name)   = Tickish Id -> IfM lcl (Tickish Id)
forall (m :: * -> *) a. Monad m => a -> m a
return (RealSrcSpan -> String -> Tickish Id
forall id. RealSrcSpan -> String -> Tickish id
SourceNote RealSrcSpan
src String
name)

-------------------------
tcIfaceLit :: Literal -> IfL Literal
-- Integer literals deserialise to (LitInteger i <error thunk>)
-- so tcIfaceLit just fills in the type.
-- See Note [Integer literals] in Literal
tcIfaceLit :: Literal -> IfL Literal
tcIfaceLit (LitNumber LitNumType
LitNumInteger Integer
i Type
_)
  = do TyCon
t <- Name -> IOEnv (Env IfGblEnv IfLclEnv) TyCon
tcIfaceTyConByName Name
integerTyConName
       Literal -> IfL Literal
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Type -> Literal
mkLitInteger Integer
i (TyCon -> Type
mkTyConTy TyCon
t))
-- Natural literals deserialise to (LitNatural i <error thunk>)
-- so tcIfaceLit just fills in the type.
-- See Note [Natural literals] in Literal
tcIfaceLit (LitNumber LitNumType
LitNumNatural Integer
i Type
_)
  = do TyCon
t <- Name -> IOEnv (Env IfGblEnv IfLclEnv) TyCon
tcIfaceTyConByName Name
naturalTyConName
       Literal -> IfL Literal
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Type -> Literal
mkLitNatural Integer
i (TyCon -> Type
mkTyConTy TyCon
t))
tcIfaceLit Literal
lit = Literal -> IfL Literal
forall (m :: * -> *) a. Monad m => a -> m a
return Literal
lit

-------------------------
tcIfaceAlt :: CoreExpr -> (TyCon, [Type])
           -> (IfaceConAlt, [FastString], IfaceExpr)
           -> IfL (AltCon, [TyVar], CoreExpr)
tcIfaceAlt :: CoreExpr
-> (TyCon, ThetaType)
-> IfaceAlt
-> IOEnv (Env IfGblEnv IfLclEnv) (AltCon, [Id], CoreExpr)
tcIfaceAlt CoreExpr
_ (TyCon, ThetaType)
_ (IfaceConAlt
IfaceDefault, [IfLclName]
names, IfaceExpr
rhs)
  = ASSERT( null names ) do
    rhs' <- tcIfaceExpr rhs
    return (DEFAULT, [], rhs')

tcIfaceAlt CoreExpr
_ (TyCon, ThetaType)
_ (IfaceLitAlt Literal
lit, [IfLclName]
names, IfaceExpr
rhs)
  = ASSERT( null names ) do
    lit' <- tcIfaceLit lit
    rhs' <- tcIfaceExpr rhs
    return (LitAlt lit', [], rhs')

-- A case alternative is made quite a bit more complicated
-- by the fact that we omit type annotations because we can
-- work them out.  True enough, but its not that easy!
tcIfaceAlt CoreExpr
scrut (TyCon
tycon, ThetaType
inst_tys) (IfaceDataAlt Name
data_occ, [IfLclName]
arg_strs, IfaceExpr
rhs)
  = do  { DataCon
con <- Name -> IOEnv (Env IfGblEnv IfLclEnv) DataCon
tcIfaceDataCon Name
data_occ
        ; Bool -> TcRnIf IfGblEnv IfLclEnv () -> TcRnIf IfGblEnv IfLclEnv ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
debugIsOn Bool -> Bool -> Bool
&& Bool -> Bool
not (DataCon
con DataCon -> [DataCon] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` TyCon -> [DataCon]
tyConDataCons TyCon
tycon))
               (SDoc -> TcRnIf IfGblEnv IfLclEnv ()
forall a. SDoc -> IfL a
failIfM (CoreExpr -> SDoc
forall a. Outputable a => a -> SDoc
ppr CoreExpr
scrut SDoc -> SDoc -> SDoc
$$ DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
con SDoc -> SDoc -> SDoc
$$ TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tycon SDoc -> SDoc -> SDoc
$$ [DataCon] -> SDoc
forall a. Outputable a => a -> SDoc
ppr (TyCon -> [DataCon]
tyConDataCons TyCon
tycon)))
        ; DataCon
-> ThetaType
-> [IfLclName]
-> IfaceExpr
-> IOEnv (Env IfGblEnv IfLclEnv) (AltCon, [Id], CoreExpr)
tcIfaceDataAlt DataCon
con ThetaType
inst_tys [IfLclName]
arg_strs IfaceExpr
rhs }

tcIfaceDataAlt :: DataCon -> [Type] -> [FastString] -> IfaceExpr
               -> IfL (AltCon, [TyVar], CoreExpr)
tcIfaceDataAlt :: DataCon
-> ThetaType
-> [IfLclName]
-> IfaceExpr
-> IOEnv (Env IfGblEnv IfLclEnv) (AltCon, [Id], CoreExpr)
tcIfaceDataAlt DataCon
con ThetaType
inst_tys [IfLclName]
arg_strs IfaceExpr
rhs
  = do  { UniqSupply
us <- TcRnIf IfGblEnv IfLclEnv UniqSupply
forall gbl lcl. TcRnIf gbl lcl UniqSupply
newUniqueSupply
        ; let uniqs :: [Unique]
uniqs = UniqSupply -> [Unique]
uniqsFromSupply UniqSupply
us
        ; let ([Id]
ex_tvs, [Id]
arg_ids)
                      = [IfLclName] -> [Unique] -> DataCon -> ThetaType -> FunDep Id
dataConRepFSInstPat [IfLclName]
arg_strs [Unique]
uniqs DataCon
con ThetaType
inst_tys

        ; CoreExpr
rhs' <- [Id]
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall a. [Id] -> IfL a -> IfL a
extendIfaceEnvs  [Id]
ex_tvs       (IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
 -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr)
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall a b. (a -> b) -> a -> b
$
                  [Id]
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall a. [Id] -> IfL a -> IfL a
extendIfaceIdEnv [Id]
arg_ids      (IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
 -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr)
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall a b. (a -> b) -> a -> b
$
                  IfaceExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
tcIfaceExpr IfaceExpr
rhs
        ; (AltCon, [Id], CoreExpr)
-> IOEnv (Env IfGblEnv IfLclEnv) (AltCon, [Id], CoreExpr)
forall (m :: * -> *) a. Monad m => a -> m a
return (DataCon -> AltCon
DataAlt DataCon
con, [Id]
ex_tvs [Id] -> [Id] -> [Id]
forall a. [a] -> [a] -> [a]
++ [Id]
arg_ids, CoreExpr
rhs') }

{-
************************************************************************
*                                                                      *
                IdInfo
*                                                                      *
************************************************************************
-}

tcIdDetails :: Type -> IfaceIdDetails -> IfL IdDetails
tcIdDetails :: Type -> IfaceIdDetails -> IfL IdDetails
tcIdDetails Type
_  IfaceIdDetails
IfVanillaId = IdDetails -> IfL IdDetails
forall (m :: * -> *) a. Monad m => a -> m a
return IdDetails
VanillaId
tcIdDetails Type
ty IfaceIdDetails
IfDFunId
  = IdDetails -> IfL IdDetails
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IdDetails
DFunId (TyCon -> Bool
isNewTyCon (Class -> TyCon
classTyCon Class
cls)))
  where
    ([Id]
_, ThetaType
_, Class
cls, ThetaType
_) = Type -> ([Id], ThetaType, Class, ThetaType)
tcSplitDFunTy Type
ty

tcIdDetails Type
_ (IfRecSelId Either IfaceTyCon IfaceDecl
tc Bool
naughty)
  = do { RecSelParent
tc' <- (IfaceTyCon -> IOEnv (Env IfGblEnv IfLclEnv) RecSelParent)
-> (IfaceDecl -> IOEnv (Env IfGblEnv IfLclEnv) RecSelParent)
-> Either IfaceTyCon IfaceDecl
-> IOEnv (Env IfGblEnv IfLclEnv) RecSelParent
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((TyCon -> RecSelParent)
-> IOEnv (Env IfGblEnv IfLclEnv) TyCon
-> IOEnv (Env IfGblEnv IfLclEnv) RecSelParent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TyCon -> RecSelParent
RecSelData (IOEnv (Env IfGblEnv IfLclEnv) TyCon
 -> IOEnv (Env IfGblEnv IfLclEnv) RecSelParent)
-> (IfaceTyCon -> IOEnv (Env IfGblEnv IfLclEnv) TyCon)
-> IfaceTyCon
-> IOEnv (Env IfGblEnv IfLclEnv) RecSelParent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IfaceTyCon -> IOEnv (Env IfGblEnv IfLclEnv) TyCon
tcIfaceTyCon)
                       ((TyThing -> RecSelParent)
-> IfL TyThing -> IOEnv (Env IfGblEnv IfLclEnv) RecSelParent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PatSyn -> RecSelParent
RecSelPatSyn (PatSyn -> RecSelParent)
-> (TyThing -> PatSyn) -> TyThing -> RecSelParent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyThing -> PatSyn
tyThingPatSyn) (IfL TyThing -> IOEnv (Env IfGblEnv IfLclEnv) RecSelParent)
-> (IfaceDecl -> IfL TyThing)
-> IfaceDecl
-> IOEnv (Env IfGblEnv IfLclEnv) RecSelParent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> IfaceDecl -> IfL TyThing
tcIfaceDecl Bool
False)
                       Either IfaceTyCon IfaceDecl
tc
       ; IdDetails -> IfL IdDetails
forall (m :: * -> *) a. Monad m => a -> m a
return (RecSelId :: RecSelParent -> Bool -> IdDetails
RecSelId { sel_tycon :: RecSelParent
sel_tycon = RecSelParent
tc', sel_naughty :: Bool
sel_naughty = Bool
naughty }) }
  where
    tyThingPatSyn :: TyThing -> PatSyn
tyThingPatSyn (AConLike (PatSynCon PatSyn
ps)) = PatSyn
ps
    tyThingPatSyn TyThing
_ = String -> PatSyn
forall a. String -> a
panic String
"tcIdDetails: expecting patsyn"

tcIdInfo :: Bool -> TopLevelFlag -> Name -> Type -> IfaceIdInfo -> IfL IdInfo
tcIdInfo :: Bool -> TopLevelFlag -> Name -> Type -> IfaceIdInfo -> IfL IdInfo
tcIdInfo Bool
ignore_prags TopLevelFlag
toplvl Name
name Type
ty IfaceIdInfo
info = do
    IfLclEnv
lcl_env <- TcRnIf IfGblEnv IfLclEnv IfLclEnv
forall gbl lcl. TcRnIf gbl lcl lcl
getLclEnv
    -- Set the CgInfo to something sensible but uninformative before
    -- we start; default assumption is that it has CAFs
    let init_info :: IdInfo
init_info | IfLclEnv -> Bool
if_boot IfLclEnv
lcl_env = IdInfo
vanillaIdInfo IdInfo -> Unfolding -> IdInfo
`setUnfoldingInfo` Unfolding
BootUnfolding
                  | Bool
otherwise       = IdInfo
vanillaIdInfo
    if Bool
ignore_prags
        then IdInfo -> IfL IdInfo
forall (m :: * -> *) a. Monad m => a -> m a
return IdInfo
init_info
        else case IfaceIdInfo
info of
                IfaceIdInfo
NoInfo -> IdInfo -> IfL IdInfo
forall (m :: * -> *) a. Monad m => a -> m a
return IdInfo
init_info
                HasInfo [IfaceInfoItem]
info -> (IdInfo -> IfaceInfoItem -> IfL IdInfo)
-> IdInfo -> [IfaceInfoItem] -> IfL IdInfo
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM IdInfo -> IfaceInfoItem -> IfL IdInfo
tcPrag IdInfo
init_info [IfaceInfoItem]
info
  where
    tcPrag :: IdInfo -> IfaceInfoItem -> IfL IdInfo
    tcPrag :: IdInfo -> IfaceInfoItem -> IfL IdInfo
tcPrag IdInfo
info IfaceInfoItem
HsNoCafRefs        = IdInfo -> IfL IdInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (IdInfo
info IdInfo -> CafInfo -> IdInfo
`setCafInfo`   CafInfo
NoCafRefs)
    tcPrag IdInfo
info (HsArity Int
arity)    = IdInfo -> IfL IdInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (IdInfo
info IdInfo -> Int -> IdInfo
`setArityInfo` Int
arity)
    tcPrag IdInfo
info (HsStrictness StrictSig
str) = IdInfo -> IfL IdInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (IdInfo
info IdInfo -> StrictSig -> IdInfo
`setStrictnessInfo` StrictSig
str)
    tcPrag IdInfo
info (HsInline InlinePragma
prag)    = IdInfo -> IfL IdInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (IdInfo
info IdInfo -> InlinePragma -> IdInfo
`setInlinePragInfo` InlinePragma
prag)
    tcPrag IdInfo
info IfaceInfoItem
HsLevity           = IdInfo -> IfL IdInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (IdInfo
info HasDebugCallStack => IdInfo -> Type -> IdInfo
IdInfo -> Type -> IdInfo
`setNeverLevPoly` Type
ty)

        -- The next two are lazy, so they don't transitively suck stuff in
    tcPrag IdInfo
info (HsUnfold Bool
lb IfaceUnfolding
if_unf)
      = do { Unfolding
unf <- TopLevelFlag
-> Name -> Type -> IdInfo -> IfaceUnfolding -> IfL Unfolding
tcUnfolding TopLevelFlag
toplvl Name
name Type
ty IdInfo
info IfaceUnfolding
if_unf
           ; let info1 :: IdInfo
info1 | Bool
lb        = IdInfo
info IdInfo -> OccInfo -> IdInfo
`setOccInfo` OccInfo
strongLoopBreaker
                       | Bool
otherwise = IdInfo
info
           ; IdInfo -> IfL IdInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (IdInfo
info1 IdInfo -> Unfolding -> IdInfo
`setUnfoldingInfo` Unfolding
unf) }

tcJoinInfo :: IfaceJoinInfo -> Maybe JoinArity
tcJoinInfo :: IfaceJoinInfo -> Maybe Int
tcJoinInfo (IfaceJoinPoint Int
ar) = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
ar
tcJoinInfo IfaceJoinInfo
IfaceNotJoinPoint   = Maybe Int
forall a. Maybe a
Nothing

tcUnfolding :: TopLevelFlag -> Name -> Type -> IdInfo -> IfaceUnfolding -> IfL Unfolding
tcUnfolding :: TopLevelFlag
-> Name -> Type -> IdInfo -> IfaceUnfolding -> IfL Unfolding
tcUnfolding TopLevelFlag
toplvl Name
name Type
_ IdInfo
info (IfCoreUnfold Bool
stable IfaceExpr
if_expr)
  = do  { DynFlags
dflags <- IOEnv (Env IfGblEnv IfLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
        ; Maybe CoreExpr
mb_expr <- TopLevelFlag -> Name -> IfaceExpr -> IfL (Maybe CoreExpr)
tcPragExpr TopLevelFlag
toplvl Name
name IfaceExpr
if_expr
        ; let unf_src :: UnfoldingSource
unf_src | Bool
stable    = UnfoldingSource
InlineStable
                      | Bool
otherwise = UnfoldingSource
InlineRhs
        ; Unfolding -> IfL Unfolding
forall (m :: * -> *) a. Monad m => a -> m a
return (Unfolding -> IfL Unfolding) -> Unfolding -> IfL Unfolding
forall a b. (a -> b) -> a -> b
$ case Maybe CoreExpr
mb_expr of
            Maybe CoreExpr
Nothing -> Unfolding
NoUnfolding
            Just CoreExpr
expr -> DynFlags
-> UnfoldingSource -> Bool -> Bool -> CoreExpr -> Unfolding
mkUnfolding DynFlags
dflags UnfoldingSource
unf_src
                           Bool
True {- Top level -}
                           (StrictSig -> Bool
isBottomingSig StrictSig
strict_sig)
                           CoreExpr
expr
        }
  where
     -- Strictness should occur before unfolding!
    strict_sig :: StrictSig
strict_sig = IdInfo -> StrictSig
strictnessInfo IdInfo
info
tcUnfolding TopLevelFlag
toplvl Name
name Type
_ IdInfo
_ (IfCompulsory IfaceExpr
if_expr)
  = do  { Maybe CoreExpr
mb_expr <- TopLevelFlag -> Name -> IfaceExpr -> IfL (Maybe CoreExpr)
tcPragExpr TopLevelFlag
toplvl Name
name IfaceExpr
if_expr
        ; Unfolding -> IfL Unfolding
forall (m :: * -> *) a. Monad m => a -> m a
return (case Maybe CoreExpr
mb_expr of
                    Maybe CoreExpr
Nothing   -> Unfolding
NoUnfolding
                    Just CoreExpr
expr -> CoreExpr -> Unfolding
mkCompulsoryUnfolding CoreExpr
expr) }

tcUnfolding TopLevelFlag
toplvl Name
name Type
_ IdInfo
_ (IfInlineRule Int
arity Bool
unsat_ok Bool
boring_ok IfaceExpr
if_expr)
  = do  { Maybe CoreExpr
mb_expr <- TopLevelFlag -> Name -> IfaceExpr -> IfL (Maybe CoreExpr)
tcPragExpr TopLevelFlag
toplvl Name
name IfaceExpr
if_expr
        ; Unfolding -> IfL Unfolding
forall (m :: * -> *) a. Monad m => a -> m a
return (case Maybe CoreExpr
mb_expr of
                    Maybe CoreExpr
Nothing   -> Unfolding
NoUnfolding
                    Just CoreExpr
expr -> UnfoldingSource
-> Bool -> CoreExpr -> UnfoldingGuidance -> Unfolding
mkCoreUnfolding UnfoldingSource
InlineStable Bool
True CoreExpr
expr UnfoldingGuidance
guidance )}
  where
    guidance :: UnfoldingGuidance
guidance = UnfWhen :: Int -> Bool -> Bool -> UnfoldingGuidance
UnfWhen { ug_arity :: Int
ug_arity = Int
arity, ug_unsat_ok :: Bool
ug_unsat_ok = Bool
unsat_ok, ug_boring_ok :: Bool
ug_boring_ok = Bool
boring_ok }

tcUnfolding TopLevelFlag
_toplvl Name
name Type
dfun_ty IdInfo
_ (IfDFunUnfold [IfaceBndr]
bs [IfaceExpr]
ops)
  = [IfaceBndr] -> ([Id] -> IfL Unfolding) -> IfL Unfolding
forall a. [IfaceBndr] -> ([Id] -> IfL a) -> IfL a
bindIfaceBndrs [IfaceBndr]
bs (([Id] -> IfL Unfolding) -> IfL Unfolding)
-> ([Id] -> IfL Unfolding) -> IfL Unfolding
forall a b. (a -> b) -> a -> b
$ \ [Id]
bs' ->
    do { Maybe [CoreExpr]
mb_ops1 <- SDoc
-> IOEnv (Env IfGblEnv IfLclEnv) [CoreExpr]
-> IfL (Maybe [CoreExpr])
forall a. SDoc -> IfL a -> IfL (Maybe a)
forkM_maybe SDoc
doc (IOEnv (Env IfGblEnv IfLclEnv) [CoreExpr]
 -> IfL (Maybe [CoreExpr]))
-> IOEnv (Env IfGblEnv IfLclEnv) [CoreExpr]
-> IfL (Maybe [CoreExpr])
forall a b. (a -> b) -> a -> b
$ (IfaceExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr)
-> [IfaceExpr] -> IOEnv (Env IfGblEnv IfLclEnv) [CoreExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
tcIfaceExpr [IfaceExpr]
ops
       ; Unfolding -> IfL Unfolding
forall (m :: * -> *) a. Monad m => a -> m a
return (case Maybe [CoreExpr]
mb_ops1 of
                    Maybe [CoreExpr]
Nothing   -> Unfolding
noUnfolding
                    Just [CoreExpr]
ops1 -> [Id] -> DataCon -> [CoreExpr] -> Unfolding
mkDFunUnfolding [Id]
bs' (Class -> DataCon
classDataCon Class
cls) [CoreExpr]
ops1) }
  where
    doc :: SDoc
doc = String -> SDoc
text String
"Class ops for dfun" SDoc -> SDoc -> SDoc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name
    ([Id]
_, ThetaType
_, Class
cls, ThetaType
_) = Type -> ([Id], ThetaType, Class, ThetaType)
tcSplitDFunTy Type
dfun_ty

{-
For unfoldings we try to do the job lazily, so that we never type check
an unfolding that isn't going to be looked at.
-}

tcPragExpr :: TopLevelFlag -> Name -> IfaceExpr -> IfL (Maybe CoreExpr)
tcPragExpr :: TopLevelFlag -> Name -> IfaceExpr -> IfL (Maybe CoreExpr)
tcPragExpr TopLevelFlag
toplvl Name
name IfaceExpr
expr
  = SDoc
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr -> IfL (Maybe CoreExpr)
forall a. SDoc -> IfL a -> IfL (Maybe a)
forkM_maybe SDoc
doc (IOEnv (Env IfGblEnv IfLclEnv) CoreExpr -> IfL (Maybe CoreExpr))
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr -> IfL (Maybe CoreExpr)
forall a b. (a -> b) -> a -> b
$ do
    CoreExpr
core_expr' <- IfaceExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
tcIfaceExpr IfaceExpr
expr

    -- Check for type consistency in the unfolding
    -- See Note [Linting Unfoldings from Interfaces]
    Bool -> TcRnIf IfGblEnv IfLclEnv () -> TcRnIf IfGblEnv IfLclEnv ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TopLevelFlag -> Bool
isTopLevel TopLevelFlag
toplvl) (TcRnIf IfGblEnv IfLclEnv () -> TcRnIf IfGblEnv IfLclEnv ())
-> TcRnIf IfGblEnv IfLclEnv () -> TcRnIf IfGblEnv IfLclEnv ()
forall a b. (a -> b) -> a -> b
$ GeneralFlag
-> TcRnIf IfGblEnv IfLclEnv () -> TcRnIf IfGblEnv IfLclEnv ()
forall gbl lcl.
GeneralFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
whenGOptM GeneralFlag
Opt_DoCoreLinting (TcRnIf IfGblEnv IfLclEnv () -> TcRnIf IfGblEnv IfLclEnv ())
-> TcRnIf IfGblEnv IfLclEnv () -> TcRnIf IfGblEnv IfLclEnv ()
forall a b. (a -> b) -> a -> b
$ do
        VarSet
in_scope <- IfL VarSet
get_in_scope
        DynFlags
dflags   <- IOEnv (Env IfGblEnv IfLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
        case DynFlags -> SrcLoc -> VarSet -> CoreExpr -> Maybe SDoc
lintUnfolding DynFlags
dflags SrcLoc
noSrcLoc VarSet
in_scope CoreExpr
core_expr' of
          Maybe SDoc
Nothing       -> () -> TcRnIf IfGblEnv IfLclEnv ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Just SDoc
fail_msg -> do { Module
mod <- IfL Module
getIfModule
                              ; String -> SDoc -> TcRnIf IfGblEnv IfLclEnv ()
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Iface Lint failure"
                                  ([SDoc] -> SDoc
vcat [ String -> SDoc
text String
"In interface for" SDoc -> SDoc -> SDoc
<+> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod
                                        , SDoc -> Int -> SDoc -> SDoc
hang SDoc
doc Int
2 SDoc
fail_msg
                                        , Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name SDoc -> SDoc -> SDoc
<+> SDoc
equals SDoc -> SDoc -> SDoc
<+> CoreExpr -> SDoc
forall a. Outputable a => a -> SDoc
ppr CoreExpr
core_expr'
                                        , String -> SDoc
text String
"Iface expr =" SDoc -> SDoc -> SDoc
<+> IfaceExpr -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceExpr
expr ]) }
    CoreExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
return CoreExpr
core_expr'
  where
    doc :: SDoc
doc = String -> SDoc
text String
"Unfolding of" SDoc -> SDoc -> SDoc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name

    get_in_scope :: IfL VarSet -- Totally disgusting; but just for linting
    get_in_scope :: IfL VarSet
get_in_scope
        = do { (IfGblEnv
gbl_env, IfLclEnv
lcl_env) <- TcRnIf IfGblEnv IfLclEnv (IfGblEnv, IfLclEnv)
forall gbl lcl. TcRnIf gbl lcl (gbl, lcl)
getEnvs
             ; [Id]
rec_ids <- case IfGblEnv -> Maybe (Module, IfG (NameEnv TyThing))
if_rec_types IfGblEnv
gbl_env of
                            Maybe (Module, IfG (NameEnv TyThing))
Nothing -> [Id] -> IOEnv (Env IfGblEnv IfLclEnv) [Id]
forall (m :: * -> *) a. Monad m => a -> m a
return []
                            Just (Module
_, IfG (NameEnv TyThing)
get_env) -> do
                               { NameEnv TyThing
type_env <- ()
-> IfG (NameEnv TyThing)
-> IOEnv (Env IfGblEnv IfLclEnv) (NameEnv TyThing)
forall lcl' gbl a lcl.
lcl' -> TcRnIf gbl lcl' a -> TcRnIf gbl lcl a
setLclEnv () IfG (NameEnv TyThing)
get_env
                               ; [Id] -> IOEnv (Env IfGblEnv IfLclEnv) [Id]
forall (m :: * -> *) a. Monad m => a -> m a
return (NameEnv TyThing -> [Id]
typeEnvIds NameEnv TyThing
type_env) }
             ; VarSet -> IfL VarSet
forall (m :: * -> *) a. Monad m => a -> m a
return (FastStringEnv Id -> VarSet
bindingsVars (IfLclEnv -> FastStringEnv Id
if_tv_env IfLclEnv
lcl_env) VarSet -> VarSet -> VarSet
`unionVarSet`
                       FastStringEnv Id -> VarSet
bindingsVars (IfLclEnv -> FastStringEnv Id
if_id_env IfLclEnv
lcl_env) VarSet -> VarSet -> VarSet
`unionVarSet`
                       [Id] -> VarSet
mkVarSet [Id]
rec_ids) }

    bindingsVars :: FastStringEnv Var -> VarSet
    bindingsVars :: FastStringEnv Id -> VarSet
bindingsVars FastStringEnv Id
ufm = [Id] -> VarSet
mkVarSet ([Id] -> VarSet) -> [Id] -> VarSet
forall a b. (a -> b) -> a -> b
$ FastStringEnv Id -> [Id]
forall a. NameEnv a -> [a]
nonDetEltsUFM FastStringEnv Id
ufm
      -- It's OK to use nonDetEltsUFM here because we immediately forget
      -- the ordering by creating a set

{-
************************************************************************
*                                                                      *
                Getting from Names to TyThings
*                                                                      *
************************************************************************
-}

tcIfaceGlobal :: Name -> IfL TyThing
tcIfaceGlobal :: Name -> IfL TyThing
tcIfaceGlobal Name
name
  | Just TyThing
thing <- Name -> Maybe TyThing
wiredInNameTyThing_maybe Name
name
        -- Wired-in things include TyCons, DataCons, and Ids
        -- Even though we are in an interface file, we want to make
        -- sure the instances and RULES of this thing (particularly TyCon) are loaded
        -- Imagine: f :: Double -> Double
  = do { TyThing -> TcRnIf IfGblEnv IfLclEnv ()
ifCheckWiredInThing TyThing
thing; TyThing -> IfL TyThing
forall (m :: * -> *) a. Monad m => a -> m a
return TyThing
thing }

  | Bool
otherwise
  = do  { IfGblEnv
env <- TcRnIf IfGblEnv IfLclEnv IfGblEnv
forall gbl lcl. TcRnIf gbl lcl gbl
getGblEnv
        ; case IfGblEnv -> Maybe (Module, IfG (NameEnv TyThing))
if_rec_types IfGblEnv
env of {    -- Note [Tying the knot]
            Just (Module
mod, IfG (NameEnv TyThing)
get_type_env)
                | Module -> Name -> Bool
nameIsLocalOrFrom Module
mod Name
name
                -> do           -- It's defined in the module being compiled
                { NameEnv TyThing
type_env <- ()
-> IfG (NameEnv TyThing)
-> IOEnv (Env IfGblEnv IfLclEnv) (NameEnv TyThing)
forall lcl' gbl a lcl.
lcl' -> TcRnIf gbl lcl' a -> TcRnIf gbl lcl a
setLclEnv () IfG (NameEnv TyThing)
get_type_env         -- yuk
                ; case NameEnv TyThing -> Name -> Maybe TyThing
forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv NameEnv TyThing
type_env Name
name of
                    Just TyThing
thing -> TyThing -> IfL TyThing
forall (m :: * -> *) a. Monad m => a -> m a
return TyThing
thing
                    -- See Note [Knot-tying fallback on boot]
                    Maybe TyThing
Nothing   -> IfL TyThing
via_external
                }

          ; Maybe (Module, IfG (NameEnv TyThing))
_ -> IfL TyThing
via_external }}
  where
    via_external :: IfL TyThing
via_external =  do
        { HscEnv
hsc_env <- TcRnIf IfGblEnv IfLclEnv HscEnv
forall gbl lcl. TcRnIf gbl lcl HscEnv
getTopEnv
        ; Maybe TyThing
mb_thing <- IO (Maybe TyThing) -> IOEnv (Env IfGblEnv IfLclEnv) (Maybe TyThing)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (HscEnv -> Name -> IO (Maybe TyThing)
lookupTypeHscEnv HscEnv
hsc_env Name
name)
        ; case Maybe TyThing
mb_thing of {
            Just TyThing
thing -> TyThing -> IfL TyThing
forall (m :: * -> *) a. Monad m => a -> m a
return TyThing
thing ;
            Maybe TyThing
Nothing    -> do

        { MaybeErr SDoc TyThing
mb_thing <- Name -> IfM IfLclEnv (MaybeErr SDoc TyThing)
forall lcl. Name -> IfM lcl (MaybeErr SDoc TyThing)
importDecl Name
name   -- It's imported; go get it
        ; case MaybeErr SDoc TyThing
mb_thing of
            Failed SDoc
err      -> SDoc -> IfL TyThing
forall a. SDoc -> IfL a
failIfM SDoc
err
            Succeeded TyThing
thing -> TyThing -> IfL TyThing
forall (m :: * -> *) a. Monad m => a -> m a
return TyThing
thing
        }}}

-- Note [Tying the knot]
-- ~~~~~~~~~~~~~~~~~~~~~
-- The if_rec_types field is used when we are compiling M.hs, which indirectly
-- imports Foo.hi, which mentions M.T Then we look up M.T in M's type
-- environment, which is splatted into if_rec_types after we've built M's type
-- envt.
--
-- This is a dark and complicated part of GHC type checking, with a lot
-- of moving parts.  Interested readers should also look at:
--
--      * Note [Knot-tying typecheckIface]
--      * Note [DFun knot-tying]
--      * Note [hsc_type_env_var hack]
--      * Note [Knot-tying fallback on boot]
--
-- There is also a wiki page on the subject, see:
--
--      https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/tying-the-knot

-- Note [Knot-tying fallback on boot]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- Suppose that you are typechecking A.hs, which transitively imports,
-- via B.hs, A.hs-boot. When we poke on B.hs and discover that it
-- has a reference to a type T from A, what TyThing should we wire
-- it up with? Clearly, if we have already typechecked T and
-- added it into the type environment, we should go ahead and use that
-- type. But what if we haven't typechecked it yet?
--
-- For the longest time, GHC adopted the policy that this was
-- *an error condition*; that you MUST NEVER poke on B.hs's reference
-- to a T defined in A.hs until A.hs has gotten around to kind-checking
-- T and adding it to the env. However, actually ensuring this is the
-- case has proven to be a bug farm, because it's really difficult to
-- actually ensure this never happens. The problem was especially poignant
-- with type family consistency checks, which eagerly happen before any
-- typechecking takes place.
--
-- Today, we take a different strategy: if we ever try to access
-- an entity from A which doesn't exist, we just fall back on the
-- definition of A from the hs-boot file. This is complicated in
-- its own way: it means that you may end up with a mix of A.hs and
-- A.hs-boot TyThings during the course of typechecking.  We don't
-- think (and have not observed) any cases where this would cause
-- problems, but the hypothetical situation one might worry about
-- is something along these lines in Core:
--
--    case x of
--        A -> e1
--        B -> e2
--
-- If, when typechecking this, we find x :: T, and the T we are hooked
-- up with is the abstract one from the hs-boot file, rather than the
-- one defined in this module with constructors A and B.  But it's hard
-- to see how this could happen, especially because the reference to
-- the constructor (A and B) means that GHC will always typecheck
-- this expression *after* typechecking T.

tcIfaceTyConByName :: IfExtName -> IfL TyCon
tcIfaceTyConByName :: Name -> IOEnv (Env IfGblEnv IfLclEnv) TyCon
tcIfaceTyConByName Name
name
  = do { TyThing
thing <- Name -> IfL TyThing
tcIfaceGlobal Name
name
       ; TyCon -> IOEnv (Env IfGblEnv IfLclEnv) TyCon
forall (m :: * -> *) a. Monad m => a -> m a
return (TyThing -> TyCon
tyThingTyCon TyThing
thing) }

tcIfaceTyCon :: IfaceTyCon -> IfL TyCon
tcIfaceTyCon :: IfaceTyCon -> IOEnv (Env IfGblEnv IfLclEnv) TyCon
tcIfaceTyCon (IfaceTyCon Name
name IfaceTyConInfo
info)
  = do { TyThing
thing <- Name -> IfL TyThing
tcIfaceGlobal Name
name
       ; TyCon -> IOEnv (Env IfGblEnv IfLclEnv) TyCon
forall (m :: * -> *) a. Monad m => a -> m a
return (TyCon -> IOEnv (Env IfGblEnv IfLclEnv) TyCon)
-> TyCon -> IOEnv (Env IfGblEnv IfLclEnv) TyCon
forall a b. (a -> b) -> a -> b
$ case IfaceTyConInfo -> PromotionFlag
ifaceTyConIsPromoted IfaceTyConInfo
info of
           PromotionFlag
NotPromoted -> TyThing -> TyCon
tyThingTyCon TyThing
thing
           PromotionFlag
IsPromoted    -> DataCon -> TyCon
promoteDataCon (DataCon -> TyCon) -> DataCon -> TyCon
forall a b. (a -> b) -> a -> b
$ TyThing -> DataCon
tyThingDataCon TyThing
thing }

tcIfaceCoAxiom :: Name -> IfL (CoAxiom Branched)
tcIfaceCoAxiom :: Name -> IfL (CoAxiom Branched)
tcIfaceCoAxiom Name
name = do { TyThing
thing <- Name -> IfL TyThing
tcIfaceImplicit Name
name
                         ; CoAxiom Branched -> IfL (CoAxiom Branched)
forall (m :: * -> *) a. Monad m => a -> m a
return (TyThing -> CoAxiom Branched
tyThingCoAxiom TyThing
thing) }


tcIfaceCoAxiomRule :: IfLclName -> IfL CoAxiomRule
-- Unlike CoAxioms, which arise form user 'type instance' declarations,
-- there are a fixed set of CoAxiomRules,
-- currently enumerated in typeNatCoAxiomRules
tcIfaceCoAxiomRule :: IfLclName -> IOEnv (Env IfGblEnv IfLclEnv) CoAxiomRule
tcIfaceCoAxiomRule IfLclName
n
  = case IfLclName -> Map IfLclName CoAxiomRule -> Maybe CoAxiomRule
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup IfLclName
n Map IfLclName CoAxiomRule
typeNatCoAxiomRules of
        Just CoAxiomRule
ax -> CoAxiomRule -> IOEnv (Env IfGblEnv IfLclEnv) CoAxiomRule
forall (m :: * -> *) a. Monad m => a -> m a
return CoAxiomRule
ax
        Maybe CoAxiomRule
_  -> String -> SDoc -> IOEnv (Env IfGblEnv IfLclEnv) CoAxiomRule
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tcIfaceCoAxiomRule" (IfLclName -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfLclName
n)

tcIfaceDataCon :: Name -> IfL DataCon
tcIfaceDataCon :: Name -> IOEnv (Env IfGblEnv IfLclEnv) DataCon
tcIfaceDataCon Name
name = do { TyThing
thing <- Name -> IfL TyThing
tcIfaceGlobal Name
name
                         ; case TyThing
thing of
                                AConLike (RealDataCon DataCon
dc) -> DataCon -> IOEnv (Env IfGblEnv IfLclEnv) DataCon
forall (m :: * -> *) a. Monad m => a -> m a
return DataCon
dc
                                TyThing
_       -> String -> SDoc -> IOEnv (Env IfGblEnv IfLclEnv) DataCon
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tcIfaceExtDC" (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
nameSDoc -> SDoc -> SDoc
$$ TyThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyThing
thing) }

tcIfaceExtId :: Name -> IfL Id
tcIfaceExtId :: Name -> IfL Id
tcIfaceExtId Name
name = do { TyThing
thing <- Name -> IfL TyThing
tcIfaceGlobal Name
name
                       ; case TyThing
thing of
                          AnId Id
id -> Id -> IfL Id
forall (m :: * -> *) a. Monad m => a -> m a
return Id
id
                          TyThing
_       -> String -> SDoc -> IfL Id
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tcIfaceExtId" (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
nameSDoc -> SDoc -> SDoc
$$ TyThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyThing
thing) }

-- See Note [Resolving never-exported Names in TcIface]
tcIfaceImplicit :: Name -> IfL TyThing
tcIfaceImplicit :: Name -> IfL TyThing
tcIfaceImplicit Name
n = do
    IfLclEnv
lcl_env <- TcRnIf IfGblEnv IfLclEnv IfLclEnv
forall gbl lcl. TcRnIf gbl lcl lcl
getLclEnv
    case IfLclEnv -> Maybe (NameEnv TyThing)
if_implicits_env IfLclEnv
lcl_env of
        Maybe (NameEnv TyThing)
Nothing -> Name -> IfL TyThing
tcIfaceGlobal Name
n
        Just NameEnv TyThing
tenv ->
            case NameEnv TyThing -> Name -> Maybe TyThing
lookupTypeEnv NameEnv TyThing
tenv Name
n of
                Maybe TyThing
Nothing -> String -> SDoc -> IfL TyThing
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tcIfaceInst" (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n SDoc -> SDoc -> SDoc
$$ NameEnv TyThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr NameEnv TyThing
tenv)
                Just TyThing
tything -> TyThing -> IfL TyThing
forall (m :: * -> *) a. Monad m => a -> m a
return TyThing
tything

{-
************************************************************************
*                                                                      *
                Bindings
*                                                                      *
************************************************************************
-}

bindIfaceId :: IfaceIdBndr -> (Id -> IfL a) -> IfL a
bindIfaceId :: IfaceTvBndr -> (Id -> IfL a) -> IfL a
bindIfaceId (IfLclName
fs, IfaceType
ty) Id -> IfL a
thing_inside
  = do  { Name
name <- OccName -> TcRnIf IfGblEnv IfLclEnv Name
newIfaceName (IfLclName -> OccName
mkVarOccFS IfLclName
fs)
        ; Type
ty' <- IfaceType -> IfL Type
tcIfaceType IfaceType
ty
        ; let id :: Id
id = Name -> Type -> Id
mkLocalIdOrCoVar Name
name Type
ty'
        ; [Id] -> IfL a -> IfL a
forall a. [Id] -> IfL a -> IfL a
extendIfaceIdEnv [Id
id] (Id -> IfL a
thing_inside Id
id) }

bindIfaceIds :: [IfaceIdBndr] -> ([Id] -> IfL a) -> IfL a
bindIfaceIds :: [IfaceTvBndr] -> ([Id] -> IfL a) -> IfL a
bindIfaceIds [] [Id] -> IfL a
thing_inside = [Id] -> IfL a
thing_inside []
bindIfaceIds (IfaceTvBndr
b:[IfaceTvBndr]
bs) [Id] -> IfL a
thing_inside
  = IfaceTvBndr -> (Id -> IfL a) -> IfL a
forall a. IfaceTvBndr -> (Id -> IfL a) -> IfL a
bindIfaceId IfaceTvBndr
b   ((Id -> IfL a) -> IfL a) -> (Id -> IfL a) -> IfL a
forall a b. (a -> b) -> a -> b
$ \Id
b'  ->
    [IfaceTvBndr] -> ([Id] -> IfL a) -> IfL a
forall a. [IfaceTvBndr] -> ([Id] -> IfL a) -> IfL a
bindIfaceIds [IfaceTvBndr]
bs (([Id] -> IfL a) -> IfL a) -> ([Id] -> IfL a) -> IfL a
forall a b. (a -> b) -> a -> b
$ \[Id]
bs' ->
    [Id] -> IfL a
thing_inside (Id
b'Id -> [Id] -> [Id]
forall a. a -> [a] -> [a]
:[Id]
bs')

bindIfaceBndr :: IfaceBndr -> (CoreBndr -> IfL a) -> IfL a
bindIfaceBndr :: IfaceBndr -> (Id -> IfL a) -> IfL a
bindIfaceBndr (IfaceIdBndr IfaceTvBndr
bndr) Id -> IfL a
thing_inside
  = IfaceTvBndr -> (Id -> IfL a) -> IfL a
forall a. IfaceTvBndr -> (Id -> IfL a) -> IfL a
bindIfaceId IfaceTvBndr
bndr Id -> IfL a
thing_inside
bindIfaceBndr (IfaceTvBndr IfaceTvBndr
bndr) Id -> IfL a
thing_inside
  = IfaceTvBndr -> (Id -> IfL a) -> IfL a
forall a. IfaceTvBndr -> (Id -> IfL a) -> IfL a
bindIfaceTyVar IfaceTvBndr
bndr Id -> IfL a
thing_inside

bindIfaceBndrs :: [IfaceBndr] -> ([CoreBndr] -> IfL a) -> IfL a
bindIfaceBndrs :: [IfaceBndr] -> ([Id] -> IfL a) -> IfL a
bindIfaceBndrs []     [Id] -> IfL a
thing_inside = [Id] -> IfL a
thing_inside []
bindIfaceBndrs (IfaceBndr
b:[IfaceBndr]
bs) [Id] -> IfL a
thing_inside
  = IfaceBndr -> (Id -> IfL a) -> IfL a
forall a. IfaceBndr -> (Id -> IfL a) -> IfL a
bindIfaceBndr IfaceBndr
b     ((Id -> IfL a) -> IfL a) -> (Id -> IfL a) -> IfL a
forall a b. (a -> b) -> a -> b
$ \ Id
b' ->
    [IfaceBndr] -> ([Id] -> IfL a) -> IfL a
forall a. [IfaceBndr] -> ([Id] -> IfL a) -> IfL a
bindIfaceBndrs [IfaceBndr]
bs   (([Id] -> IfL a) -> IfL a) -> ([Id] -> IfL a) -> IfL a
forall a b. (a -> b) -> a -> b
$ \ [Id]
bs' ->
    [Id] -> IfL a
thing_inside (Id
b'Id -> [Id] -> [Id]
forall a. a -> [a] -> [a]
:[Id]
bs')

-----------------------
bindIfaceForAllBndrs :: [IfaceForAllBndr] -> ([TyCoVarBinder] -> IfL a) -> IfL a
bindIfaceForAllBndrs :: [IfaceForAllBndr] -> ([TyCoVarBinder] -> IfL a) -> IfL a
bindIfaceForAllBndrs [] [TyCoVarBinder] -> IfL a
thing_inside = [TyCoVarBinder] -> IfL a
thing_inside []
bindIfaceForAllBndrs (IfaceForAllBndr
bndr:[IfaceForAllBndr]
bndrs) [TyCoVarBinder] -> IfL a
thing_inside
  = IfaceForAllBndr -> (Id -> ArgFlag -> IfL a) -> IfL a
forall a. IfaceForAllBndr -> (Id -> ArgFlag -> IfL a) -> IfL a
bindIfaceForAllBndr IfaceForAllBndr
bndr ((Id -> ArgFlag -> IfL a) -> IfL a)
-> (Id -> ArgFlag -> IfL a) -> IfL a
forall a b. (a -> b) -> a -> b
$ \Id
tv ArgFlag
vis ->
    [IfaceForAllBndr] -> ([TyCoVarBinder] -> IfL a) -> IfL a
forall a. [IfaceForAllBndr] -> ([TyCoVarBinder] -> IfL a) -> IfL a
bindIfaceForAllBndrs [IfaceForAllBndr]
bndrs (([TyCoVarBinder] -> IfL a) -> IfL a)
-> ([TyCoVarBinder] -> IfL a) -> IfL a
forall a b. (a -> b) -> a -> b
$ \[TyCoVarBinder]
bndrs' ->
    [TyCoVarBinder] -> IfL a
thing_inside (ArgFlag -> Id -> TyCoVarBinder
mkTyCoVarBinder ArgFlag
vis Id
tv TyCoVarBinder -> [TyCoVarBinder] -> [TyCoVarBinder]
forall a. a -> [a] -> [a]
: [TyCoVarBinder]
bndrs')

bindIfaceForAllBndr :: IfaceForAllBndr -> (TyCoVar -> ArgFlag -> IfL a) -> IfL a
bindIfaceForAllBndr :: IfaceForAllBndr -> (Id -> ArgFlag -> IfL a) -> IfL a
bindIfaceForAllBndr (Bndr (IfaceTvBndr IfaceTvBndr
tv) ArgFlag
vis) Id -> ArgFlag -> IfL a
thing_inside
  = IfaceTvBndr -> (Id -> IfL a) -> IfL a
forall a. IfaceTvBndr -> (Id -> IfL a) -> IfL a
bindIfaceTyVar IfaceTvBndr
tv ((Id -> IfL a) -> IfL a) -> (Id -> IfL a) -> IfL a
forall a b. (a -> b) -> a -> b
$ \Id
tv' -> Id -> ArgFlag -> IfL a
thing_inside Id
tv' ArgFlag
vis
bindIfaceForAllBndr (Bndr (IfaceIdBndr IfaceTvBndr
tv) ArgFlag
vis) Id -> ArgFlag -> IfL a
thing_inside
  = IfaceTvBndr -> (Id -> IfL a) -> IfL a
forall a. IfaceTvBndr -> (Id -> IfL a) -> IfL a
bindIfaceId IfaceTvBndr
tv ((Id -> IfL a) -> IfL a) -> (Id -> IfL a) -> IfL a
forall a b. (a -> b) -> a -> b
$ \Id
tv' -> Id -> ArgFlag -> IfL a
thing_inside Id
tv' ArgFlag
vis

bindIfaceTyVar :: IfaceTvBndr -> (TyVar -> IfL a) -> IfL a
bindIfaceTyVar :: IfaceTvBndr -> (Id -> IfL a) -> IfL a
bindIfaceTyVar (IfLclName
occ,IfaceType
kind) Id -> IfL a
thing_inside
  = do  { Name
name <- OccName -> TcRnIf IfGblEnv IfLclEnv Name
newIfaceName (IfLclName -> OccName
mkTyVarOccFS IfLclName
occ)
        ; Id
tyvar <- Name -> IfaceType -> IfL Id
mk_iface_tyvar Name
name IfaceType
kind
        ; [Id] -> IfL a -> IfL a
forall a. [Id] -> IfL a -> IfL a
extendIfaceTyVarEnv [Id
tyvar] (Id -> IfL a
thing_inside Id
tyvar) }

bindIfaceTyVars :: [IfaceTvBndr] -> ([TyVar] -> IfL a) -> IfL a
bindIfaceTyVars :: [IfaceTvBndr] -> ([Id] -> IfL a) -> IfL a
bindIfaceTyVars [] [Id] -> IfL a
thing_inside = [Id] -> IfL a
thing_inside []
bindIfaceTyVars (IfaceTvBndr
bndr:[IfaceTvBndr]
bndrs) [Id] -> IfL a
thing_inside
  = IfaceTvBndr -> (Id -> IfL a) -> IfL a
forall a. IfaceTvBndr -> (Id -> IfL a) -> IfL a
bindIfaceTyVar IfaceTvBndr
bndr   ((Id -> IfL a) -> IfL a) -> (Id -> IfL a) -> IfL a
forall a b. (a -> b) -> a -> b
$ \Id
tv  ->
    [IfaceTvBndr] -> ([Id] -> IfL a) -> IfL a
forall a. [IfaceTvBndr] -> ([Id] -> IfL a) -> IfL a
bindIfaceTyVars [IfaceTvBndr]
bndrs (([Id] -> IfL a) -> IfL a) -> ([Id] -> IfL a) -> IfL a
forall a b. (a -> b) -> a -> b
$ \[Id]
tvs ->
    [Id] -> IfL a
thing_inside (Id
tv Id -> [Id] -> [Id]
forall a. a -> [a] -> [a]
: [Id]
tvs)

mk_iface_tyvar :: Name -> IfaceKind -> IfL TyVar
mk_iface_tyvar :: Name -> IfaceType -> IfL Id
mk_iface_tyvar Name
name IfaceType
ifKind
   = do { Type
kind <- IfaceType -> IfL Type
tcIfaceType IfaceType
ifKind
        ; Id -> IfL Id
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Type -> Id
Var.mkTyVar Name
name Type
kind) }

bindIfaceTyConBinders :: [IfaceTyConBinder]
                      -> ([TyConBinder] -> IfL a) -> IfL a
bindIfaceTyConBinders :: [IfaceTyConBinder] -> ([TyConBinder] -> IfL a) -> IfL a
bindIfaceTyConBinders [] [TyConBinder] -> IfL a
thing_inside = [TyConBinder] -> IfL a
thing_inside []
bindIfaceTyConBinders (IfaceTyConBinder
b:[IfaceTyConBinder]
bs) [TyConBinder] -> IfL a
thing_inside
  = (IfaceBndr -> (Id -> IfL a) -> IfL a)
-> IfaceTyConBinder -> (TyConBinder -> IfL a) -> IfL a
forall a.
(IfaceBndr -> (Id -> IfL a) -> IfL a)
-> IfaceTyConBinder -> (TyConBinder -> IfL a) -> IfL a
bindIfaceTyConBinderX IfaceBndr -> (Id -> IfL a) -> IfL a
forall a. IfaceBndr -> (Id -> IfL a) -> IfL a
bindIfaceBndr IfaceTyConBinder
b ((TyConBinder -> IfL a) -> IfL a)
-> (TyConBinder -> IfL a) -> IfL a
forall a b. (a -> b) -> a -> b
$ \ TyConBinder
b'  ->
    [IfaceTyConBinder] -> ([TyConBinder] -> IfL a) -> IfL a
forall a. [IfaceTyConBinder] -> ([TyConBinder] -> IfL a) -> IfL a
bindIfaceTyConBinders [IfaceTyConBinder]
bs              (([TyConBinder] -> IfL a) -> IfL a)
-> ([TyConBinder] -> IfL a) -> IfL a
forall a b. (a -> b) -> a -> b
$ \ [TyConBinder]
bs' ->
    [TyConBinder] -> IfL a
thing_inside (TyConBinder
b'TyConBinder -> [TyConBinder] -> [TyConBinder]
forall a. a -> [a] -> [a]
:[TyConBinder]
bs')

bindIfaceTyConBinders_AT :: [IfaceTyConBinder]
                         -> ([TyConBinder] -> IfL a) -> IfL a
-- Used for type variable in nested associated data/type declarations
-- where some of the type variables are already in scope
--    class C a where { data T a b }
-- Here 'a' is in scope when we look at the 'data T'
bindIfaceTyConBinders_AT :: [IfaceTyConBinder] -> ([TyConBinder] -> IfL a) -> IfL a
bindIfaceTyConBinders_AT [] [TyConBinder] -> IfL a
thing_inside
  = [TyConBinder] -> IfL a
thing_inside []
bindIfaceTyConBinders_AT (IfaceTyConBinder
b : [IfaceTyConBinder]
bs) [TyConBinder] -> IfL a
thing_inside
  = (IfaceBndr -> (Id -> IfL a) -> IfL a)
-> IfaceTyConBinder -> (TyConBinder -> IfL a) -> IfL a
forall a.
(IfaceBndr -> (Id -> IfL a) -> IfL a)
-> IfaceTyConBinder -> (TyConBinder -> IfL a) -> IfL a
bindIfaceTyConBinderX IfaceBndr -> (Id -> IfL a) -> IfL a
forall a. IfaceBndr -> (Id -> IfL a) -> IfL a
bind_tv IfaceTyConBinder
b  ((TyConBinder -> IfL a) -> IfL a)
-> (TyConBinder -> IfL a) -> IfL a
forall a b. (a -> b) -> a -> b
$ \TyConBinder
b'  ->
    [IfaceTyConBinder] -> ([TyConBinder] -> IfL a) -> IfL a
forall a. [IfaceTyConBinder] -> ([TyConBinder] -> IfL a) -> IfL a
bindIfaceTyConBinders_AT      [IfaceTyConBinder]
bs (([TyConBinder] -> IfL a) -> IfL a)
-> ([TyConBinder] -> IfL a) -> IfL a
forall a b. (a -> b) -> a -> b
$ \[TyConBinder]
bs' ->
    [TyConBinder] -> IfL a
thing_inside (TyConBinder
b'TyConBinder -> [TyConBinder] -> [TyConBinder]
forall a. a -> [a] -> [a]
:[TyConBinder]
bs')
  where
    bind_tv :: IfaceBndr
-> (Id -> IOEnv (Env IfGblEnv IfLclEnv) a)
-> IOEnv (Env IfGblEnv IfLclEnv) a
bind_tv IfaceBndr
tv Id -> IOEnv (Env IfGblEnv IfLclEnv) a
thing
      = do { Maybe Id
mb_tv <- IfaceBndr -> IfL (Maybe Id)
lookupIfaceVar IfaceBndr
tv
           ; case Maybe Id
mb_tv of
               Just Id
b' -> Id -> IOEnv (Env IfGblEnv IfLclEnv) a
thing Id
b'
               Maybe Id
Nothing -> IfaceBndr
-> (Id -> IOEnv (Env IfGblEnv IfLclEnv) a)
-> IOEnv (Env IfGblEnv IfLclEnv) a
forall a. IfaceBndr -> (Id -> IfL a) -> IfL a
bindIfaceBndr IfaceBndr
tv Id -> IOEnv (Env IfGblEnv IfLclEnv) a
thing }

bindIfaceTyConBinderX :: (IfaceBndr -> (TyCoVar -> IfL a) -> IfL a)
                      -> IfaceTyConBinder
                      -> (TyConBinder -> IfL a) -> IfL a
bindIfaceTyConBinderX :: (IfaceBndr -> (Id -> IfL a) -> IfL a)
-> IfaceTyConBinder -> (TyConBinder -> IfL a) -> IfL a
bindIfaceTyConBinderX IfaceBndr -> (Id -> IfL a) -> IfL a
bind_tv (Bndr IfaceBndr
tv TyConBndrVis
vis) TyConBinder -> IfL a
thing_inside
  = IfaceBndr -> (Id -> IfL a) -> IfL a
bind_tv IfaceBndr
tv ((Id -> IfL a) -> IfL a) -> (Id -> IfL a) -> IfL a
forall a b. (a -> b) -> a -> b
$ \Id
tv' ->
    TyConBinder -> IfL a
thing_inside (Id -> TyConBndrVis -> TyConBinder
forall var argf. var -> argf -> VarBndr var argf
Bndr Id
tv' TyConBndrVis
vis)