{-
(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 #-}

{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}

module GHC.IfaceToCore (
        tcLookupImported_maybe,
        importDecl, checkWiredInTyCon, tcHiBootIface, typecheckIface,
        typecheckIfacesForMerging,
        typecheckIfaceForInstantiate,
        tcIfaceDecl, tcIfaceDecls,
        tcIfaceInst, tcIfaceFamInst, tcIfaceRules,
        tcIfaceAnnotations, tcIfaceCompleteMatches,
        tcIfaceExpr,    -- Desired by HERMIT (#7683)
        tcIfaceGlobal,
        tcIfaceOneShot
 ) where

#include "HsVersions.h"

import GHC.Prelude

import GHC.Driver.Env
import GHC.Driver.Session

import GHC.Builtin.Types.Literals(typeNatCoAxiomRules)
import GHC.Builtin.Types

import GHC.Iface.Syntax
import GHC.Iface.Load
import GHC.Iface.Env

import GHC.StgToCmm.Types

import GHC.Tc.TyCl.Build
import GHC.Tc.Utils.Monad
import GHC.Tc.Utils.TcType

import GHC.Core.Type
import GHC.Core.Coercion
import GHC.Core.Coercion.Axiom
import GHC.Core.FVs
import GHC.Core.TyCo.Rep    -- needs to build types & coercions in a knot
import GHC.Core.TyCo.Subst ( substTyCoVars )
import GHC.Core.InstEnv
import GHC.Core.FamInstEnv
import GHC.Core
import GHC.Core.Unify( RoughMatchTc(..) )
import GHC.Core.Utils
import GHC.Core.Unfold.Make
import GHC.Core.Lint
import GHC.Core.Make
import GHC.Core.Class
import GHC.Core.TyCon
import GHC.Core.ConLike
import GHC.Core.DataCon
import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr )
import GHC.Core.Ppr

import GHC.Unit.External
import GHC.Unit.Module
import GHC.Unit.Module.ModDetails
import GHC.Unit.Module.ModIface
import GHC.Unit.Home.ModInfo

import GHC.Utils.Outputable
import GHC.Utils.Misc
import GHC.Utils.Panic
import GHC.Utils.Logger

import GHC.Data.Bag
import GHC.Data.Maybe
import GHC.Data.FastString
import GHC.Data.List.SetOps

import GHC.Types.Annotations
import GHC.Types.SourceFile
import GHC.Types.SourceText
import GHC.Types.Basic hiding ( SuccessFlag(..) )
import GHC.Types.CompleteMatch
import GHC.Types.SrcLoc
import GHC.Types.TypeEnv
import GHC.Types.Unique.FM
import GHC.Types.Unique.DSet ( mkUniqDSet )
import GHC.Types.Unique.Supply
import GHC.Types.Literal
import GHC.Types.Var as Var
import GHC.Types.Var.Set
import GHC.Types.Name
import GHC.Types.Name.Env
import GHC.Types.Name.Set
import GHC.Types.Id
import GHC.Types.Id.Make
import GHC.Types.Id.Info
import GHC.Types.Tickish
import GHC.Types.TyThing

import GHC.Fingerprint
import qualified GHC.Data.BooleanFormula as BF

import Control.Monad
import GHC.Parser.Annotation

{-
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 GHC.IfaceToCore: 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 GHC.Driver.Make: 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 GHC.Driver.Main: 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
  = forall a lcl.
Module -> SDoc -> IsBootInterface -> IfL a -> IfM lcl a
initIfaceLcl (forall (a :: ModIfacePhase). ModIface_ a -> Module
mi_semantic_module ModIface
iface) (String -> SDoc
text String
"typecheckIface") (ModIface -> IsBootInterface
mi_boot ModIface
iface) 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 <- 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)]
tcIfaceDecls Bool
ignore_prags (forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceDeclExts phase]
mi_decls ModIface
iface)
        ; let type_env :: TypeEnv
type_env = forall a. [(Name, a)] -> NameEnv a
mkNameEnv [(Name, TyThing)]
names_w_things

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

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

                -- Complete Sigs
        ; [CompleteMatch]
complete_matches <- [IfaceCompleteMatch] -> IfL [CompleteMatch]
tcIfaceCompleteMatches (forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceCompleteMatch]
mi_complete_matches ModIface
iface)

                -- Finished
        ; forall m n. SDoc -> TcRnIf m n ()
traceIf ([SDoc] -> SDoc
vcat [String -> SDoc
text String
"Finished typechecking interface for" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr (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
<+> forall a. Outputable a => a -> SDoc
ppr (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Name, TyThing)]
names_w_things)])
        ; forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ModDetails { md_types :: TypeEnv
md_types     = TypeEnv
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_matches :: [CompleteMatch]
md_complete_matches = [CompleteMatch]
complete_matches
                              }
    }

{-
************************************************************************
*                                                                      *
                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 } = forall a. a -> Maybe a
Just [Role]
rs
ifMaybeRoles IfaceSynonym { ifRoles :: IfaceDecl -> [Role]
ifRoles = [Role]
rs } = forall a. a -> Maybe a
Just [Role]
rs
ifMaybeRoles IfaceClass   { ifRoles :: IfaceDecl -> [Role]
ifRoles = [Role]
rs } = forall a. a -> Maybe a
Just [Role]
rs
ifMaybeRoles IfaceDecl
_ = 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 FastString
ifMinDef = BooleanFormula FastString
bf1 } } <- IfaceDecl
d1
    , IfaceClass{ ifBody :: IfaceDecl -> IfaceClassBody
ifBody = IfConcreteClass { ifSigs :: IfaceClassBody -> [IfaceClassOp]
ifSigs = [IfaceClassOp]
ops2, ifMinDef :: IfaceClassBody -> BooleanFormula FastString
ifMinDef = BooleanFormula FastString
bf2 } } <- IfaceDecl
d2
    = let ops :: [IfaceClassOp]
ops = forall a. NameEnv a -> [a]
nameEnvElts forall a b. (a -> b) -> a -> b
$
                  forall a. (a -> a -> a) -> NameEnv a -> NameEnv a -> NameEnv a
plusNameEnv_C IfaceClassOp -> IfaceClassOp -> IfaceClassOp
mergeIfaceClassOp
                    (forall a. [(Name, a)] -> NameEnv a
mkNameEnv [ (Name
n, IfaceClassOp
op) | op :: IfaceClassOp
op@(IfaceClassOp Name
n IfaceType
_ Maybe (DefMethSpec IfaceType)
_) <- [IfaceClassOp]
ops1 ])
                    (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 FastString
ifMinDef = forall a. Eq a => [LBooleanFormula a] -> BooleanFormula a
BF.mkOr [forall a an. a -> LocatedAn an a
noLocA BooleanFormula FastString
bf1, forall a an. a -> LocatedAn an a
noLocA BooleanFormula FastString
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 = 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 = forall a b c. String -> (a -> b -> c) -> [a] -> [b] -> [c]
zipWithEqual String
"mergeRoles" 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 = 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 :: forall lcl.
Module
-> [ModIface] -> IORef TypeEnv -> IfM lcl (TypeEnv, [ModDetails])
typecheckIfacesForMerging Module
mod [ModIface]
ifaces IORef TypeEnv
tc_env_var =
  -- cannot be boot (False)
  forall a lcl.
Module -> SDoc -> IsBootInterface -> IfL a -> IfM lcl a
initIfaceLcl Module
mod (String -> SDoc
text String
"typecheckIfacesForMerging") IsBootInterface
NotBoot forall a b. (a -> b) -> a -> b
$ do
    Bool
ignore_prags <- 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 GHC.Iface.Rename
    -- NB: But coercions are OK, because they will have the right OccName.
    let mk_decl_env :: [IfaceDecl] -> OccEnv IfaceDecl
mk_decl_env [IfaceDecl]
decls
            = forall a. [(OccName, a)] -> OccEnv a
mkOccEnv [ (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 = forall a b. (a -> b) -> [a] -> [b]
map ([IfaceDecl] -> OccEnv IfaceDecl
mk_decl_env forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceDeclExts phase]
mi_decls) [ModIface]
ifaces
                        :: [OccEnv IfaceDecl]
        decl_env :: OccEnv IfaceDecl
decl_env = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' OccEnv IfaceDecl -> OccEnv IfaceDecl -> OccEnv IfaceDecl
mergeIfaceDecls forall a. OccEnv a
emptyOccEnv [OccEnv IfaceDecl]
decl_envs
                        ::  OccEnv IfaceDecl
    -- TODO: change tcIfaceDecls to accept w/o Fingerprint
    [(Name, TyThing)]
names_w_things <- Bool -> [(Fingerprint, IfaceDecl)] -> IfL [(Name, TyThing)]
tcIfaceDecls Bool
ignore_prags (forall a b. (a -> b) -> [a] -> [b]
map (\IfaceDecl
x -> (Fingerprint
fingerprint0, IfaceDecl
x))
                                                  (forall a. OccEnv a -> [a]
occEnvElts OccEnv IfaceDecl
decl_env))
    let global_type_env :: TypeEnv
global_type_env = forall a. [(Name, a)] -> NameEnv a
mkNameEnv [(Name, TyThing)]
names_w_things
    forall a env. IORef a -> a -> IOEnv env ()
writeMutVar IORef TypeEnv
tc_env_var TypeEnv
global_type_env

    -- OK, now typecheck each ModIface using this environment
    [ModDetails]
details <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ModIface]
ifaces forall a b. (a -> b) -> a -> b
$ \ModIface
iface -> do
        -- See Note [Resolving never-exported Names] in GHC.IfaceToCore
        TypeEnv
type_env <- forall a env. (a -> IOEnv env a) -> IOEnv env a
fixM forall a b. (a -> b) -> a -> b
$ \TypeEnv
type_env ->
            forall a. TypeEnv -> IfL a -> IfL a
setImplicitEnvM TypeEnv
type_env forall a b. (a -> b) -> a -> b
$ do
                [(Name, TyThing)]
decls <- Bool -> [(Fingerprint, IfaceDecl)] -> IfL [(Name, TyThing)]
tcIfaceDecls Bool
ignore_prags (forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceDeclExts phase]
mi_decls ModIface
iface)
                forall (m :: * -> *) a. Monad m => a -> m a
return (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'
        forall a. TypeEnv -> IfL a -> IfL a
setImplicitEnvM TypeEnv
type_env forall a b. (a -> b) -> a -> b
$ do
        [ClsInst]
insts     <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceClsInst -> IfL ClsInst
tcIfaceInst (forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceClsInst]
mi_insts ModIface
iface)
        [FamInst]
fam_insts <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceFamInst -> IfL FamInst
tcIfaceFamInst (forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceFamInst]
mi_fam_insts ModIface
iface)
        [CoreRule]
rules     <- Bool -> [IfaceRule] -> IfL [CoreRule]
tcIfaceRules Bool
ignore_prags (forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceRule]
mi_rules ModIface
iface)
        [Annotation]
anns      <- [IfaceAnnotation] -> IfL [Annotation]
tcIfaceAnnotations (forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceAnnotation]
mi_anns ModIface
iface)
        [AvailInfo]
exports   <- forall gbl lcl. [AvailInfo] -> TcRnIf gbl lcl [AvailInfo]
ifaceExportNames (forall (phase :: ModIfacePhase). ModIface_ phase -> [AvailInfo]
mi_exports ModIface
iface)
        [CompleteMatch]
complete_matches <- [IfaceCompleteMatch] -> IfL [CompleteMatch]
tcIfaceCompleteMatches (forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceCompleteMatch]
mi_complete_matches ModIface
iface)
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ModDetails { md_types :: TypeEnv
md_types     = TypeEnv
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_matches :: [CompleteMatch]
md_complete_matches = [CompleteMatch]
complete_matches
                            }
    forall (m :: * -> *) a. Monad m => a -> m a
return (TypeEnv
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 :: forall lcl. NameShape -> ModIface -> IfM lcl ModDetails
typecheckIfaceForInstantiate NameShape
nsubst ModIface
iface =
  forall a lcl.
Module
-> SDoc -> IsBootInterface -> NameShape -> IfL a -> IfM lcl a
initIfaceLclWithSubst (forall (a :: ModIfacePhase). ModIface_ a -> Module
mi_semantic_module ModIface
iface)
                        (String -> SDoc
text String
"typecheckIfaceForInstantiate")
                        (ModIface -> IsBootInterface
mi_boot ModIface
iface) NameShape
nsubst forall a b. (a -> b) -> a -> b
$ do
    Bool
ignore_prags <- forall gbl lcl. GeneralFlag -> TcRnIf gbl lcl Bool
goptM GeneralFlag
Opt_IgnoreInterfacePragmas
    -- See Note [Resolving never-exported Names] in GHC.IfaceToCore
    TypeEnv
type_env <- forall a env. (a -> IOEnv env a) -> IOEnv env a
fixM forall a b. (a -> b) -> a -> b
$ \TypeEnv
type_env ->
        forall a. TypeEnv -> IfL a -> IfL a
setImplicitEnvM TypeEnv
type_env forall a b. (a -> b) -> a -> b
$ do
            [(Name, TyThing)]
decls     <- Bool -> [(Fingerprint, IfaceDecl)] -> IfL [(Name, TyThing)]
tcIfaceDecls Bool
ignore_prags (forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceDeclExts phase]
mi_decls ModIface
iface)
            forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. [(Name, a)] -> NameEnv a
mkNameEnv [(Name, TyThing)]
decls)
    -- See Note [rnIfaceNeverExported]
    forall a. TypeEnv -> IfL a -> IfL a
setImplicitEnvM TypeEnv
type_env forall a b. (a -> b) -> a -> b
$ do
    [ClsInst]
insts     <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceClsInst -> IfL ClsInst
tcIfaceInst (forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceClsInst]
mi_insts ModIface
iface)
    [FamInst]
fam_insts <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceFamInst -> IfL FamInst
tcIfaceFamInst (forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceFamInst]
mi_fam_insts ModIface
iface)
    [CoreRule]
rules     <- Bool -> [IfaceRule] -> IfL [CoreRule]
tcIfaceRules Bool
ignore_prags (forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceRule]
mi_rules ModIface
iface)
    [Annotation]
anns      <- [IfaceAnnotation] -> IfL [Annotation]
tcIfaceAnnotations (forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceAnnotation]
mi_anns ModIface
iface)
    [AvailInfo]
exports   <- forall gbl lcl. [AvailInfo] -> TcRnIf gbl lcl [AvailInfo]
ifaceExportNames (forall (phase :: ModIfacePhase). ModIface_ phase -> [AvailInfo]
mi_exports ModIface
iface)
    [CompleteMatch]
complete_matches <- [IfaceCompleteMatch] -> IfL [CompleteMatch]
tcIfaceCompleteMatches (forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceCompleteMatch]
mi_complete_matches ModIface
iface)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ModDetails { md_types :: TypeEnv
md_types     = TypeEnv
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_matches :: [CompleteMatch]
md_complete_matches = [CompleteMatch]
complete_matches
                        }

-- Note [Resolving never-exported Names]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- 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
  = forall (m :: * -> *) a. Monad m => a -> m a
return SelfBootInfo
NoSelfBoot
  | Bool
otherwise
  = do  { forall m n. SDoc -> TcRnIf m n ()
traceIf (String -> SDoc
text String
"loadHiBootInterface" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr Module
mod)

        ; GhcMode
mode <- 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 whether 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 <- forall gbl lcl. TcRnIf gbl lcl HomePackageTable
getHpt
                 ; case HomePackageTable -> ModuleName -> Maybe HomeModInfo
lookupHpt HomePackageTable
hpt (forall unit. GenModule unit -> ModuleName
moduleName Module
mod) of
                      Just HomeModInfo
info | ModIface -> IsBootInterface
mi_boot (HomeModInfo -> ModIface
hm_iface HomeModInfo
info) forall a. Eq a => a -> a -> Bool
== IsBootInterface
IsBoot
                                -> ModIface -> ModDetails -> TcRn SelfBootInfo
mkSelfBootInfo (HomeModInfo -> ModIface
hm_iface HomeModInfo
info) (HomeModInfo -> ModDetails
hm_details HomeModInfo
info)
                      Maybe HomeModInfo
_ -> 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 <- forall gbl lcl.
SDoc
-> InstalledModule
-> Module
-> IsBootInterface
-> TcRnIf gbl lcl (MaybeErr SDoc (ModIface, String))
findAndReadIface
                                SDoc
need (forall a b. (a, b) -> a
fst (Module -> (InstalledModule, Maybe InstantiatedModule)
getModuleInstantiation Module
mod)) Module
mod
                                IsBootInterface
IsBoot  -- Hi-boot file

        ; case MaybeErr SDoc (ModIface, String)
read_result of {
            Succeeded (ModIface
iface, String
_path) -> do { ModDetails
tc_iface <- forall a. IfG a -> TcRn a
initIfaceTcRn 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 <- forall gbl lcl. TcRnIf gbl lcl ExternalPackageState
getEps
        ; case forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
lookupUFM (ExternalPackageState -> ModuleNameEnv ModuleNameWithIsBoot
eps_is_boot ExternalPackageState
eps) (forall unit. GenModule unit -> ModuleName
moduleName Module
mod) of
            -- The typical case
            Maybe ModuleNameWithIsBoot
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return SelfBootInfo
NoSelfBoot
            -- error cases
            Just (GWIB { gwib_isBoot :: forall mod. GenWithIsBoot mod -> IsBootInterface
gwib_isBoot = IsBootInterface
is_boot }) -> case IsBootInterface
is_boot of
              IsBootInterface
IsBoot -> forall a. SDoc -> TcM a
failWithTc (SDoc -> SDoc
elaborate SDoc
err)
              -- The hi-boot file has mysteriously disappeared.
              IsBootInterface
NotBoot -> forall a. SDoc -> TcM a
failWithTc SDoc
moduleLoop
              -- Someone below us imported us!
              -- This is a loop with no hi-boot in the way
    }}}}
  where
    need :: SDoc
need = String -> SDoc
text String
"Need the hi-boot interface for" SDoc -> SDoc -> 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 (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 -> Arity -> SDoc -> SDoc
hang (String -> SDoc
text String
"Could not find hi-boot interface for" SDoc -> SDoc -> SDoc
<+>
                          SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Module
mod) SDoc -> SDoc -> SDoc
<> SDoc
colon) Arity
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 = forall a b. (a -> b) -> [a] -> [b]
map IfaceDecl -> Name
ifName
                 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter IfaceDecl -> Bool
isIfaceTyCon
                 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd
                 forall a b. (a -> b) -> a -> b
$ forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceDeclExts phase]
mi_decls ModIface
iface
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 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
        ; forall (m :: * -> *) a. Monad m => a -> m a
return (CoreBndr -> TyThing
AnId (IdDetails -> Name -> Type -> IdInfo -> CoreBndr
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 })
  = forall a. [IfaceTyConBinder] -> ([TyConBinder] -> IfL a) -> IfL a
bindIfaceTyConBinders_AT [IfaceTyConBinder]
binders forall a b. (a -> b) -> a -> b
$ \ [TyConBinder]
binders' -> do
    { Type
res_kind' <- IfaceType -> IfL Type
tcIfaceType IfaceType
res_kind

    ; TyCon
tycon <- forall a env. (a -> IOEnv env a) -> IOEnv env a
fixM 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
            ; 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) }
    ; forall m n. SDoc -> TcRnIf m n ()
traceIf (String -> SDoc
text String
"tcIfaceDecl4" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr TyCon
tycon)
    ; 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 <- forall gbl lcl. Name -> TcRnIf gbl lcl Name
newTyConRepName Name
tc_name
           ; 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  = forall (br :: BranchFlag). CoAxiom br -> TyCon
coAxiomTyCon CoAxiom Branched
ax
                 ax_unbr :: CoAxiom Unbranched
ax_unbr = forall (br :: BranchFlag). CoAxiom br -> CoAxiom Unbranched
toUnbranchedAxiom CoAxiom Branched
ax
           ; ThetaType
lhs_tys <- IfaceAppArgs -> IfL ThetaType
tcIfaceAppArgs IfaceAppArgs
arg_tys
           ; 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 })
   = forall a. [IfaceTyConBinder] -> ([TyConBinder] -> IfL a) -> IfL a
bindIfaceTyConBinders_AT [IfaceTyConBinder]
binders 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      <- forall a. SDoc -> IfL a -> IfL a
forkM (forall a. Outputable a => a -> SDoc
mk_doc Name
tc_name) 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
     ; 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
<+> 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 FastString
ifResVar = Maybe FastString
res, ifFamInj :: IfaceDecl -> Injectivity
ifFamInj = Injectivity
inj })
   = forall a. [IfaceTyConBinder] -> ([TyConBinder] -> IfL a) -> IfL a
bindIfaceTyConBinders_AT [IfaceTyConBinder]
binders 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      <- forall a. SDoc -> IfL a -> IfL a
forkM (forall a. Outputable a => a -> SDoc
mk_doc Name
tc_name) forall a b. (a -> b) -> a -> b
$
                   Name -> IfaceFamTyConFlav -> IfL FamTyConFlav
tc_fam_flav Name
tc_name IfaceFamTyConFlav
fam_flav
     ; Maybe Name
res_name <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (OccName -> IOEnv (Env IfGblEnv IfLclEnv) Name
newIfaceName forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> OccName
mkTyVarOccFS) Maybe FastString
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
     ; 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
<+> 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 <- forall gbl lcl. Name -> TcRnIf gbl lcl Name
newTyConRepName Name
tc_name
            ; forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> FamTyConFlav
DataFamilyTyCon Name
tc_rep_name) }
     tc_fam_flav Name
_ IfaceFamTyConFlav
IfaceOpenSynFamilyTyCon= 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 <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Name -> IfL (CoAxiom Branched)
tcIfaceCoAxiom forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) Maybe (Name, [IfaceAxBranch])
mb_ax_name_branches
            ; forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (CoAxiom Branched) -> FamTyConFlav
ClosedSynFamilyTyCon Maybe (CoAxiom Branched)
ax) }
     tc_fam_flav Name
_ IfaceFamTyConFlav
IfaceAbstractClosedSynFamilyTyCon
         = forall (m :: * -> *) a. Monad m => a -> m a
return FamTyConFlav
AbstractClosedSynFamilyTyCon
     tc_fam_flav Name
_ IfaceFamTyConFlav
IfaceBuiltInSynFamTyCon
         = 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 FastString]
ifFDs = [FunDep FastString]
rdr_fds,
                         ifBody :: IfaceDecl -> IfaceClassBody
ifBody = IfaceClassBody
IfAbstractClass})
  = forall a. [IfaceTyConBinder] -> ([TyConBinder] -> IfL a) -> IfL a
bindIfaceTyConBinders [IfaceTyConBinder]
binders forall a b. (a -> b) -> a -> b
$ \ [TyConBinder]
binders' -> do
    { [FunDep CoreBndr]
fds  <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FunDep FastString -> IfL (FunDep CoreBndr)
tc_fd [FunDep FastString]
rdr_fds
    ; Class
cls  <- forall m n.
Name
-> [TyConBinder]
-> [Role]
-> [FunDep CoreBndr]
-> Maybe
     (ThetaType, [ClassATItem], [KnotTied MethInfo], ClassMinimalDef)
-> TcRnIf m n Class
buildClass Name
tc_name [TyConBinder]
binders' [Role]
roles [FunDep CoreBndr]
fds forall a. Maybe a
Nothing
    ; 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 FastString]
ifFDs = [FunDep FastString]
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 FastString
ifMinDef = BooleanFormula FastString
mindef_occ
                         }})
  = forall a. [IfaceTyConBinder] -> ([TyConBinder] -> IfL a) -> IfL a
bindIfaceTyConBinders [IfaceTyConBinder]
binders forall a b. (a -> b) -> a -> b
$ \ [TyConBinder]
binders' -> do
    { forall m n. SDoc -> TcRnIf m n ()
traceIf (String -> SDoc
text String
"tc-iface-class1" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr Name
tc_name)
    ; ThetaType
ctxt <- 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
    ; forall m n. SDoc -> TcRnIf m n ()
traceIf (String -> SDoc
text String
"tc-iface-class2" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr Name
tc_name)
    ; [KnotTied MethInfo]
sigs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceClassOp -> IfL (KnotTied MethInfo)
tc_sig [IfaceClassOp]
rdr_sigs
    ; [FunDep CoreBndr]
fds  <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FunDep FastString -> IfL (FunDep CoreBndr)
tc_fd [FunDep FastString]
rdr_fds
    ; forall m n. SDoc -> TcRnIf m n ()
traceIf (String -> SDoc
text String
"tc-iface-class3" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr Name
tc_name)
    ; ClassMinimalDef
mindef <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (OccName -> IOEnv (Env IfGblEnv IfLclEnv) Name
lookupIfaceTop forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> OccName
mkVarOccFS) BooleanFormula FastString
mindef_occ
    ; Class
cls  <- forall a env. (a -> IOEnv env a) -> IOEnv env a
fixM forall a b. (a -> b) -> a -> b
$ \ Class
cls -> do
              { [ClassATItem]
ats  <- 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
              ; forall m n. SDoc -> TcRnIf m n ()
traceIf (String -> SDoc
text String
"tc-iface-class4" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr Name
tc_name)
              ; forall m n.
Name
-> [TyConBinder]
-> [Role]
-> [FunDep CoreBndr]
-> Maybe
     (ThetaType, [ClassATItem], [KnotTied MethInfo], ClassMinimalDef)
-> TcRnIf m n Class
buildClass Name
tc_name [TyConBinder]
binders' [Role]
roles [FunDep CoreBndr]
fds (forall a. a -> Maybe a
Just (ThetaType
ctxt, [ClassATItem]
ats, [KnotTied MethInfo]
sigs, ClassMinimalDef
mindef)) }
    ; 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 = forall a. SDoc -> IfL a -> IfL a
forkM (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 -> IfL (KnotTied MethInfo)
tc_sig (IfaceClassOp Name
op_name IfaceType
rdr_ty Maybe (DefMethSpec IfaceType)
dm)
     = do { let doc :: SDoc
doc = forall {a} {a}. (Outputable a, Outputable a) => a -> a -> SDoc
mk_op_doc Name
op_name IfaceType
rdr_ty
          ; Type
op_ty <- forall a. SDoc -> IfL a -> IfL a
forkM (SDoc
doc SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"ty") 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
          ; 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               = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
   tc_dm SDoc
_   (Just DefMethSpec IfaceType
VanillaDM)      = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just 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' <- forall a. SDoc -> IfL a -> IfL a
forkM (SDoc
doc SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"dm") forall a b. (a -> b) -> a -> b
$ IfaceType -> IfL Type
tcIfaceType IfaceType
ty
             ; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (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 (forall a. a -> Maybe a
Just Class
cls) Bool
ignore_prags IfaceDecl
tc_decl
          Maybe (Type, ATValidityInfo)
mb_def <- case Maybe IfaceType
if_def of
                      Maybe IfaceType
Nothing  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
                      Just IfaceType
def -> forall a. SDoc -> IfL a -> IfL a
forkM (forall a. Outputable a => a -> SDoc
mk_at_doc TyCon
tc)                 forall a b. (a -> b) -> a -> b
$
                                  forall a. [CoreBndr] -> IfL a -> IfL a
extendIfaceTyVarEnv (TyCon -> [CoreBndr]
tyConTyVars TyCon
tc) forall a b. (a -> b) -> a -> b
$
                                  do { Type
tc_def <- IfaceType -> IfL Type
tcIfaceType IfaceType
def
                                     ; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (Type
tc_def, ATValidityInfo
NoATVI)) }
                  -- 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
          forall (m :: * -> *) a. Monad m => a -> m a
return (TyCon -> Maybe (Type, ATValidityInfo) -> ClassATItem
ATI TyCon
tc Maybe (Type, ATValidityInfo)
mb_def)

   mk_sc_doc :: a -> SDoc
mk_sc_doc a
pred = String -> SDoc
text String
"Superclass" SDoc -> SDoc -> 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
<+> 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 [forall a. Outputable a => a -> SDoc
ppr a
op_name, 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 <- forall a. SDoc -> IfL a -> IfL a
forkM (String -> SDoc
text String
"Axiom branches" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr Name
tc_name)
                      forall a b. (a -> b) -> a -> b
$ [IfaceAxBranch] -> IfL [CoAxBranch]
tc_ax_branches [IfaceAxBranch]
branches
       ; let axiom :: CoAxiom Branched
axiom = 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 }
       ; 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 -> [IfaceForAllSpecBndr]
ifPatUnivBndrs = [IfaceForAllSpecBndr]
univ_bndrs
                              , ifPatExBndrs :: IfaceDecl -> [IfaceForAllSpecBndr]
ifPatExBndrs = [IfaceForAllSpecBndr]
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 { forall m n. SDoc -> TcRnIf m n ()
traceIf (String -> SDoc
text String
"tc_iface_decl" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr Name
name)
       ; (Name, Type, Bool)
matcher <- (Name, Bool) -> IfL (Name, Type, Bool)
tc_pr (Name, Bool)
if_matcher
       ; Maybe (Name, Type, Bool)
builder <- forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
fmapMaybeM (Name, Bool) -> IfL (Name, Type, Bool)
tc_pr Maybe (Name, Bool)
if_builder
       ; forall vis a.
[VarBndr IfaceBndr vis]
-> ([VarBndr CoreBndr vis] -> IfL a) -> IfL a
bindIfaceForAllBndrs [IfaceForAllSpecBndr]
univ_bndrs forall a b. (a -> b) -> a -> b
$ \[VarBndr CoreBndr Specificity]
univ_tvs -> do
       { forall vis a.
[VarBndr IfaceBndr vis]
-> ([VarBndr CoreBndr vis] -> IfL a) -> IfL a
bindIfaceForAllBndrs [IfaceForAllSpecBndr]
ex_bndrs forall a b. (a -> b) -> a -> b
$ \[VarBndr CoreBndr Specificity]
ex_tvs -> do
       { PatSyn
patsyn <- forall a. SDoc -> IfL a -> IfL a
forkM (forall a. Outputable a => a -> SDoc
mk_doc Name
name) 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    <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceType -> IfL Type
tcIfaceType IfaceContext
args
                ; forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Name
-> Bool
-> (Name, Type, Bool)
-> Maybe (Name, Type, Bool)
-> ([VarBndr CoreBndr Specificity], ThetaType)
-> ([VarBndr CoreBndr Specificity], ThetaType)
-> ThetaType
-> Type
-> [FieldLabel]
-> PatSyn
buildPatSyn Name
name Bool
is_infix (Name, Type, Bool)
matcher Maybe (Name, Type, Bool)
builder
                                       ([VarBndr CoreBndr Specificity]
univ_tvs, ThetaType
req_theta)
                                       ([VarBndr CoreBndr Specificity]
ex_tvs, ThetaType
prov_theta)
                                       ThetaType
arg_tys Type
pat_ty [FieldLabel]
field_labels }
       ; forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ConLike -> TyThing
AConLike forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatSyn -> ConLike
PatSynCon 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
<+> forall a. Outputable a => a -> SDoc
ppr a
n
     tc_pr :: (IfExtName, Bool) -> IfL (Name, Type, Bool)
     tc_pr :: (Name, Bool) -> IfL (Name, Type, Bool)
tc_pr (Name
nm, Bool
b) = do { CoreBndr
id <- forall a. SDoc -> IfL a -> IfL a
forkM (forall a. Outputable a => a -> SDoc
ppr Name
nm) (Name -> IfL CoreBndr
tcIfaceExtId Name
nm)
                        ; forall (m :: * -> *) a. Monad m => a -> m a
return (Name
nm, CoreBndr -> Type
idType CoreBndr
id, Bool
b) }

tcIfaceDecls :: Bool
          -> [(Fingerprint, IfaceDecl)]
          -> IfL [(Name,TyThing)]
tcIfaceDecls :: Bool -> [(Fingerprint, IfaceDecl)] -> IfL [(Name, TyThing)]
tcIfaceDecls Bool
ignore_prags [(Fingerprint, IfaceDecl)]
ver_decls
   = forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM (Bool -> (Fingerprint, IfaceDecl) -> IfL [(Name, TyThing)]
tc_iface_decl_fingerprint Bool
ignore_prags) [(Fingerprint, IfaceDecl)]
ver_decls

tc_iface_decl_fingerprint :: Bool                    -- Don't load pragmas into the decl pool
          -> (Fingerprint, IfaceDecl)
          -> IfL [(Name,TyThing)]   -- The list can be poked eagerly, but the
                                    -- TyThings are forkM'd thunks
tc_iface_decl_fingerprint :: Bool -> (Fingerprint, IfaceDecl) -> IfL [(Name, TyThing)]
tc_iface_decl_fingerprint Bool
ignore_prags (Fingerprint
_version, IfaceDecl
decl)
  = do  {       -- Populate the name cache with final versions of all
                -- the names associated with the decl
          let main_name :: Name
main_name = IfaceDecl -> Name
ifName IfaceDecl
decl

        -- Typecheck the thing, lazily
        -- NB. Firstly, the laziness is there in case we never need the
        -- declaration (in one-shot mode), and secondly it is there so that
        -- we don't look up the occurrence of a name before calling mk_new_bndr
        -- on the binder.  This is important because we must get the right name
        -- which includes its nameParent.

        ; TyThing
thing <- forall a. SDoc -> IfL a -> IfL a
forkM SDoc
doc forall a b. (a -> b) -> a -> b
$ do { Name -> IfL ()
bumpDeclStats Name
main_name
                                  ; Bool -> IfaceDecl -> IfL TyThing
tcIfaceDecl Bool
ignore_prags IfaceDecl
decl }

        -- Populate the type environment with the implicitTyThings too.
        --
        -- Note [Tricky iface loop]
        -- ~~~~~~~~~~~~~~~~~~~~~~~~
        -- Summary: The delicate point here is that 'mini-env' must be
        -- buildable from 'thing' without demanding any of the things
        -- 'forkM'd by tcIfaceDecl.
        --
        -- In more detail: Consider the example
        --      data T a = MkT { x :: T a }
        -- The implicitTyThings of T are:  [ <datacon MkT>, <selector x>]
        -- (plus their workers, wrappers, coercions etc etc)
        --
        -- We want to return an environment
        --      [ "MkT" -> <datacon MkT>, "x" -> <selector x>, ... ]
        -- (where the "MkT" is the *Name* associated with MkT, etc.)
        --
        -- We do this by mapping the implicit_names to the associated
        -- TyThings.  By the invariant on ifaceDeclImplicitBndrs and
        -- implicitTyThings, we can use getOccName on the implicit
        -- TyThings to make this association: each Name's OccName should
        -- be the OccName of exactly one implicitTyThing.  So the key is
        -- to define a "mini-env"
        --
        -- [ 'MkT' -> <datacon MkT>, 'x' -> <selector x>, ... ]
        -- where the 'MkT' here is the *OccName* associated with MkT.
        --
        -- However, there is a subtlety: due to how type checking needs
        -- to be staged, we can't poke on the forkM'd thunks inside the
        -- implicitTyThings while building this mini-env.
        -- If we poke these thunks too early, two problems could happen:
        --    (1) When processing mutually recursive modules across
        --        hs-boot boundaries, poking too early will do the
        --        type-checking before the recursive knot has been tied,
        --        so things will be type-checked in the wrong
        --        environment, and necessary variables won't be in
        --        scope.
        --
        --    (2) Looking up one OccName in the mini_env will cause
        --        others to be looked up, which might cause that
        --        original one to be looked up again, and hence loop.
        --
        -- The code below works because of the following invariant:
        -- getOccName on a TyThing does not force the suspended type
        -- checks in order to extract the name. For example, we don't
        -- poke on the "T a" type of <selector x> on the way to
        -- extracting <selector x>'s OccName. Of course, there is no
        -- reason in principle why getting the OccName should force the
        -- thunks, but this means we need to be careful in
        -- implicitTyThings and its helper functions.
        --
        -- All a bit too finely-balanced for my liking.

        -- This mini-env and lookup function mediates between the
        --'Name's n and the map from 'OccName's to the implicit TyThings
        ; let mini_env :: OccEnv TyThing
mini_env = forall a. [(OccName, a)] -> OccEnv a
mkOccEnv [(forall a. NamedThing a => a -> OccName
getOccName TyThing
t, TyThing
t) | TyThing
t <- TyThing -> [TyThing]
implicitTyThings TyThing
thing]
              lookup :: Name -> TyThing
lookup Name
n = case forall a. OccEnv a -> OccName -> Maybe a
lookupOccEnv OccEnv TyThing
mini_env (forall a. NamedThing a => a -> OccName
getOccName Name
n) of
                           Just TyThing
thing -> TyThing
thing
                           Maybe TyThing
Nothing    ->
                             forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tc_iface_decl_fingerprint" (forall a. Outputable a => a -> SDoc
ppr Name
main_name SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr Name
n SDoc -> SDoc -> SDoc
$$ forall a. Outputable a => a -> SDoc
ppr (IfaceDecl
decl))

        ; [Name]
implicit_names <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM OccName -> IOEnv (Env IfGblEnv IfLclEnv) Name
lookupIfaceTop (IfaceDecl -> [OccName]
ifaceDeclImplicitBndrs IfaceDecl
decl)

--         ; traceIf (text "Loading decl for " <> ppr main_name $$ ppr implicit_names)
        ; forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (Name
main_name, TyThing
thing) forall a. a -> [a] -> [a]
:
                      -- uses the invariant that implicit_names and
                      -- implicitTyThings are bijective
                      [(Name
n, Name -> TyThing
lookup Name
n) | Name
n <- [Name]
implicit_names]
        }
  where
    doc :: SDoc
doc = String -> SDoc
text String
"Declaration for" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr (IfaceDecl -> Name
ifName IfaceDecl
decl)

bumpDeclStats :: Name -> IfL ()         -- Record that one more declaration has actually been used
bumpDeclStats :: Name -> IfL ()
bumpDeclStats Name
name
  = do  { forall m n. SDoc -> TcRnIf m n ()
traceIf (String -> SDoc
text String
"Loading decl for" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr Name
name)
        ; forall gbl lcl.
(ExternalPackageState -> ExternalPackageState) -> TcRnIf gbl lcl ()
updateEps_ (\ExternalPackageState
eps -> let stats :: EpsStats
stats = ExternalPackageState -> EpsStats
eps_stats ExternalPackageState
eps
                              in ExternalPackageState
eps { eps_stats :: EpsStats
eps_stats = EpsStats
stats { n_decls_out :: Arity
n_decls_out = EpsStats -> Arity
n_decls_out EpsStats
stats forall a. Num a => a -> a -> a
+ Arity
1 } })
        }

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

tc_ax_branches :: [IfaceAxBranch] -> IfL [CoAxBranch]
tc_ax_branches :: [IfaceAxBranch] -> IfL [CoAxBranch]
tc_ax_branches [IfaceAxBranch]
if_branches = 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 -> [IfaceIdBndr]
ifaxbCoVars = [IfaceIdBndr]
cv_bndrs
                            , ifaxbLHS :: IfaceAxBranch -> IfaceAppArgs
ifaxbLHS = IfaceAppArgs
lhs, ifaxbRHS :: IfaceAxBranch -> IfaceType
ifaxbRHS = IfaceType
rhs
                            , ifaxbRoles :: IfaceAxBranch -> [Role]
ifaxbRoles = [Role]
roles, ifaxbIncomps :: IfaceAxBranch -> [Arity]
ifaxbIncomps = [Arity]
incomps })
  = forall a. [IfaceTyConBinder] -> ([TyConBinder] -> IfL a) -> IfL a
bindIfaceTyConBinders_AT
      (forall a b. (a -> b) -> [a] -> [b]
map (\IfaceTvBndr
b -> forall var argf. var -> argf -> VarBndr var argf
Bndr (IfaceTvBndr -> IfaceBndr
IfaceTvBndr IfaceTvBndr
b) (ArgFlag -> TyConBndrVis
NamedTCB ArgFlag
Inferred)) [IfaceTvBndr]
tv_bndrs) forall a b. (a -> b) -> a -> b
$ \ [TyConBinder]
tvs ->
         -- The _AT variant is needed here; see Note [CoAxBranch type variables] in GHC.Core.Coercion.Axiom
    forall a. [IfaceIdBndr] -> ([CoreBndr] -> IfL a) -> IfL a
bindIfaceIds [IfaceIdBndr]
cv_bndrs forall a b. (a -> b) -> a -> b
$ \ [CoreBndr]
cvs -> do
    { ThetaType
tc_lhs   <- IfaceAppArgs -> IfL ThetaType
tcIfaceAppArgs IfaceAppArgs
lhs
    ; Type
tc_rhs   <- IfaceType -> IfL Type
tcIfaceType IfaceType
rhs
    ; [CoreBndr]
eta_tvs  <- forall a. [IfaceTvBndr] -> ([CoreBndr] -> IfL a) -> IfL a
bindIfaceTyVars [IfaceTvBndr]
eta_tv_bndrs forall (m :: * -> *) a. Monad m => a -> m a
return
    ; Module
this_mod <- IfL Module
getIfModule
    ; let loc :: SrcSpan
loc = FastString -> SrcSpan
mkGeneralSrcSpan (String -> FastString
fsLit String
"module " FastString -> FastString -> FastString
`appendFS`
                                  ModuleName -> FastString
moduleNameFS (forall unit. GenModule unit -> ModuleName
moduleName Module
this_mod))
          br :: CoAxBranch
br = CoAxBranch { cab_loc :: SrcSpan
cab_loc     = SrcSpan
loc
                          , cab_tvs :: [CoreBndr]
cab_tvs     = forall tv argf. [VarBndr tv argf] -> [tv]
binderVars [TyConBinder]
tvs
                          , cab_eta_tvs :: [CoreBndr]
cab_eta_tvs = [CoreBndr]
eta_tvs
                          , cab_cvs :: [CoreBndr]
cab_cvs     = [CoreBndr]
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 = forall a b. (a -> b) -> [a] -> [b]
map ([CoAxBranch]
prev_branches forall a. Outputable a => [a] -> Arity -> a
`getNth`) [Arity]
incomps }
    ; forall (m :: * -> *) a. Monad m => a -> m a
return ([CoAxBranch]
prev_branches 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  -> forall (m :: * -> *) a. Monad m => a -> m a
return AlgTyConRhs
AbstractTyCon
        IfDataTyCon [IfaceConDecl]
cons -> do  { [DataCon]
data_cons  <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceConDecl -> IfL DataCon
tc_con_decl [IfaceConDecl]
cons
                                ; forall (m :: * -> *) a. Monad m => a -> m a
return ([DataCon] -> AlgTyConRhs
mkDataTyConRhs [DataCon]
data_cons) }
        IfNewTyCon  IfaceConDecl
con  -> do  { DataCon
data_con  <- IfaceConDecl -> IfL DataCon
tc_con_decl IfaceConDecl
con
                                ; 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 :: [CoreBndr]
univ_tvs = forall tv argf. [VarBndr tv argf] -> [tv]
binderVars [TyConBinder]
tc_tybinders

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

    tc_con_decl :: IfaceConDecl -> IfL DataCon
tc_con_decl (IfCon { ifConInfix :: IfaceConDecl -> Bool
ifConInfix = Bool
is_infix,
                         ifConExTCvs :: IfaceConDecl -> [IfaceBndr]
ifConExTCvs = [IfaceBndr]
ex_bndrs,
                         ifConUserTvBinders :: IfaceConDecl -> [IfaceForAllSpecBndr]
ifConUserTvBinders = [IfaceForAllSpecBndr]
user_bndrs,
                         ifConName :: IfaceConDecl -> Name
ifConName = Name
dc_name,
                         ifConCtxt :: IfaceConDecl -> IfaceContext
ifConCtxt = IfaceContext
ctxt, ifConEqSpec :: IfaceConDecl -> [IfaceTvBndr]
ifConEqSpec = [IfaceTvBndr]
spec,
                         ifConArgTys :: IfaceConDecl -> [(IfaceType, IfaceType)]
ifConArgTys = [(IfaceType, IfaceType)]
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
       forall a. [IfaceBndr] -> ([CoreBndr] -> IfL a) -> IfL a
bindIfaceBndrs [IfaceBndr]
ex_bndrs    forall a b. (a -> b) -> a -> b
$ \ [CoreBndr]
ex_tvs -> do
        { forall m n. SDoc -> TcRnIf m n ()
traceIf (String -> SDoc
text String
"Start interface-file tc_con_decl" SDoc -> SDoc -> 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.
        ; [VarBndr CoreBndr Specificity]
user_tv_bndrs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(Bndr IfaceBndr
bd Specificity
vis) ->
                                   case IfaceBndr
bd of
                                     IfaceIdBndr (IfaceType
_, FastString
name, IfaceType
_) ->
                                       forall var argf. var -> argf -> VarBndr var argf
Bndr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FastString -> IfL CoreBndr
tcIfaceLclId FastString
name forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Specificity
vis
                                     IfaceTvBndr (FastString
name, IfaceType
_) ->
                                       forall var argf. var -> argf -> VarBndr var argf
Bndr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FastString -> IfL CoreBndr
tcIfaceTyVar FastString
name forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Specificity
vis)
                                [IfaceForAllSpecBndr]
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, [Scaled Type]
arg_tys, [HsImplBang]
stricts) <- forall a. SDoc -> IfL a -> IfL a
forkM (forall a. Outputable a => a -> SDoc
mk_doc Name
dc_name) 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]
                ; [Scaled Type]
arg_tys <- forall a. SDoc -> IfL a -> IfL a
forkM (forall a. Outputable a => a -> SDoc
mk_doc Name
dc_name SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"arg_tys")
                           forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(IfaceType
w, IfaceType
ty) -> forall a. Type -> a -> Scaled a
mkScaled forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceType -> IfL Type
tcIfaceType IfaceType
w forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IfaceType -> IfL Type
tcIfaceType IfaceType
ty) [(IfaceType, IfaceType)]
args
                ; [HsImplBang]
stricts <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceBang -> IfL HsImplBang
tc_strict [IfaceBang]
if_stricts
                        -- The IfBang field can mention
                        -- the type itself; hence inside forkM
                ; forall (m :: * -> *) a. Monad m => a -> m a
return ([EqSpec]
eq_spec, ThetaType
theta, [Scaled Type]
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 -> [CoreBndr] -> ThetaType
substTyCoVars ([(CoreBndr, Type)] -> TCvSubst
mkTvSubstPrs (forall a b. (a -> b) -> [a] -> [b]
map EqSpec -> (CoreBndr, Type)
eqSpecPair [EqSpec]
eq_spec))
                                             (forall tv argf. [VarBndr tv argf] -> [tv]
binderVars [TyConBinder]
tc_tybinders))

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

        ; DataCon
con <- forall m n.
FamInstEnvs
-> Name
-> Bool
-> Name
-> [HsSrcBang]
-> Maybe [HsImplBang]
-> [FieldLabel]
-> [CoreBndr]
-> [CoreBndr]
-> [VarBndr CoreBndr Specificity]
-> [EqSpec]
-> ThetaType
-> [Scaled Type]
-> Type
-> TyCon
-> NameEnv Arity
-> TcRnIf m n DataCon
buildDataCon (forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tcIfaceDataCons: FamInstEnvs" (forall a. Outputable a => a -> SDoc
ppr Name
dc_name))
                       Name
dc_name Bool
is_infix Name
prom_rep_name
                       (forall a b. (a -> b) -> [a] -> [b]
map IfaceSrcBang -> HsSrcBang
src_strict [IfaceSrcBang]
if_src_stricts)
                       (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 GHC.Types.Id.Make
                       [FieldLabel]
lbl_names
                       [CoreBndr]
univ_tvs [CoreBndr]
ex_tvs [VarBndr CoreBndr Specificity]
user_tv_bndrs
                       [EqSpec]
eq_spec ThetaType
theta
                       [Scaled Type]
arg_tys Type
orig_res_ty TyCon
tycon NameEnv Arity
tag_map
        ; forall m n. SDoc -> TcRnIf m n ()
traceIf (String -> SDoc
text String
"Done interface-file tc_con_decl" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr Name
dc_name)
        ; 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
<+> forall a. Outputable a => a -> SDoc
ppr a
con_name

    tc_strict :: IfaceBang -> IfL HsImplBang
    tc_strict :: IfaceBang -> IfL HsImplBang
tc_strict IfaceBang
IfNoBang = forall (m :: * -> *) a. Monad m => a -> m a
return (HsImplBang
HsLazy)
    tc_strict IfaceBang
IfStrict = forall (m :: * -> *) a. Monad m => a -> m a
return (HsImplBang
HsStrict)
    tc_strict IfaceBang
IfUnpack = forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Coercion -> HsImplBang
HsUnpack forall a. Maybe a
Nothing)
    tc_strict (IfUnpackCo IfaceCoercion
if_co) = do { Coercion
co <- IfaceCoercion -> IfL Coercion
tcIfaceCo IfaceCoercion
if_co
                                      ; forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Coercion -> HsImplBang
HsUnpack (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
  = 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 (FastString
occ, IfaceType
if_ty) = do { CoreBndr
tv <- FastString -> IfL CoreBndr
tcIfaceTyVar FastString
occ
                              ; Type
ty <- IfaceType -> IfL Type
tcIfaceType IfaceType
if_ty
                              ; forall (m :: * -> *) a. Monad m => a -> m a
return (CoreBndr -> Type -> EqSpec
mkEqSpec CoreBndr
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
*                                                                      *
************************************************************************
-}

tcRoughTyCon :: Maybe IfaceTyCon -> RoughMatchTc
tcRoughTyCon :: Maybe IfaceTyCon -> RoughMatchTc
tcRoughTyCon (Just IfaceTyCon
tc) = Name -> RoughMatchTc
KnownTc (IfaceTyCon -> Name
ifaceTyConName IfaceTyCon
tc)
tcRoughTyCon Maybe IfaceTyCon
Nothing   = RoughMatchTc
OtherTc

tcIfaceInst :: IfaceClsInst -> IfL ClsInst
tcIfaceInst :: IfaceClsInst -> IfL 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 { CoreBndr
dfun <- forall a. SDoc -> IfL a -> IfL a
forkM (String -> SDoc
text String
"Dict fun" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr Name
dfun_name) forall a b. (a -> b) -> a -> b
$
                    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HasDebugCallStack => TyThing -> CoreBndr
tyThingId (Name -> IfL TyThing
tcIfaceImplicit Name
dfun_name)
       ; let mb_tcs' :: [RoughMatchTc]
mb_tcs' = forall a b. (a -> b) -> [a] -> [b]
map Maybe IfaceTyCon -> RoughMatchTc
tcRoughTyCon [Maybe IfaceTyCon]
mb_tcs
       ; forall (m :: * -> *) a. Monad m => a -> m a
return (Name
-> [RoughMatchTc]
-> Name
-> CoreBndr
-> OverlapFlag
-> IsOrphan
-> ClsInst
mkImportedInstance Name
cls [RoughMatchTc]
mb_tcs' Name
dfun_name CoreBndr
dfun OverlapFlag
oflag IsOrphan
orph) }

tcIfaceFamInst :: IfaceFamInst -> IfL FamInst
tcIfaceFamInst :: IfaceFamInst -> IfL 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' <- forall a. SDoc -> IfL a -> IfL a
forkM (String -> SDoc
text String
"Axiom" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr Name
axiom_name) 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'' = forall (br :: BranchFlag). CoAxiom br -> CoAxiom Unbranched
toUnbranchedAxiom CoAxiom Branched
axiom'
               mb_tcs' :: [RoughMatchTc]
mb_tcs' = forall a b. (a -> b) -> [a] -> [b]
map Maybe IfaceTyCon -> RoughMatchTc
tcRoughTyCon [Maybe IfaceTyCon]
mb_tcs
         ; forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> [RoughMatchTc] -> CoAxiom Unbranched -> FamInst
mkImportedFamInst Name
fam [RoughMatchTc]
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 = forall (m :: * -> *) a. Monad m => a -> m a
return []
  | Bool
otherwise    = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceRule -> IfL CoreRule
tcIfaceRule [IfaceRule]
if_rules

tcIfaceRule :: IfaceRule -> IfL CoreRule
tcIfaceRule :: IfaceRule -> IfL CoreRule
tcIfaceRule (IfaceRule {ifRuleName :: IfaceRule -> FastString
ifRuleName = FastString
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  { ~([CoreBndr]
bndrs', [CoreExpr]
args', CoreExpr
rhs') <-
                -- Typecheck the payload lazily, in the hope it'll never be looked at
                forall a. SDoc -> IfL a -> IfL a
forkM (String -> SDoc
text String
"Rule" SDoc -> SDoc -> SDoc
<+> FastString -> SDoc
pprRuleName FastString
name) forall a b. (a -> b) -> a -> b
$
                forall a. [IfaceBndr] -> ([CoreBndr] -> IfL a) -> IfL a
bindIfaceBndrs [IfaceBndr]
bndrs                      forall a b. (a -> b) -> a -> b
$ \ [CoreBndr]
bndrs' ->
                do { [CoreExpr]
args'  <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceExpr -> IfL CoreExpr
tcIfaceExpr [IfaceExpr]
args
                   ; CoreExpr
rhs'   <- IfaceExpr -> IfL CoreExpr
tcIfaceExpr IfaceExpr
rhs
                   ; forall gbl lcl.
GeneralFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
whenGOptM GeneralFlag
Opt_DoCoreLinting forall a b. (a -> b) -> a -> b
$ do
                      { DynFlags
dflags <- forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
                      ; (IfGblEnv
_, IfLclEnv
lcl_env) <- forall gbl lcl. TcRnIf gbl lcl (gbl, lcl)
getEnvs
                      ; let in_scope :: [Var]
                            in_scope :: [CoreBndr]
in_scope = ((forall key elt. UniqFM key elt -> [elt]
nonDetEltsUFM forall a b. (a -> b) -> a -> b
$ IfLclEnv -> FastStringEnv CoreBndr
if_tv_env IfLclEnv
lcl_env) forall a. [a] -> [a] -> [a]
++
                                        (forall key elt. UniqFM key elt -> [elt]
nonDetEltsUFM forall a b. (a -> b) -> a -> b
$ IfLclEnv -> FastStringEnv CoreBndr
if_id_env IfLclEnv
lcl_env) forall a. [a] -> [a] -> [a]
++
                                        [CoreBndr]
bndrs' forall a. [a] -> [a] -> [a]
++
                                        [CoreExpr] -> [CoreBndr]
exprsFreeIdsList [CoreExpr]
args')
                      ; case DynFlags -> [CoreBndr] -> CoreExpr -> Maybe (Bag SDoc)
lintExpr DynFlags
dflags [CoreBndr]
in_scope CoreExpr
rhs' of
                          Maybe (Bag SDoc)
Nothing   -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
                          Just Bag SDoc
errs -> do
                            Logger
logger <- forall (m :: * -> *). HasLogger m => m Logger
getLogger
                            forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Logger -> DynFlags -> Bool -> SDoc -> SDoc -> WarnsAndErrs -> IO ()
displayLintResults Logger
logger DynFlags
dflags Bool
False SDoc
doc
                                               (forall b. OutputableBndr b => Expr b -> SDoc
pprCoreExpr CoreExpr
rhs')
                                               (forall a. Bag a
emptyBag, Bag SDoc
errs) }
                   ; forall (m :: * -> *) a. Monad m => a -> m a
return ([CoreBndr]
bndrs', [CoreExpr]
args', CoreExpr
rhs') }
        ; let mb_tcs :: [Maybe Name]
mb_tcs = forall a b. (a -> b) -> [a] -> [b]
map IfaceExpr -> Maybe Name
ifTopFreeName [IfaceExpr]
args
        ; Module
this_mod <- IfL Module
getIfModule
        ; forall (m :: * -> *) a. Monad m => a -> m a
return (Rule { ru_name :: FastString
ru_name = FastString
name, ru_fn :: Name
ru_fn = Name
fn, ru_act :: Activation
ru_act = Activation
act,
                          ru_bndrs :: [CoreBndr]
ru_bndrs = [CoreBndr]
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
_ )) = forall a. a -> Maybe a
Just (IfaceTyCon -> Name
ifaceTyConName IfaceTyCon
tc)
    ifTopFreeName (IfaceType (IfaceTupleTy TupleSort
s PromotionFlag
_ IfaceAppArgs
ts)) = forall a. a -> Maybe a
Just (TupleSort -> Arity -> Name
tupleTyConName TupleSort
s (forall (t :: * -> *) a. Foldable t => t a -> Arity
length (IfaceAppArgs -> IfaceContext
appArgsIfaceTypes IfaceAppArgs
ts)))
    ifTopFreeName (IfaceApp IfaceExpr
f IfaceExpr
_)                    = IfaceExpr -> Maybe Name
ifTopFreeName IfaceExpr
f
    ifTopFreeName (IfaceExt Name
n)                      = forall a. a -> Maybe a
Just Name
n
    ifTopFreeName IfaceExpr
_                                 = forall a. Maybe a
Nothing

    doc :: SDoc
doc = String -> SDoc
text String
"Unfolding of" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr FastString
name

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

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

tcIfaceAnnotation :: IfaceAnnotation -> IfL Annotation
tcIfaceAnnotation :: IfaceAnnotation -> IfL Annotation
tcIfaceAnnotation (IfaceAnnotation IfaceAnnTarget
target AnnPayload
serialized) = do
    AnnTarget Name
target' <- IfaceAnnTarget -> IfL (AnnTarget Name)
tcIfaceAnnTarget IfaceAnnTarget
target
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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) =
    forall name. name -> AnnTarget name
NamedTarget forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OccName -> IOEnv (Env IfGblEnv IfLclEnv) Name
lookupIfaceTop OccName
occ
tcIfaceAnnTarget (ModuleTarget Module
mod) =
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall name. Module -> AnnTarget name
ModuleTarget Module
mod

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

tcIfaceCompleteMatches :: [IfaceCompleteMatch] -> IfL [CompleteMatch]
tcIfaceCompleteMatches :: [IfaceCompleteMatch] -> IfL [CompleteMatch]
tcIfaceCompleteMatches = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceCompleteMatch -> IfL CompleteMatch
tcIfaceCompleteMatch

tcIfaceCompleteMatch :: IfaceCompleteMatch -> IfL CompleteMatch
tcIfaceCompleteMatch :: IfaceCompleteMatch -> IfL CompleteMatch
tcIfaceCompleteMatch (IfaceCompleteMatch [Name]
ms Maybe IfaceTyCon
mtc) = forall a. SDoc -> IfL a -> IfL a
forkM SDoc
doc forall a b. (a -> b) -> a -> b
$ do -- See Note [Positioning of forkM]
  UniqDSet ConLike
conlikes <- forall a. Uniquable a => [a] -> UniqDSet a
mkUniqDSet forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> IfL ConLike
tcIfaceConLike [Name]
ms
  Maybe TyCon
mtc' <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse IfaceTyCon -> IOEnv (Env IfGblEnv IfLclEnv) TyCon
tcIfaceTyCon Maybe IfaceTyCon
mtc
  forall (m :: * -> *) a. Monad m => a -> m a
return (UniqDSet ConLike -> Maybe TyCon -> CompleteMatch
CompleteMatch UniqDSet ConLike
conlikes Maybe TyCon
mtc')
  where
    doc :: SDoc
doc = String -> SDoc
text String
"COMPLETE sig" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr [Name]
ms

{- Note [Positioning of forkM]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We need to be lazy when type checking the interface, since these functions are
called when the interface itself is being loaded, which means it is not in the
PIT yet. If we are not lazy enough, in certain cases we might recursively try to
load the same interface in an infinite loop.

For this reason, the forkM should be around as much of the computation as
possible.
-}

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

tcIfaceType :: IfaceType -> IfL Type
tcIfaceType :: IfaceType -> IfL Type
tcIfaceType = IfaceType -> IfL Type
go
  where
    go :: IfaceType -> IfL Type
go (IfaceTyVar FastString
n)            = CoreBndr -> Type
TyVarTy forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FastString -> IfL CoreBndr
tcIfaceTyVar FastString
n
    go (IfaceFreeTyVar CoreBndr
n)        = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tcIfaceType:IfaceFreeTyVar" (forall a. Outputable a => a -> SDoc
ppr CoreBndr
n)
    go (IfaceLitTy IfaceTyLit
l)            = TyLit -> Type
LitTy forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceTyLit -> IfL TyLit
tcIfaceTyLit IfaceTyLit
l
    go (IfaceFunTy AnonArgFlag
flag IfaceType
w IfaceType
t1 IfaceType
t2) = AnonArgFlag -> Type -> Type -> Type -> Type
FunTy AnonArgFlag
flag forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceType -> IfL Type
tcIfaceType IfaceType
w forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IfaceType -> IfL Type
go IfaceType
t1 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' <- 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)
           ; forall (f :: * -> *) a. Applicative f => a -> f a
pure (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' <- 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)
           ; forall (m :: * -> *) a. Monad m => a -> m a
return (TyCon -> ThetaType -> Type
mkTyConApp TyCon
tc' ThetaType
tks') }
    go (IfaceForAllTy IfaceForAllBndr
bndr IfaceType
t)
      = forall vis a.
VarBndr IfaceBndr vis -> (CoreBndr -> vis -> IfL a) -> IfL a
bindIfaceForAllBndr IfaceForAllBndr
bndr forall a b. (a -> b) -> a -> b
$ \ CoreBndr
tv' ArgFlag
vis ->
        TyCoVarBinder -> Type -> Type
ForAllTy (forall var argf. var -> argf -> VarBndr var argf
Bndr CoreBndr
tv' ArgFlag
vis) 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceType -> IfL Type
go IfaceType
ty 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 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 :: Arity
arity = forall (t :: * -> *) a. Foldable t => t a -> Arity
length ThetaType
args'
      ; TyCon
base_tc <- Bool -> TupleSort -> Arity -> IOEnv (Env IfGblEnv IfLclEnv) TyCon
tcTupleTyCon Bool
True TupleSort
sort Arity
arity
      ; case PromotionFlag
is_promoted of
          PromotionFlag
NotPromoted
            -> 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 = forall a b. (a -> b) -> [a] -> [b]
map HasDebugCallStack => Type -> Type
typeKind ThetaType
args'
                  ; forall (m :: * -> *) a. Monad m => a -> m a
return (TyCon -> ThetaType -> Type
mkTyConApp TyCon
tc (ThetaType
kind_args forall a. [a] -> [a] -> [a]
++ ThetaType
args')) } }

-- See Note [Unboxed tuple RuntimeRep vars] in GHC.Core.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 -> Arity -> IOEnv (Env IfGblEnv IfLclEnv) TyCon
tcTupleTyCon Bool
in_type TupleSort
sort Arity
arity
  = case TupleSort
sort of
      TupleSort
ConstraintTuple -> forall (m :: * -> *) a. Monad m => a -> m a
return (Arity -> TyCon
cTupleTyCon Arity
arity)
      TupleSort
BoxedTuple      -> forall (m :: * -> *) a. Monad m => a -> m a
return (Boxity -> Arity -> TyCon
tupleTyCon Boxity
Boxed   Arity
arity)
      TupleSort
UnboxedTuple    -> forall (m :: * -> *) a. Monad m => a -> m a
return (Boxity -> Arity -> TyCon
tupleTyCon Boxity
Unboxed Arity
arity')
        where arity' :: Arity
arity' | Bool
in_type   = Arity
arity forall a. Integral a => a -> a -> a
`div` Arity
2
                     | Bool
otherwise = Arity
arity
                      -- in expressions, we only have term args

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

-----------------------------------------
tcIfaceCtxt :: IfaceContext -> IfL ThetaType
tcIfaceCtxt :: IfaceContext -> IfL ThetaType
tcIfaceCtxt IfaceContext
sts = 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 -> IfL TyLit
tcIfaceTyLit (IfaceNumTyLit Integer
n) = forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> TyLit
NumTyLit Integer
n)
tcIfaceTyLit (IfaceStrTyLit FastString
n) = forall (m :: * -> *) a. Monad m => a -> m a
return (FastString -> TyLit
StrTyLit FastString
n)
tcIfaceTyLit (IfaceCharTyLit Char
n) = forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> TyLit
CharTyLit Char
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    = forall (f :: * -> *) a. Applicative f => a -> f a
pure MCoercion
MRefl
    go_mco (IfaceMCo IfaceCoercion
co) = Coercion -> MCoercion
MCo 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 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceType -> IfL Type
tcIfaceType IfaceType
t 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
w IfaceCoercion
c1 IfaceCoercion
c2)    = Role -> Coercion -> Coercion -> Coercion -> Coercion
mkFunCo Role
r forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceCoercion -> IfL Coercion
go IfaceCoercion
w forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IfaceCoercion -> IfL Coercion
go IfaceCoercion
c1 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceTyCon -> IOEnv (Env IfGblEnv IfLclEnv) TyCon
tcIfaceTyCon IfaceTyCon
tc forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceCoercion -> IfL Coercion
go IfaceCoercion
c1 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
                                      ; forall a. IfaceBndr -> (CoreBndr -> IfL a) -> IfL a
bindIfaceBndr IfaceBndr
tv forall a b. (a -> b) -> a -> b
$ \ CoreBndr
tv' ->
                                        CoreBndr -> Coercion -> Coercion -> Coercion
ForAllCo CoreBndr
tv' Coercion
k' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceCoercion -> IfL Coercion
go IfaceCoercion
c }
    go (IfaceCoVarCo FastString
n)          = CoreBndr -> Coercion
CoVarCo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FastString -> IfL CoreBndr
go_var FastString
n
    go (IfaceAxiomInstCo Name
n Arity
i [IfaceCoercion]
cs) = CoAxiom Branched -> Arity -> [Coercion] -> Coercion
AxiomInstCo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> IfL (CoAxiom Branched)
tcIfaceCoAxiom Name
n forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Arity
i forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceUnivCoProv -> IfL UnivCoProvenance
tcIfaceUnivCoProv IfaceUnivCoProv
p forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Role
r
                                          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IfaceType -> IfL Type
tcIfaceType IfaceType
t1 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    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  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceCoercion -> IfL Coercion
go IfaceCoercion
c1
                                            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   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceCoercion -> IfL Coercion
go IfaceCoercion
c1
                                            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IfaceCoercion -> IfL Coercion
go IfaceCoercion
t2
    go (IfaceNthCo Arity
d IfaceCoercion
c)          = do { Coercion
c' <- IfaceCoercion -> IfL Coercion
go IfaceCoercion
c
                                      ; forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ HasDebugCallStack => Role -> Arity -> Coercion -> Coercion
mkNthCo (Arity -> Coercion -> Role
nthCoRole Arity
d Coercion
c') Arity
d Coercion
c' }
    go (IfaceLRCo LeftOrRight
lr IfaceCoercion
c)          = LeftOrRight -> Coercion -> Coercion
LRCo LeftOrRight
lr  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   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    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceCoercion -> IfL Coercion
go IfaceCoercion
c
    go (IfaceAxiomRuleCo FastString
ax [IfaceCoercion]
cos) = CoAxiomRule -> [Coercion] -> Coercion
AxiomRuleCo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FastString -> IfL CoAxiomRule
tcIfaceCoAxiomRule FastString
ax
                                               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 CoreBndr
c)        = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tcIfaceCo:IfaceFreeCoVar" (forall a. Outputable a => a -> SDoc
ppr CoreBndr
c)
    go (IfaceHoleCo CoreBndr
c)           = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tcIfaceCo:IfaceHoleCo"    (forall a. Outputable a => a -> SDoc
ppr CoreBndr
c)

    go_var :: FastString -> IfL CoVar
    go_var :: FastString -> IfL CoreBndr
go_var = FastString -> IfL CoreBndr
tcIfaceLclId

tcIfaceUnivCoProv :: IfaceUnivCoProv -> IfL UnivCoProvenance
tcIfaceUnivCoProv :: IfaceUnivCoProv -> IfL UnivCoProvenance
tcIfaceUnivCoProv (IfacePhantomProv IfaceCoercion
kco)    = Coercion -> UnivCoProvenance
PhantomProv 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceCoercion -> IfL Coercion
tcIfaceCo IfaceCoercion
kco
tcIfaceUnivCoProv (IfacePluginProv String
str)     = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> UnivCoProvenance
PluginProv String
str
tcIfaceUnivCoProv (IfaceCorePrepProv Bool
b)     = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool -> UnivCoProvenance
CorePrepProv Bool
b

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

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

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

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

tcIfaceExpr (IfaceLcl FastString
name)
  = forall b. CoreBndr -> Expr b
Var forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FastString -> IfL CoreBndr
tcIfaceLclId FastString
name

tcIfaceExpr (IfaceExt Name
gbl)
  = forall b. CoreBndr -> Expr b
Var forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> IfL CoreBndr
tcIfaceExtId Name
gbl

tcIfaceExpr (IfaceLitRubbish IfaceType
rep)
  = do Type
rep' <- IfaceType -> IfL Type
tcIfaceType IfaceType
rep
       forall (m :: * -> *) a. Monad m => a -> m a
return (forall b. Literal -> Expr b
Lit (Type -> Literal
LitRubbish Type
rep'))

tcIfaceExpr (IfaceLit Literal
lit)
  = do Literal
lit' <- Literal -> IfL Literal
tcIfaceLit Literal
lit
       forall (m :: * -> *) a. Monad m => a -> m a
return (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 <- forall gbl lcl. TcRnIf gbl lcl Unique
newUnique
    DynFlags
dflags <- forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall b. CoreBndr -> Expr b
Var (DynFlags -> Unique -> ForeignCall -> Type -> CoreBndr
mkFCallId DynFlags
dflags Unique
u ForeignCall
cc Type
ty'))

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

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

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

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

tcIfaceExpr (IfaceCase IfaceExpr
scrut FastString
case_bndr [IfaceAlt]
alts)  = do
    CoreExpr
scrut' <- IfaceExpr -> IfL CoreExpr
tcIfaceExpr IfaceExpr
scrut
    Name
case_bndr_name <- OccName -> IOEnv (Env IfGblEnv IfLclEnv) Name
newIfaceName (FastString -> OccName
mkVarOccFS FastString
case_bndr)
    let
        scrut_ty :: Type
scrut_ty   = CoreExpr -> Type
exprType CoreExpr
scrut'
        case_mult :: Type
case_mult = Type
Many
        case_bndr' :: CoreBndr
case_bndr' = Name -> Type -> Type -> CoreBndr
mkLocalIdOrCoVar Name
case_bndr_name Type
case_mult Type
scrut_ty
     -- "OrCoVar" since a coercion can be a scrutinee with -fdefer-type-errors
     -- (e.g. see test T15695). Ticket #17291 covers fixing this problem.
        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

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

tcIfaceExpr (IfaceLet (IfaceNonRec (IfLetBndr FastString
fs IfaceType
ty IfaceIdInfo
info IfaceJoinInfo
ji) IfaceExpr
rhs) IfaceExpr
body)
  = do  { Name
name    <- OccName -> IOEnv (Env IfGblEnv IfLclEnv) Name
newIfaceName (FastString -> OccName
mkVarOccFS FastString
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 :: CoreBndr
id = HasDebugCallStack => Name -> Type -> Type -> IdInfo -> CoreBndr
mkLocalIdWithInfo Name
name Type
Many Type
ty' IdInfo
id_info
                     CoreBndr -> Maybe Arity -> CoreBndr
`asJoinId_maybe` IfaceJoinInfo -> Maybe Arity
tcJoinInfo IfaceJoinInfo
ji
        ; CoreExpr
rhs' <- IfaceExpr -> IfL CoreExpr
tcIfaceExpr IfaceExpr
rhs
        ; CoreExpr
body' <- forall a. [CoreBndr] -> IfL a -> IfL a
extendIfaceIdEnv [CoreBndr
id] (IfaceExpr -> IfL CoreExpr
tcIfaceExpr IfaceExpr
body)
        ; forall (m :: * -> *) a. Monad m => a -> m a
return (forall b. Bind b -> Expr b -> Expr b
Let (forall b. b -> Expr b -> Bind b
NonRec CoreBndr
id CoreExpr
rhs') CoreExpr
body') }

tcIfaceExpr (IfaceLet (IfaceRec [(IfaceLetBndr, IfaceExpr)]
pairs) IfaceExpr
body)
  = do { [CoreBndr]
ids <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceLetBndr -> IfL CoreBndr
tc_rec_bndr (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(IfaceLetBndr, IfaceExpr)]
pairs)
       ; forall a. [CoreBndr] -> IfL a -> IfL a
extendIfaceIdEnv [CoreBndr]
ids forall a b. (a -> b) -> a -> b
$ do
       { [(CoreBndr, CoreExpr)]
pairs' <- forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (IfaceLetBndr, IfaceExpr)
-> CoreBndr -> IOEnv (Env IfGblEnv IfLclEnv) (CoreBndr, CoreExpr)
tc_pair [(IfaceLetBndr, IfaceExpr)]
pairs [CoreBndr]
ids
       ; CoreExpr
body' <- IfaceExpr -> IfL CoreExpr
tcIfaceExpr IfaceExpr
body
       ; forall (m :: * -> *) a. Monad m => a -> m a
return (forall b. Bind b -> Expr b -> Expr b
Let (forall b. [(b, Expr b)] -> Bind b
Rec [(CoreBndr, CoreExpr)]
pairs') CoreExpr
body') } }
 where
   tc_rec_bndr :: IfaceLetBndr -> IfL CoreBndr
tc_rec_bndr (IfLetBndr FastString
fs IfaceType
ty IfaceIdInfo
_ IfaceJoinInfo
ji)
     = do { Name
name <- OccName -> IOEnv (Env IfGblEnv IfLclEnv) Name
newIfaceName (FastString -> OccName
mkVarOccFS FastString
fs)
          ; Type
ty'  <- IfaceType -> IfL Type
tcIfaceType IfaceType
ty
          ; forall (m :: * -> *) a. Monad m => a -> m a
return (HasDebugCallStack => Name -> Type -> Type -> CoreBndr
mkLocalId Name
name Type
Many Type
ty' CoreBndr -> Maybe Arity -> CoreBndr
`asJoinId_maybe` IfaceJoinInfo -> Maybe Arity
tcJoinInfo IfaceJoinInfo
ji) }
   tc_pair :: (IfaceLetBndr, IfaceExpr)
-> CoreBndr -> IOEnv (Env IfGblEnv IfLclEnv) (CoreBndr, CoreExpr)
tc_pair (IfLetBndr FastString
_ IfaceType
_ IfaceIdInfo
info IfaceJoinInfo
_, IfaceExpr
rhs) CoreBndr
id
     = do { CoreExpr
rhs' <- IfaceExpr -> IfL 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 (CoreBndr -> Name
idName CoreBndr
id) (CoreBndr -> Type
idType CoreBndr
id) IfaceIdInfo
info
          ; forall (m :: * -> *) a. Monad m => a -> m a
return (CoreBndr -> IdInfo -> CoreBndr
setIdInfo CoreBndr
id IdInfo
id_info, CoreExpr
rhs') }

tcIfaceExpr (IfaceTick IfaceTickish
tickish IfaceExpr
expr) = do
    CoreExpr
expr' <- IfaceExpr -> IfL CoreExpr
tcIfaceExpr IfaceExpr
expr
    -- If debug flag is not set: Ignore source notes
    Bool
need_notes <- DynFlags -> Bool
needSourceNotes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
    case IfaceTickish
tickish of
      IfaceSource{} | Bool -> Bool
not (Bool
need_notes)
                    -> forall (m :: * -> *) a. Monad m => a -> m a
return CoreExpr
expr'
      IfaceTickish
_otherwise    -> do
        CoreTickish
tickish' <- forall lcl. IfaceTickish -> IfM lcl CoreTickish
tcIfaceTickish IfaceTickish
tickish
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall b. CoreTickish -> Expr b -> Expr b
Tick CoreTickish
tickish' CoreExpr
expr')

-------------------------
tcIfaceTickish :: IfaceTickish -> IfM lcl CoreTickish
tcIfaceTickish :: forall lcl. IfaceTickish -> IfM lcl CoreTickish
tcIfaceTickish (IfaceHpcTick Module
modl Arity
ix)   = forall (m :: * -> *) a. Monad m => a -> m a
return (forall (pass :: TickishPass). Module -> Arity -> GenTickish pass
HpcTick Module
modl Arity
ix)
tcIfaceTickish (IfaceSCC  CostCentre
cc Bool
tick Bool
push) = forall (m :: * -> *) a. Monad m => a -> m a
return (forall (pass :: TickishPass).
CostCentre -> Bool -> Bool -> GenTickish pass
ProfNote CostCentre
cc Bool
tick Bool
push)
tcIfaceTickish (IfaceSource RealSrcSpan
src String
name)   = forall (m :: * -> *) a. Monad m => a -> m a
return (forall (pass :: TickishPass).
RealSrcSpan -> String -> GenTickish pass
SourceNote RealSrcSpan
src String
name)

-------------------------
tcIfaceLit :: Literal -> IfL Literal
tcIfaceLit :: Literal -> IfL Literal
tcIfaceLit Literal
lit = forall (m :: * -> *) a. Monad m => a -> m a
return Literal
lit

-------------------------
tcIfaceAlt :: CoreExpr -> Mult -> (TyCon, [Type])
           -> IfaceAlt
           -> IfL CoreAlt
tcIfaceAlt :: CoreExpr -> Type -> (TyCon, ThetaType) -> IfaceAlt -> IfL CoreAlt
tcIfaceAlt CoreExpr
_ Type
_ (TyCon, ThetaType)
_ (IfaceAlt IfaceConAlt
IfaceDefault [FastString]
names IfaceExpr
rhs)
  = ASSERT( null names ) do
    rhs' <- tcIfaceExpr rhs
    return (Alt DEFAULT [] rhs')

tcIfaceAlt CoreExpr
_ Type
_ (TyCon, ThetaType)
_ (IfaceAlt (IfaceLitAlt Literal
lit) [FastString]
names IfaceExpr
rhs)
  = ASSERT( null names ) do
    lit' <- tcIfaceLit lit
    rhs' <- tcIfaceExpr rhs
    return (Alt (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 Type
mult (TyCon
tycon, ThetaType
inst_tys) (IfaceAlt (IfaceDataAlt Name
data_occ) [FastString]
arg_strs IfaceExpr
rhs)
  = do  { DataCon
con <- Name -> IfL DataCon
tcIfaceDataCon Name
data_occ
        ; forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
debugIsOn Bool -> Bool -> Bool
&& Bool -> Bool
not (DataCon
con forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` TyCon -> [DataCon]
tyConDataCons TyCon
tycon))
               (forall a. SDoc -> IfL a
failIfM (forall a. Outputable a => a -> SDoc
ppr CoreExpr
scrut SDoc -> SDoc -> SDoc
$$ forall a. Outputable a => a -> SDoc
ppr DataCon
con SDoc -> SDoc -> SDoc
$$ forall a. Outputable a => a -> SDoc
ppr TyCon
tycon SDoc -> SDoc -> SDoc
$$ forall a. Outputable a => a -> SDoc
ppr (TyCon -> [DataCon]
tyConDataCons TyCon
tycon)))
        ; Type
-> DataCon -> ThetaType -> [FastString] -> IfaceExpr -> IfL CoreAlt
tcIfaceDataAlt Type
mult DataCon
con ThetaType
inst_tys [FastString]
arg_strs IfaceExpr
rhs }

tcIfaceDataAlt :: Mult -> DataCon -> [Type] -> [FastString] -> IfaceExpr
               -> IfL CoreAlt
tcIfaceDataAlt :: Type
-> DataCon -> ThetaType -> [FastString] -> IfaceExpr -> IfL CoreAlt
tcIfaceDataAlt Type
mult DataCon
con ThetaType
inst_tys [FastString]
arg_strs IfaceExpr
rhs
  = do  { UniqSupply
us <- forall gbl lcl. TcRnIf gbl lcl UniqSupply
newUniqueSupply
        ; let uniqs :: [Unique]
uniqs = UniqSupply -> [Unique]
uniqsFromSupply UniqSupply
us
        ; let ([CoreBndr]
ex_tvs, [CoreBndr]
arg_ids)
                      = [FastString]
-> [Unique] -> Type -> DataCon -> ThetaType -> FunDep CoreBndr
dataConRepFSInstPat [FastString]
arg_strs [Unique]
uniqs Type
mult DataCon
con ThetaType
inst_tys

        ; CoreExpr
rhs' <- forall a. [CoreBndr] -> IfL a -> IfL a
extendIfaceEnvs  [CoreBndr]
ex_tvs       forall a b. (a -> b) -> a -> b
$
                  forall a. [CoreBndr] -> IfL a -> IfL a
extendIfaceIdEnv [CoreBndr]
arg_ids      forall a b. (a -> b) -> a -> b
$
                  IfaceExpr -> IfL CoreExpr
tcIfaceExpr IfaceExpr
rhs
        ; forall (m :: * -> *) a. Monad m => a -> m a
return (forall b. AltCon -> [b] -> Expr b -> Alt b
Alt (DataCon -> AltCon
DataAlt DataCon
con) ([CoreBndr]
ex_tvs forall a. [a] -> [a] -> [a]
++ [CoreBndr]
arg_ids) CoreExpr
rhs') }

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

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

tcIdDetails Type
_ (IfRecSelId Either IfaceTyCon IfaceDecl
tc Bool
naughty)
  = do { RecSelParent
tc' <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TyCon -> RecSelParent
RecSelData forall b c a. (b -> c) -> (a -> b) -> a -> c
. IfaceTyCon -> IOEnv (Env IfGblEnv IfLclEnv) TyCon
tcIfaceTyCon)
                       (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PatSyn -> RecSelParent
RecSelPatSyn forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyThing -> PatSyn
tyThingPatSyn) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> IfaceDecl -> IfL TyThing
tcIfaceDecl Bool
False)
                       Either IfaceTyCon IfaceDecl
tc
       ; forall (m :: * -> *) a. Monad m => a -> m a
return (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
_ = 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 <- 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 = if IfLclEnv -> IsBootInterface
if_boot IfLclEnv
lcl_env forall a. Eq a => a -> a -> Bool
== IsBootInterface
IsBoot
                      then IdInfo
vanillaIdInfo IdInfo -> Unfolding -> IdInfo
`setUnfoldingInfo` Unfolding
BootUnfolding
                      else IdInfo
vanillaIdInfo

    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 (IfaceIdInfo -> IfaceIdInfo
needed_prags IfaceIdInfo
info)
  where
    needed_prags :: [IfaceInfoItem] -> [IfaceInfoItem]
    needed_prags :: IfaceIdInfo -> IfaceIdInfo
needed_prags IfaceIdInfo
items
      | Bool -> Bool
not Bool
ignore_prags = IfaceIdInfo
items
      | Bool
otherwise        = forall a. (a -> Bool) -> [a] -> [a]
filter IfaceInfoItem -> Bool
need_prag IfaceIdInfo
items

    need_prag :: IfaceInfoItem -> Bool
      -- Always read in compulsory unfoldings
      -- See Note [Always expose compulsory unfoldings] in GHC.Iface.Tidy
    need_prag :: IfaceInfoItem -> Bool
need_prag (HsUnfold Bool
_ (IfCompulsory {})) = Bool
True
    need_prag IfaceInfoItem
_                              = Bool
False

    tcPrag :: IdInfo -> IfaceInfoItem -> IfL IdInfo
    tcPrag :: IdInfo -> IfaceInfoItem -> IfL IdInfo
tcPrag IdInfo
info IfaceInfoItem
HsNoCafRefs        = forall (m :: * -> *) a. Monad m => a -> m a
return (IdInfo
info IdInfo -> CafInfo -> IdInfo
`setCafInfo`   CafInfo
NoCafRefs)
    tcPrag IdInfo
info (HsArity Arity
arity)    = forall (m :: * -> *) a. Monad m => a -> m a
return (IdInfo
info IdInfo -> Arity -> IdInfo
`setArityInfo` Arity
arity)
    tcPrag IdInfo
info (HsStrictness StrictSig
str) = forall (m :: * -> *) a. Monad m => a -> m a
return (IdInfo
info IdInfo -> StrictSig -> IdInfo
`setStrictnessInfo` StrictSig
str)
    tcPrag IdInfo
info (HsCpr CprSig
cpr)        = forall (m :: * -> *) a. Monad m => a -> m a
return (IdInfo
info IdInfo -> CprSig -> IdInfo
`setCprInfo` CprSig
cpr)
    tcPrag IdInfo
info (HsInline InlinePragma
prag)    = forall (m :: * -> *) a. Monad m => a -> m a
return (IdInfo
info IdInfo -> InlinePragma -> IdInfo
`setInlinePragInfo` InlinePragma
prag)
    tcPrag IdInfo
info IfaceInfoItem
HsLevity           = forall (m :: * -> *) a. Monad m => a -> m a
return (IdInfo
info HasDebugCallStack => IdInfo -> Type -> IdInfo
`setNeverLevPoly` Type
ty)
    tcPrag IdInfo
info (HsLFInfo IfaceLFInfo
lf_info) = do
      LambdaFormInfo
lf_info <- IfaceLFInfo -> IfL LambdaFormInfo
tcLFInfo IfaceLFInfo
lf_info
      forall (m :: * -> *) a. Monad m => a -> m a
return (IdInfo
info IdInfo -> LambdaFormInfo -> IdInfo
`setLFInfo` LambdaFormInfo
lf_info)

        -- 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
           ; forall (m :: * -> *) a. Monad m => a -> m a
return (IdInfo
info1 IdInfo -> Unfolding -> IdInfo
`setUnfoldingInfo` Unfolding
unf) }

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

tcLFInfo :: IfaceLFInfo -> IfL LambdaFormInfo
tcLFInfo :: IfaceLFInfo -> IfL LambdaFormInfo
tcLFInfo IfaceLFInfo
lfi = case IfaceLFInfo
lfi of
    IfLFReEntrant Arity
rep_arity ->
      -- LFReEntrant closures in interface files are guaranteed to
      --
      -- - Be top-level, as only top-level closures are exported.
      -- - Have no free variables, as only non-top-level closures have free
      --   variables
      -- - Don't have ArgDescrs, as ArgDescr is used when generating code for
      --   the closure
      --
      -- These invariants are checked when generating LFInfos in toIfaceLFInfo.
      forall (m :: * -> *) a. Monad m => a -> m a
return (TopLevelFlag -> Arity -> Bool -> ArgDescr -> LambdaFormInfo
LFReEntrant TopLevelFlag
TopLevel Arity
rep_arity Bool
True ArgDescr
ArgUnknown)

    IfLFThunk Bool
updatable Bool
mb_fun ->
      -- LFThunk closure in interface files are guaranteed to
      --
      -- - Be top-level
      -- - No have free variables
      --
      -- These invariants are checked when generating LFInfos in toIfaceLFInfo.
      forall (m :: * -> *) a. Monad m => a -> m a
return (TopLevelFlag
-> Bool -> Bool -> StandardFormInfo -> Bool -> LambdaFormInfo
LFThunk TopLevelFlag
TopLevel Bool
True Bool
updatable StandardFormInfo
NonStandardThunk Bool
mb_fun)

    IfaceLFInfo
IfLFUnlifted ->
      forall (m :: * -> *) a. Monad m => a -> m a
return LambdaFormInfo
LFUnlifted

    IfLFCon Name
con_name ->
      DataCon -> LambdaFormInfo
LFCon forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Name -> IfL DataCon
tcIfaceDataCon Name
con_name

    IfLFUnknown Bool
fun_flag ->
      forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> LambdaFormInfo
LFUnknown Bool
fun_flag)

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  { UnfoldingOpts
uf_opts <- DynFlags -> UnfoldingOpts
unfoldingOpts forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
        ; Maybe CoreExpr
mb_expr <- Bool -> TopLevelFlag -> Name -> IfaceExpr -> IfL (Maybe CoreExpr)
tcPragExpr Bool
False TopLevelFlag
toplvl Name
name IfaceExpr
if_expr
        ; let unf_src :: UnfoldingSource
unf_src | Bool
stable    = UnfoldingSource
InlineStable
                      | Bool
otherwise = UnfoldingSource
InlineRhs
        ; forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe CoreExpr
mb_expr of
            Maybe CoreExpr
Nothing -> Unfolding
NoUnfolding
            Just CoreExpr
expr -> UnfoldingOpts
-> UnfoldingSource -> StrictSig -> CoreExpr -> Unfolding
mkFinalUnfolding UnfoldingOpts
uf_opts UnfoldingSource
unf_src 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 <- Bool -> TopLevelFlag -> Name -> IfaceExpr -> IfL (Maybe CoreExpr)
tcPragExpr Bool
True TopLevelFlag
toplvl Name
name IfaceExpr
if_expr
        ; 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 Arity
arity Bool
unsat_ok Bool
boring_ok IfaceExpr
if_expr)
  = do  { Maybe CoreExpr
mb_expr <- Bool -> TopLevelFlag -> Name -> IfaceExpr -> IfL (Maybe CoreExpr)
tcPragExpr Bool
False TopLevelFlag
toplvl Name
name IfaceExpr
if_expr
        ; 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 { ug_arity :: Arity
ug_arity = Arity
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)
  = forall a. [IfaceBndr] -> ([CoreBndr] -> IfL a) -> IfL a
bindIfaceBndrs [IfaceBndr]
bs forall a b. (a -> b) -> a -> b
$ \ [CoreBndr]
bs' ->
    do { Maybe [CoreExpr]
mb_ops1 <- forall a. SDoc -> IfL a -> IfL (Maybe a)
forkM_maybe SDoc
doc forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceExpr -> IfL CoreExpr
tcIfaceExpr [IfaceExpr]
ops
       ; forall (m :: * -> *) a. Monad m => a -> m a
return (case Maybe [CoreExpr]
mb_ops1 of
                    Maybe [CoreExpr]
Nothing   -> Unfolding
noUnfolding
                    Just [CoreExpr]
ops1 -> [CoreBndr] -> DataCon -> [CoreExpr] -> Unfolding
mkDFunUnfolding [CoreBndr]
bs' (Class -> DataCon
classDataCon Class
cls) [CoreExpr]
ops1) }
  where
    doc :: SDoc
doc = String -> SDoc
text String
"Class ops for dfun" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr Name
name
    ([CoreBndr]
_, ThetaType
_, Class
cls, ThetaType
_) = Type -> ([CoreBndr], 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 :: Bool  -- Is this unfolding compulsory?
                    -- See Note [Checking for levity polymorphism] in GHC.Core.Lint
           -> TopLevelFlag -> Name -> IfaceExpr -> IfL (Maybe CoreExpr)
tcPragExpr :: Bool -> TopLevelFlag -> Name -> IfaceExpr -> IfL (Maybe CoreExpr)
tcPragExpr Bool
is_compulsory TopLevelFlag
toplvl Name
name IfaceExpr
expr
  = forall a. SDoc -> IfL a -> IfL (Maybe a)
forkM_maybe SDoc
doc forall a b. (a -> b) -> a -> b
$ do
    CoreExpr
core_expr' <- IfaceExpr -> IfL CoreExpr
tcIfaceExpr IfaceExpr
expr

    -- Check for type consistency in the unfolding
    -- See Note [Linting Unfoldings from Interfaces] in GHC.Core.Lint
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TopLevelFlag -> Bool
isTopLevel TopLevelFlag
toplvl) forall a b. (a -> b) -> a -> b
$
      forall gbl lcl.
GeneralFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
whenGOptM GeneralFlag
Opt_DoCoreLinting forall a b. (a -> b) -> a -> b
$ do
        VarSet
in_scope <- IfL VarSet
get_in_scope
        DynFlags
dflags   <- forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
        Logger
logger   <- forall (m :: * -> *). HasLogger m => m Logger
getLogger
        case Bool
-> DynFlags -> SrcLoc -> VarSet -> CoreExpr -> Maybe (Bag SDoc)
lintUnfolding Bool
is_compulsory DynFlags
dflags SrcLoc
noSrcLoc VarSet
in_scope CoreExpr
core_expr' of
          Maybe (Bag SDoc)
Nothing   -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Just Bag SDoc
errs -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
            Logger -> DynFlags -> Bool -> SDoc -> SDoc -> WarnsAndErrs -> IO ()
displayLintResults Logger
logger DynFlags
dflags Bool
False SDoc
doc
                               (forall b. OutputableBndr b => Expr b -> SDoc
pprCoreExpr CoreExpr
core_expr') (forall a. Bag a
emptyBag, Bag SDoc
errs)
    forall (m :: * -> *) a. Monad m => a -> m a
return CoreExpr
core_expr'
  where
    doc :: SDoc
doc = Bool -> SDoc -> SDoc
ppWhen Bool
is_compulsory (String -> SDoc
text String
"Compulsory") SDoc -> SDoc -> SDoc
<+>
          String -> SDoc
text String
"Unfolding of" SDoc -> SDoc -> 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) <- forall gbl lcl. TcRnIf gbl lcl (gbl, lcl)
getEnvs
             ; [CoreBndr]
rec_ids <- case IfGblEnv -> Maybe (Module, IfG TypeEnv)
if_rec_types IfGblEnv
gbl_env of
                            Maybe (Module, IfG TypeEnv)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return []
                            Just (Module
_, IfG TypeEnv
get_env) -> do
                               { TypeEnv
type_env <- forall lcl' gbl a lcl.
lcl' -> TcRnIf gbl lcl' a -> TcRnIf gbl lcl a
setLclEnv () IfG TypeEnv
get_env
                               ; forall (m :: * -> *) a. Monad m => a -> m a
return (TypeEnv -> [CoreBndr]
typeEnvIds TypeEnv
type_env) }
             ; forall (m :: * -> *) a. Monad m => a -> m a
return (FastStringEnv CoreBndr -> VarSet
bindingsVars (IfLclEnv -> FastStringEnv CoreBndr
if_tv_env IfLclEnv
lcl_env) VarSet -> VarSet -> VarSet
`unionVarSet`
                       FastStringEnv CoreBndr -> VarSet
bindingsVars (IfLclEnv -> FastStringEnv CoreBndr
if_id_env IfLclEnv
lcl_env) VarSet -> VarSet -> VarSet
`unionVarSet`
                       [CoreBndr] -> VarSet
mkVarSet [CoreBndr]
rec_ids) }

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

tcIfaceOneShot :: IfaceOneShot -> OneShotInfo
tcIfaceOneShot :: IfaceOneShot -> OneShotInfo
tcIfaceOneShot IfaceOneShot
IfaceNoOneShot = OneShotInfo
NoOneShotInfo
tcIfaceOneShot IfaceOneShot
IfaceOneShot = OneShotInfo
OneShotLam

{-
************************************************************************
*                                                                      *
                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 -> IfL ()
ifCheckWiredInThing TyThing
thing; forall (m :: * -> *) a. Monad m => a -> m a
return TyThing
thing }

  | Bool
otherwise
  = do  { IfGblEnv
env <- forall gbl lcl. TcRnIf gbl lcl gbl
getGblEnv
        ; case IfGblEnv -> Maybe (Module, IfG TypeEnv)
if_rec_types IfGblEnv
env of {    -- Note [Tying the knot]
            Just (Module
mod, IfG TypeEnv
get_type_env)
                | Module -> Name -> Bool
nameIsLocalOrFrom Module
mod Name
name
                -> do           -- It's defined in the module being compiled
                { TypeEnv
type_env <- forall lcl' gbl a lcl.
lcl' -> TcRnIf gbl lcl' a -> TcRnIf gbl lcl a
setLclEnv () IfG TypeEnv
get_type_env         -- yuk
                ; case forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv TypeEnv
type_env Name
name of
                    Just TyThing
thing -> 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 TypeEnv)
_ -> IfL TyThing
via_external }}
  where
    via_external :: IfL TyThing
via_external =  do
        { HscEnv
hsc_env <- forall gbl lcl. TcRnIf gbl lcl HscEnv
getTopEnv
        ; Maybe TyThing
mb_thing <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (HscEnv -> Name -> IO (Maybe TyThing)
lookupType HscEnv
hsc_env Name
name)
        ; case Maybe TyThing
mb_thing of {
            Just TyThing
thing -> forall (m :: * -> *) a. Monad m => a -> m a
return TyThing
thing ;
            Maybe TyThing
Nothing    -> do

        { MaybeErr SDoc TyThing
mb_thing <- 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      -> forall a. SDoc -> IfL a
failIfM SDoc
err
            Succeeded TyThing
thing -> 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.

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
       ; forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case IfaceTyConInfo -> PromotionFlag
ifaceTyConIsPromoted IfaceTyConInfo
info of
           PromotionFlag
NotPromoted -> HasDebugCallStack => TyThing -> TyCon
tyThingTyCon TyThing
thing
           PromotionFlag
IsPromoted  -> DataCon -> TyCon
promoteDataCon forall a b. (a -> b) -> a -> b
$ HasDebugCallStack => 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
                         ; forall (m :: * -> *) a. Monad m => a -> m a
return (HasDebugCallStack => 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 :: FastString -> IfL CoAxiomRule
tcIfaceCoAxiomRule FastString
n
  = case forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
lookupUFM UniqFM FastString CoAxiomRule
typeNatCoAxiomRules FastString
n of
        Just CoAxiomRule
ax -> forall (m :: * -> *) a. Monad m => a -> m a
return CoAxiomRule
ax
        Maybe CoAxiomRule
_  -> forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tcIfaceCoAxiomRule" (forall a. Outputable a => a -> SDoc
ppr FastString
n)

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

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

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

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

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

bindIfaceId :: IfaceIdBndr -> (Id -> IfL a) -> IfL a
bindIfaceId :: forall a. IfaceIdBndr -> (CoreBndr -> IfL a) -> IfL a
bindIfaceId (IfaceType
w, FastString
fs, IfaceType
ty) CoreBndr -> IfL a
thing_inside
  = do  { Name
name <- OccName -> IOEnv (Env IfGblEnv IfLclEnv) Name
newIfaceName (FastString -> OccName
mkVarOccFS FastString
fs)
        ; Type
ty' <- IfaceType -> IfL Type
tcIfaceType IfaceType
ty
        ; Type
w' <- IfaceType -> IfL Type
tcIfaceType IfaceType
w
        ; let id :: CoreBndr
id = Name -> Type -> Type -> CoreBndr
mkLocalIdOrCoVar Name
name Type
w' Type
ty'
          -- We should not have "OrCoVar" here, this is a bug (#17545)
        ; forall a. [CoreBndr] -> IfL a -> IfL a
extendIfaceIdEnv [CoreBndr
id] (CoreBndr -> IfL a
thing_inside CoreBndr
id) }

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

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

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

-----------------------
bindIfaceForAllBndrs :: [VarBndr IfaceBndr vis] -> ([VarBndr TyCoVar vis] -> IfL a) -> IfL a
bindIfaceForAllBndrs :: forall vis a.
[VarBndr IfaceBndr vis]
-> ([VarBndr CoreBndr vis] -> IfL a) -> IfL a
bindIfaceForAllBndrs [] [VarBndr CoreBndr vis] -> IfL a
thing_inside = [VarBndr CoreBndr vis] -> IfL a
thing_inside []
bindIfaceForAllBndrs (VarBndr IfaceBndr vis
bndr:[VarBndr IfaceBndr vis]
bndrs) [VarBndr CoreBndr vis] -> IfL a
thing_inside
  = forall vis a.
VarBndr IfaceBndr vis -> (CoreBndr -> vis -> IfL a) -> IfL a
bindIfaceForAllBndr VarBndr IfaceBndr vis
bndr forall a b. (a -> b) -> a -> b
$ \CoreBndr
tv vis
vis ->
    forall vis a.
[VarBndr IfaceBndr vis]
-> ([VarBndr CoreBndr vis] -> IfL a) -> IfL a
bindIfaceForAllBndrs [VarBndr IfaceBndr vis]
bndrs forall a b. (a -> b) -> a -> b
$ \[VarBndr CoreBndr vis]
bndrs' ->
    [VarBndr CoreBndr vis] -> IfL a
thing_inside (forall var argf. var -> argf -> VarBndr var argf
Bndr CoreBndr
tv vis
vis forall a. a -> [a] -> [a]
: [VarBndr CoreBndr vis]
bndrs')

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

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

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

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

bindIfaceTyConBinders :: [IfaceTyConBinder]
                      -> ([TyConBinder] -> IfL a) -> IfL a
bindIfaceTyConBinders :: forall a. [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
  = forall a.
(IfaceBndr -> (CoreBndr -> IfL a) -> IfL a)
-> IfaceTyConBinder -> (TyConBinder -> IfL a) -> IfL a
bindIfaceTyConBinderX forall a. IfaceBndr -> (CoreBndr -> IfL a) -> IfL a
bindIfaceBndr IfaceTyConBinder
b forall a b. (a -> b) -> a -> b
$ \ TyConBinder
b'  ->
    forall a. [IfaceTyConBinder] -> ([TyConBinder] -> IfL a) -> IfL a
bindIfaceTyConBinders [IfaceTyConBinder]
bs              forall a b. (a -> b) -> a -> b
$ \ [TyConBinder]
bs' ->
    [TyConBinder] -> IfL a
thing_inside (TyConBinder
b'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 :: forall a. [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
  = forall a.
(IfaceBndr -> (CoreBndr -> IfL a) -> IfL a)
-> IfaceTyConBinder -> (TyConBinder -> IfL a) -> IfL a
bindIfaceTyConBinderX forall a. IfaceBndr -> (CoreBndr -> IfL a) -> IfL a
bind_tv IfaceTyConBinder
b  forall a b. (a -> b) -> a -> b
$ \TyConBinder
b'  ->
    forall a. [IfaceTyConBinder] -> ([TyConBinder] -> IfL a) -> IfL a
bindIfaceTyConBinders_AT      [IfaceTyConBinder]
bs forall a b. (a -> b) -> a -> b
$ \[TyConBinder]
bs' ->
    [TyConBinder] -> IfL a
thing_inside (TyConBinder
b'forall a. a -> [a] -> [a]
:[TyConBinder]
bs')
  where
    bind_tv :: IfaceBndr
-> (CoreBndr -> IOEnv (Env IfGblEnv IfLclEnv) b)
-> IOEnv (Env IfGblEnv IfLclEnv) b
bind_tv IfaceBndr
tv CoreBndr -> IOEnv (Env IfGblEnv IfLclEnv) b
thing
      = do { Maybe CoreBndr
mb_tv <- IfaceBndr -> IfL (Maybe CoreBndr)
lookupIfaceVar IfaceBndr
tv
           ; case Maybe CoreBndr
mb_tv of
               Just CoreBndr
b' -> CoreBndr -> IOEnv (Env IfGblEnv IfLclEnv) b
thing CoreBndr
b'
               Maybe CoreBndr
Nothing -> forall a. IfaceBndr -> (CoreBndr -> IfL a) -> IfL a
bindIfaceBndr IfaceBndr
tv CoreBndr -> IOEnv (Env IfGblEnv IfLclEnv) b
thing }

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