{-# 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,
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
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
typecheckIface :: ModIface
-> IfG ModDetails
typecheckIface :: ModIface -> IfG ModDetails
typecheckIface ModIface
iface
= Module
-> SDoc -> IsBootInterface -> IfL ModDetails -> IfG ModDetails
forall a lcl.
Module -> SDoc -> IsBootInterface -> IfL a -> IfM lcl a
initIfaceLcl (ModIface -> Module
forall (a :: ModIfacePhase). ModIface_ a -> Module
mi_semantic_module ModIface
iface) (String -> SDoc
text String
"typecheckIface") (ModIface -> IsBootInterface
mi_boot ModIface
iface) (IfL ModDetails -> IfG ModDetails)
-> IfL ModDetails -> IfG ModDetails
forall a b. (a -> b) -> a -> b
$ do
{
Bool
ignore_prags <- GeneralFlag -> TcRnIf IfGblEnv IfLclEnv Bool
forall gbl lcl. GeneralFlag -> TcRnIf gbl lcl Bool
goptM GeneralFlag
Opt_IgnoreInterfacePragmas
; [(Name, TyThing)]
names_w_things <- Bool -> [(Fingerprint, IfaceDecl)] -> IfL [(Name, TyThing)]
tcIfaceDecls Bool
ignore_prags (ModIface -> [IfaceDeclExts 'ModIfaceFinal]
forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceDeclExts phase]
mi_decls ModIface
iface)
; let type_env :: TypeEnv
type_env = [(Name, TyThing)] -> TypeEnv
forall a. [(Name, a)] -> NameEnv a
mkNameEnv [(Name, TyThing)]
names_w_things
; [ClsInst]
insts <- (IfaceClsInst -> IOEnv (Env IfGblEnv IfLclEnv) ClsInst)
-> [IfaceClsInst] -> IOEnv (Env IfGblEnv IfLclEnv) [ClsInst]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceClsInst -> IOEnv (Env IfGblEnv IfLclEnv) ClsInst
tcIfaceInst (ModIface -> [IfaceClsInst]
forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceClsInst]
mi_insts ModIface
iface)
; [FamInst]
fam_insts <- (IfaceFamInst -> IOEnv (Env IfGblEnv IfLclEnv) FamInst)
-> [IfaceFamInst] -> IOEnv (Env IfGblEnv IfLclEnv) [FamInst]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceFamInst -> IOEnv (Env IfGblEnv IfLclEnv) FamInst
tcIfaceFamInst (ModIface -> [IfaceFamInst]
forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceFamInst]
mi_fam_insts ModIface
iface)
; [CoreRule]
rules <- Bool -> [IfaceRule] -> IfL [CoreRule]
tcIfaceRules Bool
ignore_prags (ModIface -> [IfaceRule]
forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceRule]
mi_rules ModIface
iface)
; [Annotation]
anns <- [IfaceAnnotation] -> IfL [Annotation]
tcIfaceAnnotations (ModIface -> [IfaceAnnotation]
forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceAnnotation]
mi_anns ModIface
iface)
; [AvailInfo]
exports <- [AvailInfo] -> TcRnIf IfGblEnv IfLclEnv [AvailInfo]
forall gbl lcl. [AvailInfo] -> TcRnIf gbl lcl [AvailInfo]
ifaceExportNames (ModIface -> [AvailInfo]
forall (phase :: ModIfacePhase). ModIface_ phase -> [AvailInfo]
mi_exports ModIface
iface)
; [CompleteMatch]
complete_matches <- [IfaceCompleteMatch] -> IfL [CompleteMatch]
tcIfaceCompleteMatches (ModIface -> [IfaceCompleteMatch]
forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceCompleteMatch]
mi_complete_matches ModIface
iface)
; SDoc -> TcRnIf IfGblEnv IfLclEnv ()
forall m n. SDoc -> TcRnIf m n ()
traceIf ([SDoc] -> SDoc
vcat [String -> SDoc
text String
"Finished typechecking interface for" SDoc -> SDoc -> SDoc
<+> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ModIface -> Module
forall (a :: ModIfacePhase). ModIface_ a -> Module
mi_module ModIface
iface),
String -> SDoc
text String
"Type envt:" SDoc -> SDoc -> SDoc
<+> [Name] -> SDoc
forall a. Outputable a => a -> SDoc
ppr (((Name, TyThing) -> Name) -> [(Name, TyThing)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, TyThing) -> Name
forall a b. (a, b) -> a
fst [(Name, TyThing)]
names_w_things)])
; ModDetails -> IfL ModDetails
forall (m :: * -> *) a. Monad m => a -> m a
return (ModDetails -> IfL ModDetails) -> ModDetails -> IfL ModDetails
forall a b. (a -> b) -> a -> b
$ ModDetails { 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
}
}
isAbstractIfaceDecl :: IfaceDecl -> Bool
isAbstractIfaceDecl :: IfaceDecl -> Bool
isAbstractIfaceDecl IfaceData{ ifCons :: IfaceDecl -> IfaceConDecls
ifCons = IfaceConDecls
IfAbstractTyCon } = Bool
True
isAbstractIfaceDecl IfaceClass{ ifBody :: IfaceDecl -> IfaceClassBody
ifBody = IfaceClassBody
IfAbstractClass } = Bool
True
isAbstractIfaceDecl IfaceFamily{ ifFamFlav :: IfaceDecl -> IfaceFamTyConFlav
ifFamFlav = IfaceFamTyConFlav
IfaceAbstractClosedSynFamilyTyCon } = Bool
True
isAbstractIfaceDecl IfaceDecl
_ = Bool
False
ifMaybeRoles :: IfaceDecl -> Maybe [Role]
ifMaybeRoles :: IfaceDecl -> Maybe [Role]
ifMaybeRoles IfaceData { ifRoles :: IfaceDecl -> [Role]
ifRoles = [Role]
rs } = [Role] -> Maybe [Role]
forall a. a -> Maybe a
Just [Role]
rs
ifMaybeRoles IfaceSynonym { ifRoles :: IfaceDecl -> [Role]
ifRoles = [Role]
rs } = [Role] -> Maybe [Role]
forall a. a -> Maybe a
Just [Role]
rs
ifMaybeRoles IfaceClass { ifRoles :: IfaceDecl -> [Role]
ifRoles = [Role]
rs } = [Role] -> Maybe [Role]
forall a. a -> Maybe a
Just [Role]
rs
ifMaybeRoles IfaceDecl
_ = Maybe [Role]
forall a. Maybe a
Nothing
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 = NameEnv IfaceClassOp -> [IfaceClassOp]
forall a. NameEnv a -> [a]
nameEnvElts (NameEnv IfaceClassOp -> [IfaceClassOp])
-> NameEnv IfaceClassOp -> [IfaceClassOp]
forall a b. (a -> b) -> a -> b
$
(IfaceClassOp -> IfaceClassOp -> IfaceClassOp)
-> NameEnv IfaceClassOp
-> NameEnv IfaceClassOp
-> NameEnv IfaceClassOp
forall a. (a -> a -> a) -> NameEnv a -> NameEnv a -> NameEnv a
plusNameEnv_C IfaceClassOp -> IfaceClassOp -> IfaceClassOp
mergeIfaceClassOp
([(Name, IfaceClassOp)] -> NameEnv IfaceClassOp
forall a. [(Name, a)] -> NameEnv a
mkNameEnv [ (Name
n, IfaceClassOp
op) | op :: IfaceClassOp
op@(IfaceClassOp Name
n IfaceType
_ Maybe (DefMethSpec IfaceType)
_) <- [IfaceClassOp]
ops1 ])
([(Name, IfaceClassOp)] -> NameEnv IfaceClassOp
forall a. [(Name, a)] -> NameEnv a
mkNameEnv [ (Name
n, IfaceClassOp
op) | op :: IfaceClassOp
op@(IfaceClassOp Name
n IfaceType
_ Maybe (DefMethSpec IfaceType)
_) <- [IfaceClassOp]
ops2 ])
in IfaceDecl
d1 { ifBody :: IfaceClassBody
ifBody = (IfaceDecl -> IfaceClassBody
ifBody IfaceDecl
d1) {
ifSigs :: [IfaceClassOp]
ifSigs = [IfaceClassOp]
ops,
ifMinDef :: BooleanFormula FastString
ifMinDef = [LBooleanFormula FastString] -> BooleanFormula FastString
forall a. Eq a => [LBooleanFormula a] -> BooleanFormula a
BF.mkOr [BooleanFormula FastString -> LBooleanFormula FastString
forall a an. a -> LocatedAn an a
noLocA BooleanFormula FastString
bf1, BooleanFormula FastString -> LBooleanFormula FastString
forall a an. a -> LocatedAn an a
noLocA BooleanFormula FastString
bf2]
}
} IfaceDecl -> IfaceDecl -> IfaceDecl
`withRolesFrom` IfaceDecl
d2
| Bool
otherwise = IfaceDecl
d1 IfaceDecl -> IfaceDecl -> IfaceDecl
`withRolesFrom` IfaceDecl
d2
withRolesFrom :: IfaceDecl -> IfaceDecl -> IfaceDecl
IfaceDecl
d1 withRolesFrom :: IfaceDecl -> IfaceDecl -> IfaceDecl
`withRolesFrom` IfaceDecl
d2
| Just [Role]
roles1 <- IfaceDecl -> Maybe [Role]
ifMaybeRoles IfaceDecl
d1
, Just [Role]
roles2 <- IfaceDecl -> Maybe [Role]
ifMaybeRoles IfaceDecl
d2
, Bool -> Bool
not (IfaceDecl -> Bool
isRepInjectiveIfaceDecl IfaceDecl
d1 Bool -> Bool -> Bool
|| IfaceDecl -> Bool
isRepInjectiveIfaceDecl IfaceDecl
d2)
= IfaceDecl
d1 { ifRoles :: [Role]
ifRoles = [Role] -> [Role] -> [Role]
forall {c}. Ord c => [c] -> [c] -> [c]
mergeRoles [Role]
roles1 [Role]
roles2 }
| Bool
otherwise = IfaceDecl
d1
where
mergeRoles :: [c] -> [c] -> [c]
mergeRoles [c]
roles1 [c]
roles2 = String -> (c -> c -> c) -> [c] -> [c] -> [c]
forall a b c. String -> (a -> b -> c) -> [a] -> [b] -> [c]
zipWithEqual String
"mergeRoles" c -> c -> c
forall a. Ord a => a -> a -> a
max [c]
roles1 [c]
roles2
isRepInjectiveIfaceDecl :: IfaceDecl -> Bool
isRepInjectiveIfaceDecl :: IfaceDecl -> Bool
isRepInjectiveIfaceDecl IfaceData{ ifCons :: IfaceDecl -> IfaceConDecls
ifCons = IfDataTyCon [IfaceConDecl]
_ } = Bool
True
isRepInjectiveIfaceDecl IfaceFamily{ ifFamFlav :: IfaceDecl -> IfaceFamTyConFlav
ifFamFlav = IfaceFamTyConFlav
IfaceDataFamilyTyCon } = Bool
True
isRepInjectiveIfaceDecl IfaceDecl
_ = Bool
False
mergeIfaceClassOp :: IfaceClassOp -> IfaceClassOp -> IfaceClassOp
mergeIfaceClassOp :: IfaceClassOp -> IfaceClassOp -> IfaceClassOp
mergeIfaceClassOp op1 :: IfaceClassOp
op1@(IfaceClassOp Name
_ IfaceType
_ (Just DefMethSpec IfaceType
_)) IfaceClassOp
_ = IfaceClassOp
op1
mergeIfaceClassOp IfaceClassOp
_ IfaceClassOp
op2 = IfaceClassOp
op2
mergeIfaceDecls :: OccEnv IfaceDecl -> OccEnv IfaceDecl -> OccEnv IfaceDecl
mergeIfaceDecls :: OccEnv IfaceDecl -> OccEnv IfaceDecl -> OccEnv IfaceDecl
mergeIfaceDecls = (IfaceDecl -> IfaceDecl -> IfaceDecl)
-> OccEnv IfaceDecl -> OccEnv IfaceDecl -> OccEnv IfaceDecl
forall a. (a -> a -> a) -> OccEnv a -> OccEnv a -> OccEnv a
plusOccEnv_C IfaceDecl -> IfaceDecl -> IfaceDecl
mergeIfaceDecl
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 =
Module
-> SDoc
-> IsBootInterface
-> IfL (TypeEnv, [ModDetails])
-> IfM lcl (TypeEnv, [ModDetails])
forall a lcl.
Module -> SDoc -> IsBootInterface -> IfL a -> IfM lcl a
initIfaceLcl Module
mod (String -> SDoc
text String
"typecheckIfacesForMerging") IsBootInterface
NotBoot (IfL (TypeEnv, [ModDetails]) -> IfM lcl (TypeEnv, [ModDetails]))
-> IfL (TypeEnv, [ModDetails]) -> IfM lcl (TypeEnv, [ModDetails])
forall a b. (a -> b) -> a -> b
$ do
Bool
ignore_prags <- GeneralFlag -> TcRnIf IfGblEnv IfLclEnv Bool
forall gbl lcl. GeneralFlag -> TcRnIf gbl lcl Bool
goptM GeneralFlag
Opt_IgnoreInterfacePragmas
let mk_decl_env :: [IfaceDecl] -> OccEnv IfaceDecl
mk_decl_env [IfaceDecl]
decls
= [(OccName, IfaceDecl)] -> OccEnv IfaceDecl
forall a. [(OccName, a)] -> OccEnv a
mkOccEnv [ (IfaceDecl -> OccName
forall a. NamedThing a => a -> OccName
getOccName IfaceDecl
decl, IfaceDecl
decl)
| IfaceDecl
decl <- [IfaceDecl]
decls
, case IfaceDecl
decl of
IfaceId { ifIdDetails :: IfaceDecl -> IfaceIdDetails
ifIdDetails = IfaceIdDetails
IfDFunId } -> Bool
False
IfaceDecl
_ -> Bool
True ]
decl_envs :: [OccEnv IfaceDecl]
decl_envs = (ModIface -> OccEnv IfaceDecl) -> [ModIface] -> [OccEnv IfaceDecl]
forall a b. (a -> b) -> [a] -> [b]
map ([IfaceDecl] -> OccEnv IfaceDecl
mk_decl_env ([IfaceDecl] -> OccEnv IfaceDecl)
-> (ModIface -> [IfaceDecl]) -> ModIface -> OccEnv IfaceDecl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Fingerprint, IfaceDecl) -> IfaceDecl)
-> [(Fingerprint, IfaceDecl)] -> [IfaceDecl]
forall a b. (a -> b) -> [a] -> [b]
map (Fingerprint, IfaceDecl) -> IfaceDecl
forall a b. (a, b) -> b
snd ([(Fingerprint, IfaceDecl)] -> [IfaceDecl])
-> (ModIface -> [(Fingerprint, IfaceDecl)])
-> ModIface
-> [IfaceDecl]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModIface -> [(Fingerprint, IfaceDecl)]
forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceDeclExts phase]
mi_decls) [ModIface]
ifaces
:: [OccEnv IfaceDecl]
decl_env :: OccEnv IfaceDecl
decl_env = (OccEnv IfaceDecl -> OccEnv IfaceDecl -> OccEnv IfaceDecl)
-> OccEnv IfaceDecl -> [OccEnv IfaceDecl] -> OccEnv IfaceDecl
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' OccEnv IfaceDecl -> OccEnv IfaceDecl -> OccEnv IfaceDecl
mergeIfaceDecls OccEnv IfaceDecl
forall a. OccEnv a
emptyOccEnv [OccEnv IfaceDecl]
decl_envs
:: OccEnv IfaceDecl
[(Name, TyThing)]
names_w_things <- Bool -> [(Fingerprint, IfaceDecl)] -> IfL [(Name, TyThing)]
tcIfaceDecls Bool
ignore_prags ((IfaceDecl -> (Fingerprint, IfaceDecl))
-> [IfaceDecl] -> [(Fingerprint, IfaceDecl)]
forall a b. (a -> b) -> [a] -> [b]
map (\IfaceDecl
x -> (Fingerprint
fingerprint0, IfaceDecl
x))
(OccEnv IfaceDecl -> [IfaceDecl]
forall a. OccEnv a -> [a]
occEnvElts OccEnv IfaceDecl
decl_env))
let global_type_env :: TypeEnv
global_type_env = [(Name, TyThing)] -> TypeEnv
forall a. [(Name, a)] -> NameEnv a
mkNameEnv [(Name, TyThing)]
names_w_things
IORef TypeEnv -> TypeEnv -> TcRnIf IfGblEnv IfLclEnv ()
forall a env. IORef a -> a -> IOEnv env ()
writeMutVar IORef TypeEnv
tc_env_var TypeEnv
global_type_env
[ModDetails]
details <- [ModIface]
-> (ModIface -> IfL ModDetails)
-> IOEnv (Env IfGblEnv IfLclEnv) [ModDetails]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ModIface]
ifaces ((ModIface -> IfL ModDetails)
-> IOEnv (Env IfGblEnv IfLclEnv) [ModDetails])
-> (ModIface -> IfL ModDetails)
-> IOEnv (Env IfGblEnv IfLclEnv) [ModDetails]
forall a b. (a -> b) -> a -> b
$ \ModIface
iface -> do
TypeEnv
type_env <- (TypeEnv -> IOEnv (Env IfGblEnv IfLclEnv) TypeEnv)
-> IOEnv (Env IfGblEnv IfLclEnv) TypeEnv
forall a env. (a -> IOEnv env a) -> IOEnv env a
fixM ((TypeEnv -> IOEnv (Env IfGblEnv IfLclEnv) TypeEnv)
-> IOEnv (Env IfGblEnv IfLclEnv) TypeEnv)
-> (TypeEnv -> IOEnv (Env IfGblEnv IfLclEnv) TypeEnv)
-> IOEnv (Env IfGblEnv IfLclEnv) TypeEnv
forall a b. (a -> b) -> a -> b
$ \TypeEnv
type_env ->
TypeEnv
-> IOEnv (Env IfGblEnv IfLclEnv) TypeEnv
-> IOEnv (Env IfGblEnv IfLclEnv) TypeEnv
forall a. TypeEnv -> IfL a -> IfL a
setImplicitEnvM TypeEnv
type_env (IOEnv (Env IfGblEnv IfLclEnv) TypeEnv
-> IOEnv (Env IfGblEnv IfLclEnv) TypeEnv)
-> IOEnv (Env IfGblEnv IfLclEnv) TypeEnv
-> IOEnv (Env IfGblEnv IfLclEnv) TypeEnv
forall a b. (a -> b) -> a -> b
$ do
[(Name, TyThing)]
decls <- Bool -> [(Fingerprint, IfaceDecl)] -> IfL [(Name, TyThing)]
tcIfaceDecls Bool
ignore_prags (ModIface -> [IfaceDeclExts 'ModIfaceFinal]
forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceDeclExts phase]
mi_decls ModIface
iface)
TypeEnv -> IOEnv (Env IfGblEnv IfLclEnv) TypeEnv
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Name, TyThing)] -> TypeEnv
forall a. [(Name, a)] -> NameEnv a
mkNameEnv [(Name, TyThing)]
decls)
TypeEnv -> IfL ModDetails -> IfL ModDetails
forall a. TypeEnv -> IfL a -> IfL a
setImplicitEnvM TypeEnv
type_env (IfL ModDetails -> IfL ModDetails)
-> IfL ModDetails -> IfL ModDetails
forall a b. (a -> b) -> a -> b
$ do
[ClsInst]
insts <- (IfaceClsInst -> IOEnv (Env IfGblEnv IfLclEnv) ClsInst)
-> [IfaceClsInst] -> IOEnv (Env IfGblEnv IfLclEnv) [ClsInst]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceClsInst -> IOEnv (Env IfGblEnv IfLclEnv) ClsInst
tcIfaceInst (ModIface -> [IfaceClsInst]
forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceClsInst]
mi_insts ModIface
iface)
[FamInst]
fam_insts <- (IfaceFamInst -> IOEnv (Env IfGblEnv IfLclEnv) FamInst)
-> [IfaceFamInst] -> IOEnv (Env IfGblEnv IfLclEnv) [FamInst]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceFamInst -> IOEnv (Env IfGblEnv IfLclEnv) FamInst
tcIfaceFamInst (ModIface -> [IfaceFamInst]
forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceFamInst]
mi_fam_insts ModIface
iface)
[CoreRule]
rules <- Bool -> [IfaceRule] -> IfL [CoreRule]
tcIfaceRules Bool
ignore_prags (ModIface -> [IfaceRule]
forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceRule]
mi_rules ModIface
iface)
[Annotation]
anns <- [IfaceAnnotation] -> IfL [Annotation]
tcIfaceAnnotations (ModIface -> [IfaceAnnotation]
forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceAnnotation]
mi_anns ModIface
iface)
[AvailInfo]
exports <- [AvailInfo] -> TcRnIf IfGblEnv IfLclEnv [AvailInfo]
forall gbl lcl. [AvailInfo] -> TcRnIf gbl lcl [AvailInfo]
ifaceExportNames (ModIface -> [AvailInfo]
forall (phase :: ModIfacePhase). ModIface_ phase -> [AvailInfo]
mi_exports ModIface
iface)
[CompleteMatch]
complete_matches <- [IfaceCompleteMatch] -> IfL [CompleteMatch]
tcIfaceCompleteMatches (ModIface -> [IfaceCompleteMatch]
forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceCompleteMatch]
mi_complete_matches ModIface
iface)
ModDetails -> IfL ModDetails
forall (m :: * -> *) a. Monad m => a -> m a
return (ModDetails -> IfL ModDetails) -> ModDetails -> IfL ModDetails
forall a b. (a -> b) -> a -> b
$ ModDetails { 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
}
(TypeEnv, [ModDetails]) -> IfL (TypeEnv, [ModDetails])
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeEnv
global_type_env, [ModDetails]
details)
typecheckIfaceForInstantiate :: NameShape -> ModIface -> IfM lcl ModDetails
typecheckIfaceForInstantiate :: forall lcl. NameShape -> ModIface -> IfM lcl ModDetails
typecheckIfaceForInstantiate NameShape
nsubst ModIface
iface =
Module
-> SDoc
-> IsBootInterface
-> NameShape
-> IfL ModDetails
-> IfM lcl ModDetails
forall a lcl.
Module
-> SDoc -> IsBootInterface -> NameShape -> IfL a -> IfM lcl a
initIfaceLclWithSubst (ModIface -> Module
forall (a :: ModIfacePhase). ModIface_ a -> Module
mi_semantic_module ModIface
iface)
(String -> SDoc
text String
"typecheckIfaceForInstantiate")
(ModIface -> IsBootInterface
mi_boot ModIface
iface) NameShape
nsubst (IfL ModDetails -> IfM lcl ModDetails)
-> IfL ModDetails -> IfM lcl ModDetails
forall a b. (a -> b) -> a -> b
$ do
Bool
ignore_prags <- GeneralFlag -> TcRnIf IfGblEnv IfLclEnv Bool
forall gbl lcl. GeneralFlag -> TcRnIf gbl lcl Bool
goptM GeneralFlag
Opt_IgnoreInterfacePragmas
TypeEnv
type_env <- (TypeEnv -> IOEnv (Env IfGblEnv IfLclEnv) TypeEnv)
-> IOEnv (Env IfGblEnv IfLclEnv) TypeEnv
forall a env. (a -> IOEnv env a) -> IOEnv env a
fixM ((TypeEnv -> IOEnv (Env IfGblEnv IfLclEnv) TypeEnv)
-> IOEnv (Env IfGblEnv IfLclEnv) TypeEnv)
-> (TypeEnv -> IOEnv (Env IfGblEnv IfLclEnv) TypeEnv)
-> IOEnv (Env IfGblEnv IfLclEnv) TypeEnv
forall a b. (a -> b) -> a -> b
$ \TypeEnv
type_env ->
TypeEnv
-> IOEnv (Env IfGblEnv IfLclEnv) TypeEnv
-> IOEnv (Env IfGblEnv IfLclEnv) TypeEnv
forall a. TypeEnv -> IfL a -> IfL a
setImplicitEnvM TypeEnv
type_env (IOEnv (Env IfGblEnv IfLclEnv) TypeEnv
-> IOEnv (Env IfGblEnv IfLclEnv) TypeEnv)
-> IOEnv (Env IfGblEnv IfLclEnv) TypeEnv
-> IOEnv (Env IfGblEnv IfLclEnv) TypeEnv
forall a b. (a -> b) -> a -> b
$ do
[(Name, TyThing)]
decls <- Bool -> [(Fingerprint, IfaceDecl)] -> IfL [(Name, TyThing)]
tcIfaceDecls Bool
ignore_prags (ModIface -> [IfaceDeclExts 'ModIfaceFinal]
forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceDeclExts phase]
mi_decls ModIface
iface)
TypeEnv -> IOEnv (Env IfGblEnv IfLclEnv) TypeEnv
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Name, TyThing)] -> TypeEnv
forall a. [(Name, a)] -> NameEnv a
mkNameEnv [(Name, TyThing)]
decls)
TypeEnv -> IfL ModDetails -> IfL ModDetails
forall a. TypeEnv -> IfL a -> IfL a
setImplicitEnvM TypeEnv
type_env (IfL ModDetails -> IfL ModDetails)
-> IfL ModDetails -> IfL ModDetails
forall a b. (a -> b) -> a -> b
$ do
[ClsInst]
insts <- (IfaceClsInst -> IOEnv (Env IfGblEnv IfLclEnv) ClsInst)
-> [IfaceClsInst] -> IOEnv (Env IfGblEnv IfLclEnv) [ClsInst]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceClsInst -> IOEnv (Env IfGblEnv IfLclEnv) ClsInst
tcIfaceInst (ModIface -> [IfaceClsInst]
forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceClsInst]
mi_insts ModIface
iface)
[FamInst]
fam_insts <- (IfaceFamInst -> IOEnv (Env IfGblEnv IfLclEnv) FamInst)
-> [IfaceFamInst] -> IOEnv (Env IfGblEnv IfLclEnv) [FamInst]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceFamInst -> IOEnv (Env IfGblEnv IfLclEnv) FamInst
tcIfaceFamInst (ModIface -> [IfaceFamInst]
forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceFamInst]
mi_fam_insts ModIface
iface)
[CoreRule]
rules <- Bool -> [IfaceRule] -> IfL [CoreRule]
tcIfaceRules Bool
ignore_prags (ModIface -> [IfaceRule]
forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceRule]
mi_rules ModIface
iface)
[Annotation]
anns <- [IfaceAnnotation] -> IfL [Annotation]
tcIfaceAnnotations (ModIface -> [IfaceAnnotation]
forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceAnnotation]
mi_anns ModIface
iface)
[AvailInfo]
exports <- [AvailInfo] -> TcRnIf IfGblEnv IfLclEnv [AvailInfo]
forall gbl lcl. [AvailInfo] -> TcRnIf gbl lcl [AvailInfo]
ifaceExportNames (ModIface -> [AvailInfo]
forall (phase :: ModIfacePhase). ModIface_ phase -> [AvailInfo]
mi_exports ModIface
iface)
[CompleteMatch]
complete_matches <- [IfaceCompleteMatch] -> IfL [CompleteMatch]
tcIfaceCompleteMatches (ModIface -> [IfaceCompleteMatch]
forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceCompleteMatch]
mi_complete_matches ModIface
iface)
ModDetails -> IfL ModDetails
forall (m :: * -> *) a. Monad m => a -> m a
return (ModDetails -> IfL ModDetails) -> ModDetails -> IfL ModDetails
forall a b. (a -> b) -> a -> b
$ ModDetails { 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
}
tcHiBootIface :: HscSource -> Module -> TcRn SelfBootInfo
tcHiBootIface :: HscSource -> Module -> TcRn SelfBootInfo
tcHiBootIface HscSource
hsc_src Module
mod
| HscSource
HsBootFile <- HscSource
hsc_src
= SelfBootInfo -> TcRn SelfBootInfo
forall (m :: * -> *) a. Monad m => a -> m a
return SelfBootInfo
NoSelfBoot
| Bool
otherwise
= do { SDoc -> TcRnIf TcGblEnv TcLclEnv ()
forall m n. SDoc -> TcRnIf m n ()
traceIf (String -> SDoc
text String
"loadHiBootInterface" SDoc -> SDoc -> SDoc
<+> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod)
; GhcMode
mode <- TcRnIf TcGblEnv TcLclEnv GhcMode
forall gbl lcl. TcRnIf gbl lcl GhcMode
getGhcMode
; if Bool -> Bool
not (GhcMode -> Bool
isOneShot GhcMode
mode)
then do { HomePackageTable
hpt <- TcRnIf TcGblEnv TcLclEnv HomePackageTable
forall gbl lcl. TcRnIf gbl lcl HomePackageTable
getHpt
; case HomePackageTable -> ModuleName -> Maybe HomeModInfo
lookupHpt HomePackageTable
hpt (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
mod) of
Just HomeModInfo
info | ModIface -> IsBootInterface
mi_boot (HomeModInfo -> ModIface
hm_iface HomeModInfo
info) IsBootInterface -> IsBootInterface -> Bool
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
_ -> SelfBootInfo -> TcRn SelfBootInfo
forall (m :: * -> *) a. Monad m => a -> m a
return SelfBootInfo
NoSelfBoot }
else do
{ MaybeErr SDoc (ModIface, String)
read_result <- SDoc
-> InstalledModule
-> Module
-> IsBootInterface
-> TcRnIf TcGblEnv TcLclEnv (MaybeErr SDoc (ModIface, String))
forall gbl lcl.
SDoc
-> InstalledModule
-> Module
-> IsBootInterface
-> TcRnIf gbl lcl (MaybeErr SDoc (ModIface, String))
findAndReadIface
SDoc
need ((InstalledModule, Maybe InstantiatedModule) -> InstalledModule
forall a b. (a, b) -> a
fst (Module -> (InstalledModule, Maybe InstantiatedModule)
getModuleInstantiation Module
mod)) Module
mod
IsBootInterface
IsBoot
; case MaybeErr SDoc (ModIface, String)
read_result of {
Succeeded (ModIface
iface, String
_path) -> do { ModDetails
tc_iface <- IfG ModDetails -> TcRn ModDetails
forall a. IfG a -> TcRn a
initIfaceTcRn (IfG ModDetails -> TcRn ModDetails)
-> IfG ModDetails -> TcRn ModDetails
forall a b. (a -> b) -> a -> b
$ ModIface -> IfG ModDetails
typecheckIface ModIface
iface
; ModIface -> ModDetails -> TcRn SelfBootInfo
mkSelfBootInfo ModIface
iface ModDetails
tc_iface } ;
Failed SDoc
err ->
do { ExternalPackageState
eps <- TcRnIf TcGblEnv TcLclEnv ExternalPackageState
forall gbl lcl. TcRnIf gbl lcl ExternalPackageState
getEps
; case UniqFM ModuleName ModuleNameWithIsBoot
-> ModuleName -> Maybe ModuleNameWithIsBoot
forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
lookupUFM (ExternalPackageState -> UniqFM ModuleName ModuleNameWithIsBoot
eps_is_boot ExternalPackageState
eps) (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
mod) of
Maybe ModuleNameWithIsBoot
Nothing -> SelfBootInfo -> TcRn SelfBootInfo
forall (m :: * -> *) a. Monad m => a -> m a
return SelfBootInfo
NoSelfBoot
Just (GWIB { gwib_isBoot :: forall mod. GenWithIsBoot mod -> IsBootInterface
gwib_isBoot = IsBootInterface
is_boot }) -> case IsBootInterface
is_boot of
IsBootInterface
IsBoot -> SDoc -> TcRn SelfBootInfo
forall a. SDoc -> TcM a
failWithTc (SDoc -> SDoc
elaborate SDoc
err)
IsBootInterface
NotBoot -> SDoc -> TcRn SelfBootInfo
forall a. SDoc -> TcM a
failWithTc SDoc
moduleLoop
}}}}
where
need :: SDoc
need = String -> SDoc
text String
"Need the hi-boot interface for" SDoc -> SDoc -> SDoc
<+> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"to compare against the Real Thing"
moduleLoop :: SDoc
moduleLoop = String -> SDoc
text String
"Circular imports: module" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod)
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"depends on itself"
elaborate :: SDoc -> SDoc
elaborate SDoc
err = SDoc -> Arity -> SDoc -> SDoc
hang (String -> SDoc
text String
"Could not find hi-boot interface for" SDoc -> SDoc -> SDoc
<+>
SDoc -> SDoc
quotes (Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod) SDoc -> SDoc -> SDoc
<> SDoc
colon) Arity
4 SDoc
err
mkSelfBootInfo :: ModIface -> ModDetails -> TcRn SelfBootInfo
mkSelfBootInfo :: ModIface -> ModDetails -> TcRn SelfBootInfo
mkSelfBootInfo ModIface
iface ModDetails
mds
= do
let tcs :: [Name]
tcs = (IfaceDecl -> Name) -> [IfaceDecl] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map IfaceDecl -> Name
ifName
([IfaceDecl] -> [Name])
-> ([(Fingerprint, IfaceDecl)] -> [IfaceDecl])
-> [(Fingerprint, IfaceDecl)]
-> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IfaceDecl -> Bool) -> [IfaceDecl] -> [IfaceDecl]
forall a. (a -> Bool) -> [a] -> [a]
filter IfaceDecl -> Bool
isIfaceTyCon
([IfaceDecl] -> [IfaceDecl])
-> ([(Fingerprint, IfaceDecl)] -> [IfaceDecl])
-> [(Fingerprint, IfaceDecl)]
-> [IfaceDecl]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Fingerprint, IfaceDecl) -> IfaceDecl)
-> [(Fingerprint, IfaceDecl)] -> [IfaceDecl]
forall a b. (a -> b) -> [a] -> [b]
map (Fingerprint, IfaceDecl) -> IfaceDecl
forall a b. (a, b) -> b
snd
([(Fingerprint, IfaceDecl)] -> [Name])
-> [(Fingerprint, IfaceDecl)] -> [Name]
forall a b. (a -> b) -> a -> b
$ ModIface -> [IfaceDeclExts 'ModIfaceFinal]
forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceDeclExts phase]
mi_decls ModIface
iface
SelfBootInfo -> TcRn SelfBootInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (SelfBootInfo -> TcRn SelfBootInfo)
-> SelfBootInfo -> TcRn SelfBootInfo
forall a b. (a -> b) -> a -> b
$ SelfBoot { sb_mds :: ModDetails
sb_mds = ModDetails
mds
, sb_tcs :: NameSet
sb_tcs = [Name] -> NameSet
mkNameSet [Name]
tcs }
where
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
tcIfaceDecl :: Bool
-> IfaceDecl
-> IfL TyThing
tcIfaceDecl :: Bool -> IfaceDecl -> IfL TyThing
tcIfaceDecl = Maybe Class -> Bool -> IfaceDecl -> IfL TyThing
tc_iface_decl Maybe Class
forall a. Maybe a
Nothing
tc_iface_decl :: Maybe Class
-> Bool
-> IfaceDecl
-> IfL TyThing
tc_iface_decl :: Maybe Class -> Bool -> IfaceDecl -> IfL TyThing
tc_iface_decl Maybe Class
_ Bool
ignore_prags (IfaceId {ifName :: IfaceDecl -> Name
ifName = Name
name, ifType :: IfaceDecl -> IfaceType
ifType = IfaceType
iface_type,
ifIdDetails :: IfaceDecl -> IfaceIdDetails
ifIdDetails = IfaceIdDetails
details, ifIdInfo :: IfaceDecl -> IfaceIdInfo
ifIdInfo = IfaceIdInfo
info})
= do { Type
ty <- IfaceType -> IfL Type
tcIfaceType IfaceType
iface_type
; IdDetails
details <- Type -> IfaceIdDetails -> IfL IdDetails
tcIdDetails Type
ty IfaceIdDetails
details
; IdInfo
info <- Bool -> TopLevelFlag -> Name -> Type -> IfaceIdInfo -> IfL IdInfo
tcIdInfo Bool
ignore_prags TopLevelFlag
TopLevel Name
name Type
ty IfaceIdInfo
info
; TyThing -> IfL TyThing
forall (m :: * -> *) a. Monad m => a -> m a
return (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 })
= [IfaceTyConBinder] -> ([TyConBinder] -> IfL TyThing) -> IfL TyThing
forall a. [IfaceTyConBinder] -> ([TyConBinder] -> IfL a) -> IfL a
bindIfaceTyConBinders_AT [IfaceTyConBinder]
binders (([TyConBinder] -> IfL TyThing) -> IfL TyThing)
-> ([TyConBinder] -> IfL TyThing) -> IfL TyThing
forall a b. (a -> b) -> a -> b
$ \ [TyConBinder]
binders' -> do
{ Type
res_kind' <- IfaceType -> IfL Type
tcIfaceType IfaceType
res_kind
; TyCon
tycon <- (TyCon -> IOEnv (Env IfGblEnv IfLclEnv) TyCon)
-> IOEnv (Env IfGblEnv IfLclEnv) TyCon
forall a env. (a -> IOEnv env a) -> IOEnv env a
fixM ((TyCon -> IOEnv (Env IfGblEnv IfLclEnv) TyCon)
-> IOEnv (Env IfGblEnv IfLclEnv) TyCon)
-> (TyCon -> IOEnv (Env IfGblEnv IfLclEnv) TyCon)
-> IOEnv (Env IfGblEnv IfLclEnv) TyCon
forall a b. (a -> b) -> a -> b
$ \ TyCon
tycon -> do
{ ThetaType
stupid_theta <- IfaceContext -> IfL ThetaType
tcIfaceCtxt IfaceContext
ctxt
; AlgTyConFlav
parent' <- Name -> IfaceTyConParent -> IfL AlgTyConFlav
tc_parent Name
tc_name IfaceTyConParent
mb_parent
; AlgTyConRhs
cons <- Name -> TyCon -> [TyConBinder] -> IfaceConDecls -> IfL AlgTyConRhs
tcIfaceDataCons Name
tc_name TyCon
tycon [TyConBinder]
binders' IfaceConDecls
rdr_cons
; TyCon -> IOEnv (Env IfGblEnv IfLclEnv) TyCon
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
-> [TyConBinder]
-> Type
-> [Role]
-> Maybe CType
-> ThetaType
-> AlgTyConRhs
-> AlgTyConFlav
-> Bool
-> TyCon
mkAlgTyCon Name
tc_name [TyConBinder]
binders' Type
res_kind'
[Role]
roles Maybe CType
cType ThetaType
stupid_theta
AlgTyConRhs
cons AlgTyConFlav
parent' Bool
gadt_syn) }
; SDoc -> TcRnIf IfGblEnv IfLclEnv ()
forall m n. SDoc -> TcRnIf m n ()
traceIf (String -> SDoc
text String
"tcIfaceDecl4" SDoc -> SDoc -> SDoc
<+> TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tycon)
; TyThing -> IfL TyThing
forall (m :: * -> *) a. Monad m => a -> m a
return (TyCon -> TyThing
ATyCon TyCon
tycon) }
where
tc_parent :: Name -> IfaceTyConParent -> IfL AlgTyConFlav
tc_parent :: Name -> IfaceTyConParent -> IfL AlgTyConFlav
tc_parent Name
tc_name IfaceTyConParent
IfNoParent
= do { Name
tc_rep_name <- Name -> TcRnIf IfGblEnv IfLclEnv Name
forall gbl lcl. Name -> TcRnIf gbl lcl Name
newTyConRepName Name
tc_name
; AlgTyConFlav -> IfL AlgTyConFlav
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> AlgTyConFlav
VanillaAlgTyCon Name
tc_rep_name) }
tc_parent Name
_ (IfDataInstance Name
ax_name IfaceTyCon
_ IfaceAppArgs
arg_tys)
= do { CoAxiom Branched
ax <- Name -> IfL (CoAxiom Branched)
tcIfaceCoAxiom Name
ax_name
; let fam_tc :: TyCon
fam_tc = CoAxiom Branched -> TyCon
forall (br :: BranchFlag). CoAxiom br -> TyCon
coAxiomTyCon CoAxiom Branched
ax
ax_unbr :: CoAxiom Unbranched
ax_unbr = CoAxiom Branched -> CoAxiom Unbranched
forall (br :: BranchFlag). CoAxiom br -> CoAxiom Unbranched
toUnbranchedAxiom CoAxiom Branched
ax
; ThetaType
lhs_tys <- IfaceAppArgs -> IfL ThetaType
tcIfaceAppArgs IfaceAppArgs
arg_tys
; AlgTyConFlav -> IfL AlgTyConFlav
forall (m :: * -> *) a. Monad m => a -> m a
return (CoAxiom Unbranched -> TyCon -> ThetaType -> AlgTyConFlav
DataFamInstTyCon CoAxiom Unbranched
ax_unbr TyCon
fam_tc ThetaType
lhs_tys) }
tc_iface_decl Maybe Class
_ Bool
_ (IfaceSynonym {ifName :: IfaceDecl -> Name
ifName = Name
tc_name,
ifRoles :: IfaceDecl -> [Role]
ifRoles = [Role]
roles,
ifSynRhs :: IfaceDecl -> IfaceType
ifSynRhs = IfaceType
rhs_ty,
ifBinders :: IfaceDecl -> [IfaceTyConBinder]
ifBinders = [IfaceTyConBinder]
binders,
ifResKind :: IfaceDecl -> IfaceType
ifResKind = IfaceType
res_kind })
= [IfaceTyConBinder] -> ([TyConBinder] -> IfL TyThing) -> IfL TyThing
forall a. [IfaceTyConBinder] -> ([TyConBinder] -> IfL a) -> IfL a
bindIfaceTyConBinders_AT [IfaceTyConBinder]
binders (([TyConBinder] -> IfL TyThing) -> IfL TyThing)
-> ([TyConBinder] -> IfL TyThing) -> IfL TyThing
forall a b. (a -> b) -> a -> b
$ \ [TyConBinder]
binders' -> do
{ Type
res_kind' <- IfaceType -> IfL Type
tcIfaceType IfaceType
res_kind
; Type
rhs <- SDoc -> IfL Type -> IfL Type
forall a. SDoc -> IfL a -> IfL a
forkM (Name -> SDoc
forall a. Outputable a => a -> SDoc
mk_doc Name
tc_name) (IfL Type -> IfL Type) -> IfL Type -> IfL Type
forall a b. (a -> b) -> a -> b
$
IfaceType -> IfL Type
tcIfaceType IfaceType
rhs_ty
; let tycon :: TyCon
tycon = Name -> [TyConBinder] -> Type -> [Role] -> Type -> TyCon
buildSynTyCon Name
tc_name [TyConBinder]
binders' Type
res_kind' [Role]
roles Type
rhs
; TyThing -> IfL TyThing
forall (m :: * -> *) a. Monad m => a -> m a
return (TyCon -> TyThing
ATyCon TyCon
tycon) }
where
mk_doc :: a -> SDoc
mk_doc a
n = String -> SDoc
text String
"Type synonym" SDoc -> SDoc -> SDoc
<+> a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
n
tc_iface_decl Maybe Class
parent Bool
_ (IfaceFamily {ifName :: IfaceDecl -> Name
ifName = Name
tc_name,
ifFamFlav :: IfaceDecl -> IfaceFamTyConFlav
ifFamFlav = IfaceFamTyConFlav
fam_flav,
ifBinders :: IfaceDecl -> [IfaceTyConBinder]
ifBinders = [IfaceTyConBinder]
binders,
ifResKind :: IfaceDecl -> IfaceType
ifResKind = IfaceType
res_kind,
ifResVar :: IfaceDecl -> Maybe FastString
ifResVar = Maybe FastString
res, ifFamInj :: IfaceDecl -> Injectivity
ifFamInj = Injectivity
inj })
= [IfaceTyConBinder] -> ([TyConBinder] -> IfL TyThing) -> IfL TyThing
forall a. [IfaceTyConBinder] -> ([TyConBinder] -> IfL a) -> IfL a
bindIfaceTyConBinders_AT [IfaceTyConBinder]
binders (([TyConBinder] -> IfL TyThing) -> IfL TyThing)
-> ([TyConBinder] -> IfL TyThing) -> IfL TyThing
forall a b. (a -> b) -> a -> b
$ \ [TyConBinder]
binders' -> do
{ Type
res_kind' <- IfaceType -> IfL Type
tcIfaceType IfaceType
res_kind
; FamTyConFlav
rhs <- SDoc -> IfL FamTyConFlav -> IfL FamTyConFlav
forall a. SDoc -> IfL a -> IfL a
forkM (Name -> SDoc
forall a. Outputable a => a -> SDoc
mk_doc Name
tc_name) (IfL FamTyConFlav -> IfL FamTyConFlav)
-> IfL FamTyConFlav -> IfL FamTyConFlav
forall a b. (a -> b) -> a -> b
$
Name -> IfaceFamTyConFlav -> IfL FamTyConFlav
tc_fam_flav Name
tc_name IfaceFamTyConFlav
fam_flav
; Maybe Name
res_name <- (FastString -> TcRnIf IfGblEnv IfLclEnv Name)
-> Maybe FastString -> IOEnv (Env IfGblEnv IfLclEnv) (Maybe Name)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (OccName -> TcRnIf IfGblEnv IfLclEnv Name
newIfaceName (OccName -> TcRnIf IfGblEnv IfLclEnv Name)
-> (FastString -> OccName)
-> FastString
-> TcRnIf IfGblEnv IfLclEnv Name
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
; TyThing -> IfL TyThing
forall (m :: * -> *) a. Monad m => a -> m a
return (TyCon -> TyThing
ATyCon TyCon
tycon) }
where
mk_doc :: a -> SDoc
mk_doc a
n = String -> SDoc
text String
"Type synonym" SDoc -> SDoc -> SDoc
<+> a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
n
tc_fam_flav :: Name -> IfaceFamTyConFlav -> IfL FamTyConFlav
tc_fam_flav :: Name -> IfaceFamTyConFlav -> IfL FamTyConFlav
tc_fam_flav Name
tc_name IfaceFamTyConFlav
IfaceDataFamilyTyCon
= do { Name
tc_rep_name <- Name -> TcRnIf IfGblEnv IfLclEnv Name
forall gbl lcl. Name -> TcRnIf gbl lcl Name
newTyConRepName Name
tc_name
; FamTyConFlav -> IfL FamTyConFlav
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> FamTyConFlav
DataFamilyTyCon Name
tc_rep_name) }
tc_fam_flav Name
_ IfaceFamTyConFlav
IfaceOpenSynFamilyTyCon= FamTyConFlav -> IfL FamTyConFlav
forall (m :: * -> *) a. Monad m => a -> m a
return FamTyConFlav
OpenSynFamilyTyCon
tc_fam_flav Name
_ (IfaceClosedSynFamilyTyCon Maybe (Name, [IfaceAxBranch])
mb_ax_name_branches)
= do { Maybe (CoAxiom Branched)
ax <- ((Name, [IfaceAxBranch]) -> IfL (CoAxiom Branched))
-> Maybe (Name, [IfaceAxBranch])
-> IOEnv (Env IfGblEnv IfLclEnv) (Maybe (CoAxiom Branched))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Name -> IfL (CoAxiom Branched)
tcIfaceCoAxiom (Name -> IfL (CoAxiom Branched))
-> ((Name, [IfaceAxBranch]) -> Name)
-> (Name, [IfaceAxBranch])
-> IfL (CoAxiom Branched)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, [IfaceAxBranch]) -> Name
forall a b. (a, b) -> a
fst) Maybe (Name, [IfaceAxBranch])
mb_ax_name_branches
; FamTyConFlav -> IfL FamTyConFlav
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (CoAxiom Branched) -> FamTyConFlav
ClosedSynFamilyTyCon Maybe (CoAxiom Branched)
ax) }
tc_fam_flav Name
_ IfaceFamTyConFlav
IfaceAbstractClosedSynFamilyTyCon
= FamTyConFlav -> IfL FamTyConFlav
forall (m :: * -> *) a. Monad m => a -> m a
return FamTyConFlav
AbstractClosedSynFamilyTyCon
tc_fam_flav Name
_ IfaceFamTyConFlav
IfaceBuiltInSynFamTyCon
= String -> SDoc -> IfL FamTyConFlav
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tc_iface_decl"
(String -> SDoc
text String
"IfaceBuiltInSynFamTyCon in interface file")
tc_iface_decl Maybe Class
_parent Bool
_ignore_prags
(IfaceClass {ifName :: IfaceDecl -> Name
ifName = Name
tc_name,
ifRoles :: IfaceDecl -> [Role]
ifRoles = [Role]
roles,
ifBinders :: IfaceDecl -> [IfaceTyConBinder]
ifBinders = [IfaceTyConBinder]
binders,
ifFDs :: IfaceDecl -> [FunDep FastString]
ifFDs = [FunDep FastString]
rdr_fds,
ifBody :: IfaceDecl -> IfaceClassBody
ifBody = IfaceClassBody
IfAbstractClass})
= [IfaceTyConBinder] -> ([TyConBinder] -> IfL TyThing) -> IfL TyThing
forall a. [IfaceTyConBinder] -> ([TyConBinder] -> IfL a) -> IfL a
bindIfaceTyConBinders [IfaceTyConBinder]
binders (([TyConBinder] -> IfL TyThing) -> IfL TyThing)
-> ([TyConBinder] -> IfL TyThing) -> IfL TyThing
forall a b. (a -> b) -> a -> b
$ \ [TyConBinder]
binders' -> do
{ [FunDep CoreBndr]
fds <- (FunDep FastString
-> IOEnv (Env IfGblEnv IfLclEnv) (FunDep CoreBndr))
-> [FunDep FastString]
-> IOEnv (Env IfGblEnv IfLclEnv) [FunDep CoreBndr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FunDep FastString
-> IOEnv (Env IfGblEnv IfLclEnv) (FunDep CoreBndr)
tc_fd [FunDep FastString]
rdr_fds
; Class
cls <- Name
-> [TyConBinder]
-> [Role]
-> [FunDep CoreBndr]
-> Maybe
(ThetaType, [ClassATItem], [KnotTied MethInfo], ClassMinimalDef)
-> TcRnIf IfGblEnv IfLclEnv Class
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 Maybe
(ThetaType, [ClassATItem], [KnotTied MethInfo], ClassMinimalDef)
forall a. Maybe a
Nothing
; TyThing -> IfL TyThing
forall (m :: * -> *) a. Monad m => a -> m a
return (TyCon -> TyThing
ATyCon (Class -> TyCon
classTyCon Class
cls)) }
tc_iface_decl Maybe Class
_parent Bool
ignore_prags
(IfaceClass {ifName :: IfaceDecl -> Name
ifName = Name
tc_name,
ifRoles :: IfaceDecl -> [Role]
ifRoles = [Role]
roles,
ifBinders :: IfaceDecl -> [IfaceTyConBinder]
ifBinders = [IfaceTyConBinder]
binders,
ifFDs :: IfaceDecl -> [FunDep 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
}})
= [IfaceTyConBinder] -> ([TyConBinder] -> IfL TyThing) -> IfL TyThing
forall a. [IfaceTyConBinder] -> ([TyConBinder] -> IfL a) -> IfL a
bindIfaceTyConBinders [IfaceTyConBinder]
binders (([TyConBinder] -> IfL TyThing) -> IfL TyThing)
-> ([TyConBinder] -> IfL TyThing) -> IfL TyThing
forall a b. (a -> b) -> a -> b
$ \ [TyConBinder]
binders' -> do
{ SDoc -> TcRnIf IfGblEnv IfLclEnv ()
forall m n. SDoc -> TcRnIf m n ()
traceIf (String -> SDoc
text String
"tc-iface-class1" SDoc -> SDoc -> SDoc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
tc_name)
; ThetaType
ctxt <- (IfaceType -> IfL Type) -> IfaceContext -> IfL ThetaType
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceType -> IfL Type
tc_sc IfaceContext
rdr_ctxt
; SDoc -> TcRnIf IfGblEnv IfLclEnv ()
forall m n. SDoc -> TcRnIf m n ()
traceIf (String -> SDoc
text String
"tc-iface-class2" SDoc -> SDoc -> SDoc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
tc_name)
; [KnotTied MethInfo]
sigs <- (IfaceClassOp -> IOEnv (Env IfGblEnv IfLclEnv) (KnotTied MethInfo))
-> [IfaceClassOp]
-> IOEnv (Env IfGblEnv IfLclEnv) [KnotTied MethInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceClassOp -> IOEnv (Env IfGblEnv IfLclEnv) (KnotTied MethInfo)
tc_sig [IfaceClassOp]
rdr_sigs
; [FunDep CoreBndr]
fds <- (FunDep FastString
-> IOEnv (Env IfGblEnv IfLclEnv) (FunDep CoreBndr))
-> [FunDep FastString]
-> IOEnv (Env IfGblEnv IfLclEnv) [FunDep CoreBndr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FunDep FastString
-> IOEnv (Env IfGblEnv IfLclEnv) (FunDep CoreBndr)
tc_fd [FunDep FastString]
rdr_fds
; SDoc -> TcRnIf IfGblEnv IfLclEnv ()
forall m n. SDoc -> TcRnIf m n ()
traceIf (String -> SDoc
text String
"tc-iface-class3" SDoc -> SDoc -> SDoc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
tc_name)
; ClassMinimalDef
mindef <- (FastString -> TcRnIf IfGblEnv IfLclEnv Name)
-> BooleanFormula FastString
-> IOEnv (Env IfGblEnv IfLclEnv) ClassMinimalDef
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (OccName -> TcRnIf IfGblEnv IfLclEnv Name
lookupIfaceTop (OccName -> TcRnIf IfGblEnv IfLclEnv Name)
-> (FastString -> OccName)
-> FastString
-> TcRnIf IfGblEnv IfLclEnv Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> OccName
mkVarOccFS) BooleanFormula FastString
mindef_occ
; Class
cls <- (Class -> TcRnIf IfGblEnv IfLclEnv Class)
-> TcRnIf IfGblEnv IfLclEnv Class
forall a env. (a -> IOEnv env a) -> IOEnv env a
fixM ((Class -> TcRnIf IfGblEnv IfLclEnv Class)
-> TcRnIf IfGblEnv IfLclEnv Class)
-> (Class -> TcRnIf IfGblEnv IfLclEnv Class)
-> TcRnIf IfGblEnv IfLclEnv Class
forall a b. (a -> b) -> a -> b
$ \ Class
cls -> do
{ [ClassATItem]
ats <- (IfaceAT -> IOEnv (Env IfGblEnv IfLclEnv) ClassATItem)
-> [IfaceAT] -> IOEnv (Env IfGblEnv IfLclEnv) [ClassATItem]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Class -> IfaceAT -> IOEnv (Env IfGblEnv IfLclEnv) ClassATItem
tc_at Class
cls) [IfaceAT]
rdr_ats
; SDoc -> TcRnIf IfGblEnv IfLclEnv ()
forall m n. SDoc -> TcRnIf m n ()
traceIf (String -> SDoc
text String
"tc-iface-class4" SDoc -> SDoc -> SDoc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
tc_name)
; Name
-> [TyConBinder]
-> [Role]
-> [FunDep CoreBndr]
-> Maybe
(ThetaType, [ClassATItem], [KnotTied MethInfo], ClassMinimalDef)
-> TcRnIf IfGblEnv IfLclEnv Class
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 ((ThetaType, [ClassATItem], [KnotTied MethInfo], ClassMinimalDef)
-> Maybe
(ThetaType, [ClassATItem], [KnotTied MethInfo], ClassMinimalDef)
forall a. a -> Maybe a
Just (ThetaType
ctxt, [ClassATItem]
ats, [KnotTied MethInfo]
sigs, ClassMinimalDef
mindef)) }
; TyThing -> IfL TyThing
forall (m :: * -> *) a. Monad m => a -> m a
return (TyCon -> TyThing
ATyCon (Class -> TyCon
classTyCon Class
cls)) }
where
tc_sc :: IfaceType -> IfL Type
tc_sc IfaceType
pred = SDoc -> IfL Type -> IfL Type
forall a. SDoc -> IfL a -> IfL a
forkM (IfaceType -> SDoc
forall a. Outputable a => a -> SDoc
mk_sc_doc IfaceType
pred) (IfaceType -> IfL Type
tcIfaceType IfaceType
pred)
tc_sig :: IfaceClassOp -> IfL TcMethInfo
tc_sig :: IfaceClassOp -> IOEnv (Env IfGblEnv IfLclEnv) (KnotTied MethInfo)
tc_sig (IfaceClassOp Name
op_name IfaceType
rdr_ty Maybe (DefMethSpec IfaceType)
dm)
= do { let doc :: SDoc
doc = Name -> IfaceType -> SDoc
forall {a} {a}. (Outputable a, Outputable a) => a -> a -> SDoc
mk_op_doc Name
op_name IfaceType
rdr_ty
; Type
op_ty <- SDoc -> IfL Type -> IfL Type
forall a. SDoc -> IfL a -> IfL a
forkM (SDoc
doc SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"ty") (IfL Type -> IfL Type) -> IfL Type -> IfL Type
forall a b. (a -> b) -> a -> b
$ IfaceType -> IfL Type
tcIfaceType IfaceType
rdr_ty
; Maybe (DefMethSpec (SrcSpan, Type))
dm' <- SDoc
-> Maybe (DefMethSpec IfaceType)
-> IfL (Maybe (DefMethSpec (SrcSpan, Type)))
tc_dm SDoc
doc Maybe (DefMethSpec IfaceType)
dm
; KnotTied MethInfo
-> IOEnv (Env IfGblEnv IfLclEnv) (KnotTied MethInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
op_name, Type
op_ty, Maybe (DefMethSpec (SrcSpan, Type))
dm') }
tc_dm :: SDoc
-> Maybe (DefMethSpec IfaceType)
-> IfL (Maybe (DefMethSpec (SrcSpan, Type)))
tc_dm :: SDoc
-> Maybe (DefMethSpec IfaceType)
-> IfL (Maybe (DefMethSpec (SrcSpan, Type)))
tc_dm SDoc
_ Maybe (DefMethSpec IfaceType)
Nothing = Maybe (DefMethSpec (SrcSpan, Type))
-> IfL (Maybe (DefMethSpec (SrcSpan, Type)))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (DefMethSpec (SrcSpan, Type))
forall a. Maybe a
Nothing
tc_dm SDoc
_ (Just DefMethSpec IfaceType
VanillaDM) = Maybe (DefMethSpec (SrcSpan, Type))
-> IfL (Maybe (DefMethSpec (SrcSpan, Type)))
forall (m :: * -> *) a. Monad m => a -> m a
return (DefMethSpec (SrcSpan, Type) -> Maybe (DefMethSpec (SrcSpan, Type))
forall a. a -> Maybe a
Just DefMethSpec (SrcSpan, Type)
forall ty. DefMethSpec ty
VanillaDM)
tc_dm SDoc
doc (Just (GenericDM IfaceType
ty))
= do {
; Type
ty' <- SDoc -> IfL Type -> IfL Type
forall a. SDoc -> IfL a -> IfL a
forkM (SDoc
doc SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"dm") (IfL Type -> IfL Type) -> IfL Type -> IfL Type
forall a b. (a -> b) -> a -> b
$ IfaceType -> IfL Type
tcIfaceType IfaceType
ty
; Maybe (DefMethSpec (SrcSpan, Type))
-> IfL (Maybe (DefMethSpec (SrcSpan, Type)))
forall (m :: * -> *) a. Monad m => a -> m a
return (DefMethSpec (SrcSpan, Type) -> Maybe (DefMethSpec (SrcSpan, Type))
forall a. a -> Maybe a
Just ((SrcSpan, Type) -> DefMethSpec (SrcSpan, Type)
forall ty. ty -> DefMethSpec ty
GenericDM (SrcSpan
noSrcSpan, Type
ty'))) }
tc_at :: Class -> IfaceAT -> IOEnv (Env IfGblEnv IfLclEnv) ClassATItem
tc_at Class
cls (IfaceAT IfaceDecl
tc_decl Maybe IfaceType
if_def)
= do ATyCon TyCon
tc <- Maybe Class -> Bool -> IfaceDecl -> IfL TyThing
tc_iface_decl (Class -> Maybe Class
forall a. a -> Maybe a
Just Class
cls) Bool
ignore_prags IfaceDecl
tc_decl
Maybe (Type, ATValidityInfo)
mb_def <- case Maybe IfaceType
if_def of
Maybe IfaceType
Nothing -> Maybe (Type, ATValidityInfo)
-> IOEnv (Env IfGblEnv IfLclEnv) (Maybe (Type, ATValidityInfo))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Type, ATValidityInfo)
forall a. Maybe a
Nothing
Just IfaceType
def -> SDoc
-> IOEnv (Env IfGblEnv IfLclEnv) (Maybe (Type, ATValidityInfo))
-> IOEnv (Env IfGblEnv IfLclEnv) (Maybe (Type, ATValidityInfo))
forall a. SDoc -> IfL a -> IfL a
forkM (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
mk_at_doc TyCon
tc) (IOEnv (Env IfGblEnv IfLclEnv) (Maybe (Type, ATValidityInfo))
-> IOEnv (Env IfGblEnv IfLclEnv) (Maybe (Type, ATValidityInfo)))
-> IOEnv (Env IfGblEnv IfLclEnv) (Maybe (Type, ATValidityInfo))
-> IOEnv (Env IfGblEnv IfLclEnv) (Maybe (Type, ATValidityInfo))
forall a b. (a -> b) -> a -> b
$
[CoreBndr]
-> IOEnv (Env IfGblEnv IfLclEnv) (Maybe (Type, ATValidityInfo))
-> IOEnv (Env IfGblEnv IfLclEnv) (Maybe (Type, ATValidityInfo))
forall a. [CoreBndr] -> IfL a -> IfL a
extendIfaceTyVarEnv (TyCon -> [CoreBndr]
tyConTyVars TyCon
tc) (IOEnv (Env IfGblEnv IfLclEnv) (Maybe (Type, ATValidityInfo))
-> IOEnv (Env IfGblEnv IfLclEnv) (Maybe (Type, ATValidityInfo)))
-> IOEnv (Env IfGblEnv IfLclEnv) (Maybe (Type, ATValidityInfo))
-> IOEnv (Env IfGblEnv IfLclEnv) (Maybe (Type, ATValidityInfo))
forall a b. (a -> b) -> a -> b
$
do { Type
tc_def <- IfaceType -> IfL Type
tcIfaceType IfaceType
def
; Maybe (Type, ATValidityInfo)
-> IOEnv (Env IfGblEnv IfLclEnv) (Maybe (Type, ATValidityInfo))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Type, ATValidityInfo) -> Maybe (Type, ATValidityInfo)
forall a. a -> Maybe a
Just (Type
tc_def, ATValidityInfo
NoATVI)) }
ClassATItem -> IOEnv (Env IfGblEnv IfLclEnv) ClassATItem
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
<+> a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
pred
mk_at_doc :: a -> SDoc
mk_at_doc a
tc = String -> SDoc
text String
"Associated type" SDoc -> SDoc -> SDoc
<+> a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
tc
mk_op_doc :: a -> a -> SDoc
mk_op_doc a
op_name a
op_ty = String -> SDoc
text String
"Class op" SDoc -> SDoc -> SDoc
<+> [SDoc] -> SDoc
sep [a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
op_name, a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
op_ty]
tc_iface_decl Maybe Class
_ Bool
_ (IfaceAxiom { ifName :: IfaceDecl -> Name
ifName = Name
tc_name, ifTyCon :: IfaceDecl -> IfaceTyCon
ifTyCon = IfaceTyCon
tc
, ifAxBranches :: IfaceDecl -> [IfaceAxBranch]
ifAxBranches = [IfaceAxBranch]
branches, ifRole :: IfaceDecl -> Role
ifRole = Role
role })
= do { TyCon
tc_tycon <- IfaceTyCon -> IOEnv (Env IfGblEnv IfLclEnv) TyCon
tcIfaceTyCon IfaceTyCon
tc
; [CoAxBranch]
tc_branches <- SDoc -> IfL [CoAxBranch] -> IfL [CoAxBranch]
forall a. SDoc -> IfL a -> IfL a
forkM (String -> SDoc
text String
"Axiom branches" SDoc -> SDoc -> SDoc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
tc_name)
(IfL [CoAxBranch] -> IfL [CoAxBranch])
-> IfL [CoAxBranch] -> IfL [CoAxBranch]
forall a b. (a -> b) -> a -> b
$ [IfaceAxBranch] -> IfL [CoAxBranch]
tc_ax_branches [IfaceAxBranch]
branches
; let axiom :: CoAxiom Branched
axiom = CoAxiom { co_ax_unique :: Unique
co_ax_unique = Name -> Unique
nameUnique Name
tc_name
, co_ax_name :: Name
co_ax_name = Name
tc_name
, co_ax_tc :: TyCon
co_ax_tc = TyCon
tc_tycon
, co_ax_role :: Role
co_ax_role = Role
role
, co_ax_branches :: Branches Branched
co_ax_branches = [CoAxBranch] -> Branches Branched
manyBranches [CoAxBranch]
tc_branches
, co_ax_implicit :: Bool
co_ax_implicit = Bool
False }
; TyThing -> IfL TyThing
forall (m :: * -> *) a. Monad m => a -> m a
return (CoAxiom Branched -> TyThing
ACoAxiom CoAxiom Branched
axiom) }
tc_iface_decl Maybe Class
_ Bool
_ (IfacePatSyn{ ifName :: IfaceDecl -> Name
ifName = Name
name
, ifPatMatcher :: IfaceDecl -> (Name, Bool)
ifPatMatcher = (Name, Bool)
if_matcher
, ifPatBuilder :: IfaceDecl -> Maybe (Name, Bool)
ifPatBuilder = Maybe (Name, Bool)
if_builder
, ifPatIsInfix :: IfaceDecl -> Bool
ifPatIsInfix = Bool
is_infix
, ifPatUnivBndrs :: IfaceDecl -> [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 { SDoc -> TcRnIf IfGblEnv IfLclEnv ()
forall m n. SDoc -> TcRnIf m n ()
traceIf (String -> SDoc
text String
"tc_iface_decl" SDoc -> SDoc -> SDoc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name)
; (Name, Type, Bool)
matcher <- (Name, Bool) -> IfL (Name, Type, Bool)
tc_pr (Name, Bool)
if_matcher
; Maybe (Name, Type, Bool)
builder <- ((Name, Bool) -> IfL (Name, Type, Bool))
-> Maybe (Name, Bool)
-> IOEnv (Env IfGblEnv IfLclEnv) (Maybe (Name, Type, Bool))
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
; [IfaceForAllSpecBndr]
-> ([VarBndr CoreBndr Specificity] -> IfL TyThing) -> IfL TyThing
forall vis a.
[VarBndr IfaceBndr vis]
-> ([VarBndr CoreBndr vis] -> IfL a) -> IfL a
bindIfaceForAllBndrs [IfaceForAllSpecBndr]
univ_bndrs (([VarBndr CoreBndr Specificity] -> IfL TyThing) -> IfL TyThing)
-> ([VarBndr CoreBndr Specificity] -> IfL TyThing) -> IfL TyThing
forall a b. (a -> b) -> a -> b
$ \[VarBndr CoreBndr Specificity]
univ_tvs -> do
{ [IfaceForAllSpecBndr]
-> ([VarBndr CoreBndr Specificity] -> IfL TyThing) -> IfL TyThing
forall vis a.
[VarBndr IfaceBndr vis]
-> ([VarBndr CoreBndr vis] -> IfL a) -> IfL a
bindIfaceForAllBndrs [IfaceForAllSpecBndr]
ex_bndrs (([VarBndr CoreBndr Specificity] -> IfL TyThing) -> IfL TyThing)
-> ([VarBndr CoreBndr Specificity] -> IfL TyThing) -> IfL TyThing
forall a b. (a -> b) -> a -> b
$ \[VarBndr CoreBndr Specificity]
ex_tvs -> do
{ PatSyn
patsyn <- SDoc -> IfL PatSyn -> IfL PatSyn
forall a. SDoc -> IfL a -> IfL a
forkM (Name -> SDoc
forall a. Outputable a => a -> SDoc
mk_doc Name
name) (IfL PatSyn -> IfL PatSyn) -> IfL PatSyn -> IfL PatSyn
forall a b. (a -> b) -> a -> b
$
do { ThetaType
prov_theta <- IfaceContext -> IfL ThetaType
tcIfaceCtxt IfaceContext
prov_ctxt
; ThetaType
req_theta <- IfaceContext -> IfL ThetaType
tcIfaceCtxt IfaceContext
req_ctxt
; Type
pat_ty <- IfaceType -> IfL Type
tcIfaceType IfaceType
pat_ty
; ThetaType
arg_tys <- (IfaceType -> IfL Type) -> IfaceContext -> IfL ThetaType
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceType -> IfL Type
tcIfaceType IfaceContext
args
; PatSyn -> IfL PatSyn
forall (m :: * -> *) a. Monad m => a -> m a
return (PatSyn -> IfL PatSyn) -> PatSyn -> IfL PatSyn
forall a b. (a -> b) -> a -> b
$ Name
-> Bool
-> (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 }
; TyThing -> IfL TyThing
forall (m :: * -> *) a. Monad m => a -> m a
return (TyThing -> IfL TyThing) -> TyThing -> IfL TyThing
forall a b. (a -> b) -> a -> b
$ ConLike -> TyThing
AConLike (ConLike -> TyThing) -> (PatSyn -> ConLike) -> PatSyn -> TyThing
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatSyn -> ConLike
PatSynCon (PatSyn -> TyThing) -> PatSyn -> TyThing
forall a b. (a -> b) -> a -> b
$ PatSyn
patsyn }}}
where
mk_doc :: a -> SDoc
mk_doc a
n = String -> SDoc
text String
"Pattern synonym" SDoc -> SDoc -> SDoc
<+> a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
n
tc_pr :: (IfExtName, Bool) -> IfL (Name, Type, Bool)
tc_pr :: (Name, Bool) -> IfL (Name, Type, Bool)
tc_pr (Name
nm, Bool
b) = do { CoreBndr
id <- SDoc -> IfL CoreBndr -> IfL CoreBndr
forall a. SDoc -> IfL a -> IfL a
forkM (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
nm) (Name -> IfL CoreBndr
tcIfaceExtId Name
nm)
; (Name, Type, Bool) -> IfL (Name, Type, Bool)
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
= ((Fingerprint, IfaceDecl) -> IfL [(Name, TyThing)])
-> [(Fingerprint, IfaceDecl)] -> IfL [(Name, TyThing)]
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
-> (Fingerprint, IfaceDecl)
-> IfL [(Name,TyThing)]
tc_iface_decl_fingerprint :: Bool -> (Fingerprint, IfaceDecl) -> IfL [(Name, TyThing)]
tc_iface_decl_fingerprint Bool
ignore_prags (Fingerprint
_version, IfaceDecl
decl)
= do {
let main_name :: Name
main_name = IfaceDecl -> Name
ifName IfaceDecl
decl
; TyThing
thing <- SDoc -> IfL TyThing -> IfL TyThing
forall a. SDoc -> IfL a -> IfL a
forkM SDoc
doc (IfL TyThing -> IfL TyThing) -> IfL TyThing -> IfL TyThing
forall a b. (a -> b) -> a -> b
$ do { Name -> TcRnIf IfGblEnv IfLclEnv ()
bumpDeclStats Name
main_name
; Bool -> IfaceDecl -> IfL TyThing
tcIfaceDecl Bool
ignore_prags IfaceDecl
decl }
; let mini_env :: OccEnv TyThing
mini_env = [(OccName, TyThing)] -> OccEnv TyThing
forall a. [(OccName, a)] -> OccEnv a
mkOccEnv [(TyThing -> OccName
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 OccEnv TyThing -> OccName -> Maybe TyThing
forall a. OccEnv a -> OccName -> Maybe a
lookupOccEnv OccEnv TyThing
mini_env (Name -> OccName
forall a. NamedThing a => a -> OccName
getOccName Name
n) of
Just TyThing
thing -> TyThing
thing
Maybe TyThing
Nothing ->
String -> SDoc -> TyThing
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tc_iface_decl_fingerprint" (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
main_name SDoc -> SDoc -> SDoc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n SDoc -> SDoc -> SDoc
$$ IfaceDecl -> SDoc
forall a. Outputable a => a -> SDoc
ppr (IfaceDecl
decl))
; [Name]
implicit_names <- (OccName -> TcRnIf IfGblEnv IfLclEnv Name)
-> [OccName] -> IOEnv (Env IfGblEnv IfLclEnv) [Name]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM OccName -> TcRnIf IfGblEnv IfLclEnv Name
lookupIfaceTop (IfaceDecl -> [OccName]
ifaceDeclImplicitBndrs IfaceDecl
decl)
; [(Name, TyThing)] -> IfL [(Name, TyThing)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Name, TyThing)] -> IfL [(Name, TyThing)])
-> [(Name, TyThing)] -> IfL [(Name, TyThing)]
forall a b. (a -> b) -> a -> b
$ (Name
main_name, TyThing
thing) (Name, TyThing) -> [(Name, TyThing)] -> [(Name, TyThing)]
forall a. a -> [a] -> [a]
:
[(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
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr (IfaceDecl -> Name
ifName IfaceDecl
decl)
bumpDeclStats :: Name -> IfL ()
bumpDeclStats :: Name -> TcRnIf IfGblEnv IfLclEnv ()
bumpDeclStats Name
name
= do { SDoc -> TcRnIf IfGblEnv IfLclEnv ()
forall m n. SDoc -> TcRnIf m n ()
traceIf (String -> SDoc
text String
"Loading decl for" SDoc -> SDoc -> SDoc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name)
; (ExternalPackageState -> ExternalPackageState)
-> TcRnIf IfGblEnv IfLclEnv ()
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 Arity -> Arity -> Arity
forall a. Num a => a -> a -> a
+ Arity
1 } })
}
tc_fd :: FunDep IfLclName -> IfL (FunDep TyVar)
tc_fd :: FunDep FastString
-> IOEnv (Env IfGblEnv IfLclEnv) (FunDep CoreBndr)
tc_fd ([FastString]
tvs1, [FastString]
tvs2) = do { [CoreBndr]
tvs1' <- (FastString -> IfL CoreBndr)
-> [FastString] -> IOEnv (Env IfGblEnv IfLclEnv) [CoreBndr]
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' <- (FastString -> IfL CoreBndr)
-> [FastString] -> IOEnv (Env IfGblEnv IfLclEnv) [CoreBndr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FastString -> IfL CoreBndr
tcIfaceTyVar [FastString]
tvs2
; FunDep CoreBndr -> IOEnv (Env IfGblEnv IfLclEnv) (FunDep CoreBndr)
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 = ([CoAxBranch] -> IfaceAxBranch -> IfL [CoAxBranch])
-> [CoAxBranch] -> [IfaceAxBranch] -> IfL [CoAxBranch]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM [CoAxBranch] -> IfaceAxBranch -> IfL [CoAxBranch]
tc_ax_branch [] [IfaceAxBranch]
if_branches
tc_ax_branch :: [CoAxBranch] -> IfaceAxBranch -> IfL [CoAxBranch]
tc_ax_branch :: [CoAxBranch] -> IfaceAxBranch -> IfL [CoAxBranch]
tc_ax_branch [CoAxBranch]
prev_branches
(IfaceAxBranch { ifaxbTyVars :: IfaceAxBranch -> [IfaceTvBndr]
ifaxbTyVars = [IfaceTvBndr]
tv_bndrs
, ifaxbEtaTyVars :: IfaceAxBranch -> [IfaceTvBndr]
ifaxbEtaTyVars = [IfaceTvBndr]
eta_tv_bndrs
, ifaxbCoVars :: IfaceAxBranch -> [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 })
= [IfaceTyConBinder]
-> ([TyConBinder] -> IfL [CoAxBranch]) -> IfL [CoAxBranch]
forall a. [IfaceTyConBinder] -> ([TyConBinder] -> IfL a) -> IfL a
bindIfaceTyConBinders_AT
((IfaceTvBndr -> IfaceTyConBinder)
-> [IfaceTvBndr] -> [IfaceTyConBinder]
forall a b. (a -> b) -> [a] -> [b]
map (\IfaceTvBndr
b -> IfaceBndr -> TyConBndrVis -> IfaceTyConBinder
forall var argf. var -> argf -> VarBndr var argf
Bndr (IfaceTvBndr -> IfaceBndr
IfaceTvBndr IfaceTvBndr
b) (ArgFlag -> TyConBndrVis
NamedTCB ArgFlag
Inferred)) [IfaceTvBndr]
tv_bndrs) (([TyConBinder] -> IfL [CoAxBranch]) -> IfL [CoAxBranch])
-> ([TyConBinder] -> IfL [CoAxBranch]) -> IfL [CoAxBranch]
forall a b. (a -> b) -> a -> b
$ \ [TyConBinder]
tvs ->
[IfaceIdBndr]
-> ([CoreBndr] -> IfL [CoAxBranch]) -> IfL [CoAxBranch]
forall a. [IfaceIdBndr] -> ([CoreBndr] -> IfL a) -> IfL a
bindIfaceIds [IfaceIdBndr]
cv_bndrs (([CoreBndr] -> IfL [CoAxBranch]) -> IfL [CoAxBranch])
-> ([CoreBndr] -> IfL [CoAxBranch]) -> IfL [CoAxBranch]
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 <- [IfaceTvBndr]
-> ([CoreBndr] -> IOEnv (Env IfGblEnv IfLclEnv) [CoreBndr])
-> IOEnv (Env IfGblEnv IfLclEnv) [CoreBndr]
forall a. [IfaceTvBndr] -> ([CoreBndr] -> IfL a) -> IfL a
bindIfaceTyVars [IfaceTvBndr]
eta_tv_bndrs [CoreBndr] -> IOEnv (Env IfGblEnv IfLclEnv) [CoreBndr]
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 (Module -> ModuleName
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 = [TyConBinder] -> [CoreBndr]
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 = (Arity -> CoAxBranch) -> [Arity] -> [CoAxBranch]
forall a b. (a -> b) -> [a] -> [b]
map ([CoAxBranch]
prev_branches [CoAxBranch] -> Arity -> CoAxBranch
forall a. Outputable a => [a] -> Arity -> a
`getNth`) [Arity]
incomps }
; [CoAxBranch] -> IfL [CoAxBranch]
forall (m :: * -> *) a. Monad m => a -> m a
return ([CoAxBranch]
prev_branches [CoAxBranch] -> [CoAxBranch] -> [CoAxBranch]
forall a. [a] -> [a] -> [a]
++ [CoAxBranch
br]) }
tcIfaceDataCons :: Name -> TyCon -> [TyConBinder] -> IfaceConDecls -> IfL AlgTyConRhs
tcIfaceDataCons :: Name -> TyCon -> [TyConBinder] -> IfaceConDecls -> IfL AlgTyConRhs
tcIfaceDataCons Name
tycon_name TyCon
tycon [TyConBinder]
tc_tybinders IfaceConDecls
if_cons
= case IfaceConDecls
if_cons of
IfaceConDecls
IfAbstractTyCon -> AlgTyConRhs -> IfL AlgTyConRhs
forall (m :: * -> *) a. Monad m => a -> m a
return AlgTyConRhs
AbstractTyCon
IfDataTyCon [IfaceConDecl]
cons -> do { [DataCon]
data_cons <- (IfaceConDecl -> IOEnv (Env IfGblEnv IfLclEnv) DataCon)
-> [IfaceConDecl] -> IOEnv (Env IfGblEnv IfLclEnv) [DataCon]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceConDecl -> IOEnv (Env IfGblEnv IfLclEnv) DataCon
tc_con_decl [IfaceConDecl]
cons
; AlgTyConRhs -> IfL AlgTyConRhs
forall (m :: * -> *) a. Monad m => a -> m a
return ([DataCon] -> AlgTyConRhs
mkDataTyConRhs [DataCon]
data_cons) }
IfNewTyCon IfaceConDecl
con -> do { DataCon
data_con <- IfaceConDecl -> IOEnv (Env IfGblEnv IfLclEnv) DataCon
tc_con_decl IfaceConDecl
con
; Name -> TyCon -> DataCon -> IfL AlgTyConRhs
forall m n. Name -> TyCon -> DataCon -> TcRnIf m n AlgTyConRhs
mkNewTyConRhs Name
tycon_name TyCon
tycon DataCon
data_con }
where
univ_tvs :: [TyVar]
univ_tvs :: [CoreBndr]
univ_tvs = [TyConBinder] -> [CoreBndr]
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 -> IOEnv (Env IfGblEnv IfLclEnv) DataCon
tc_con_decl (IfCon { ifConInfix :: IfaceConDecl -> Bool
ifConInfix = Bool
is_infix,
ifConExTCvs :: IfaceConDecl -> [IfaceBndr]
ifConExTCvs = [IfaceBndr]
ex_bndrs,
ifConUserTvBinders :: IfaceConDecl -> [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})
=
[IfaceBndr]
-> ([CoreBndr] -> IOEnv (Env IfGblEnv IfLclEnv) DataCon)
-> IOEnv (Env IfGblEnv IfLclEnv) DataCon
forall a. [IfaceBndr] -> ([CoreBndr] -> IfL a) -> IfL a
bindIfaceBndrs [IfaceBndr]
ex_bndrs (([CoreBndr] -> IOEnv (Env IfGblEnv IfLclEnv) DataCon)
-> IOEnv (Env IfGblEnv IfLclEnv) DataCon)
-> ([CoreBndr] -> IOEnv (Env IfGblEnv IfLclEnv) DataCon)
-> IOEnv (Env IfGblEnv IfLclEnv) DataCon
forall a b. (a -> b) -> a -> b
$ \ [CoreBndr]
ex_tvs -> do
{ SDoc -> TcRnIf IfGblEnv IfLclEnv ()
forall m n. SDoc -> TcRnIf m n ()
traceIf (String -> SDoc
text String
"Start interface-file tc_con_decl" SDoc -> SDoc -> SDoc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
dc_name)
; [VarBndr CoreBndr Specificity]
user_tv_bndrs <- (IfaceForAllSpecBndr
-> IOEnv (Env IfGblEnv IfLclEnv) (VarBndr CoreBndr Specificity))
-> [IfaceForAllSpecBndr]
-> IOEnv (Env IfGblEnv IfLclEnv) [VarBndr CoreBndr Specificity]
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
_) ->
CoreBndr -> Specificity -> VarBndr CoreBndr Specificity
forall var argf. var -> argf -> VarBndr var argf
Bndr (CoreBndr -> Specificity -> VarBndr CoreBndr Specificity)
-> IfL CoreBndr
-> IOEnv
(Env IfGblEnv IfLclEnv)
(Specificity -> VarBndr CoreBndr Specificity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FastString -> IfL CoreBndr
tcIfaceLclId FastString
name IOEnv
(Env IfGblEnv IfLclEnv)
(Specificity -> VarBndr CoreBndr Specificity)
-> IOEnv (Env IfGblEnv IfLclEnv) Specificity
-> IOEnv (Env IfGblEnv IfLclEnv) (VarBndr CoreBndr Specificity)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Specificity -> IOEnv (Env IfGblEnv IfLclEnv) Specificity
forall (f :: * -> *) a. Applicative f => a -> f a
pure Specificity
vis
IfaceTvBndr (FastString
name, IfaceType
_) ->
CoreBndr -> Specificity -> VarBndr CoreBndr Specificity
forall var argf. var -> argf -> VarBndr var argf
Bndr (CoreBndr -> Specificity -> VarBndr CoreBndr Specificity)
-> IfL CoreBndr
-> IOEnv
(Env IfGblEnv IfLclEnv)
(Specificity -> VarBndr CoreBndr Specificity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FastString -> IfL CoreBndr
tcIfaceTyVar FastString
name IOEnv
(Env IfGblEnv IfLclEnv)
(Specificity -> VarBndr CoreBndr Specificity)
-> IOEnv (Env IfGblEnv IfLclEnv) Specificity
-> IOEnv (Env IfGblEnv IfLclEnv) (VarBndr CoreBndr Specificity)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Specificity -> IOEnv (Env IfGblEnv IfLclEnv) Specificity
forall (f :: * -> *) a. Applicative f => a -> f a
pure Specificity
vis)
[IfaceForAllSpecBndr]
user_bndrs
; ~([EqSpec]
eq_spec, ThetaType
theta, [Scaled Type]
arg_tys, [HsImplBang]
stricts) <- SDoc
-> IfL ([EqSpec], ThetaType, [Scaled Type], [HsImplBang])
-> IfL ([EqSpec], ThetaType, [Scaled Type], [HsImplBang])
forall a. SDoc -> IfL a -> IfL a
forkM (Name -> SDoc
forall a. Outputable a => a -> SDoc
mk_doc Name
dc_name) (IfL ([EqSpec], ThetaType, [Scaled Type], [HsImplBang])
-> IfL ([EqSpec], ThetaType, [Scaled Type], [HsImplBang]))
-> IfL ([EqSpec], ThetaType, [Scaled Type], [HsImplBang])
-> IfL ([EqSpec], ThetaType, [Scaled Type], [HsImplBang])
forall a b. (a -> b) -> a -> b
$
do { [EqSpec]
eq_spec <- [IfaceTvBndr] -> IfL [EqSpec]
tcIfaceEqSpec [IfaceTvBndr]
spec
; ThetaType
theta <- IfaceContext -> IfL ThetaType
tcIfaceCtxt IfaceContext
ctxt
; [Scaled Type]
arg_tys <- SDoc -> IfL [Scaled Type] -> IfL [Scaled Type]
forall a. SDoc -> IfL a -> IfL a
forkM (Name -> SDoc
forall a. Outputable a => a -> SDoc
mk_doc Name
dc_name SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"arg_tys")
(IfL [Scaled Type] -> IfL [Scaled Type])
-> IfL [Scaled Type] -> IfL [Scaled Type]
forall a b. (a -> b) -> a -> b
$ ((IfaceType, IfaceType)
-> IOEnv (Env IfGblEnv IfLclEnv) (Scaled Type))
-> [(IfaceType, IfaceType)] -> IfL [Scaled Type]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(IfaceType
w, IfaceType
ty) -> Type -> Type -> Scaled Type
forall a. Type -> a -> Scaled a
mkScaled (Type -> Type -> Scaled Type)
-> IfL Type -> IOEnv (Env IfGblEnv IfLclEnv) (Type -> Scaled Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceType -> IfL Type
tcIfaceType IfaceType
w IOEnv (Env IfGblEnv IfLclEnv) (Type -> Scaled Type)
-> IfL Type -> IOEnv (Env IfGblEnv IfLclEnv) (Scaled Type)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IfaceType -> IfL Type
tcIfaceType IfaceType
ty) [(IfaceType, IfaceType)]
args
; [HsImplBang]
stricts <- (IfaceBang -> IOEnv (Env IfGblEnv IfLclEnv) HsImplBang)
-> [IfaceBang] -> IOEnv (Env IfGblEnv IfLclEnv) [HsImplBang]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceBang -> IOEnv (Env IfGblEnv IfLclEnv) HsImplBang
tc_strict [IfaceBang]
if_stricts
; ([EqSpec], ThetaType, [Scaled Type], [HsImplBang])
-> IfL ([EqSpec], ThetaType, [Scaled Type], [HsImplBang])
forall (m :: * -> *) a. Monad m => a -> m a
return ([EqSpec]
eq_spec, ThetaType
theta, [Scaled Type]
arg_tys, [HsImplBang]
stricts) }
; let orig_res_ty :: Type
orig_res_ty = TyCon -> ThetaType -> Type
mkFamilyTyConApp TyCon
tycon
(TCvSubst -> [CoreBndr] -> ThetaType
substTyCoVars ([(CoreBndr, Type)] -> TCvSubst
mkTvSubstPrs ((EqSpec -> (CoreBndr, Type)) -> [EqSpec] -> [(CoreBndr, Type)]
forall a b. (a -> b) -> [a] -> [b]
map EqSpec -> (CoreBndr, Type)
eqSpecPair [EqSpec]
eq_spec))
([TyConBinder] -> [CoreBndr]
forall tv argf. [VarBndr tv argf] -> [tv]
binderVars [TyConBinder]
tc_tybinders))
; Name
prom_rep_name <- Name -> TcRnIf IfGblEnv IfLclEnv Name
forall gbl lcl. Name -> TcRnIf gbl lcl Name
newTyConRepName Name
dc_name
; DataCon
con <- FamInstEnvs
-> Name
-> Bool
-> Name
-> [HsSrcBang]
-> Maybe [HsImplBang]
-> [FieldLabel]
-> [CoreBndr]
-> [CoreBndr]
-> [VarBndr CoreBndr Specificity]
-> [EqSpec]
-> ThetaType
-> [Scaled Type]
-> Type
-> TyCon
-> NameEnv Arity
-> IOEnv (Env IfGblEnv IfLclEnv) DataCon
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 (String -> SDoc -> FamInstEnvs
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tcIfaceDataCons: FamInstEnvs" (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
dc_name))
Name
dc_name Bool
is_infix Name
prom_rep_name
((IfaceSrcBang -> HsSrcBang) -> [IfaceSrcBang] -> [HsSrcBang]
forall a b. (a -> b) -> [a] -> [b]
map IfaceSrcBang -> HsSrcBang
src_strict [IfaceSrcBang]
if_src_stricts)
([HsImplBang] -> Maybe [HsImplBang]
forall a. a -> Maybe a
Just [HsImplBang]
stricts)
[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
; SDoc -> TcRnIf IfGblEnv IfLclEnv ()
forall m n. SDoc -> TcRnIf m n ()
traceIf (String -> SDoc
text String
"Done interface-file tc_con_decl" SDoc -> SDoc -> SDoc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
dc_name)
; DataCon -> IOEnv (Env IfGblEnv IfLclEnv) DataCon
forall (m :: * -> *) a. Monad m => a -> m a
return DataCon
con }
mk_doc :: a -> SDoc
mk_doc a
con_name = String -> SDoc
text String
"Constructor" SDoc -> SDoc -> SDoc
<+> a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
con_name
tc_strict :: IfaceBang -> IfL HsImplBang
tc_strict :: IfaceBang -> IOEnv (Env IfGblEnv IfLclEnv) HsImplBang
tc_strict IfaceBang
IfNoBang = HsImplBang -> IOEnv (Env IfGblEnv IfLclEnv) HsImplBang
forall (m :: * -> *) a. Monad m => a -> m a
return (HsImplBang
HsLazy)
tc_strict IfaceBang
IfStrict = HsImplBang -> IOEnv (Env IfGblEnv IfLclEnv) HsImplBang
forall (m :: * -> *) a. Monad m => a -> m a
return (HsImplBang
HsStrict)
tc_strict IfaceBang
IfUnpack = HsImplBang -> IOEnv (Env IfGblEnv IfLclEnv) HsImplBang
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Coercion -> HsImplBang
HsUnpack Maybe Coercion
forall a. Maybe a
Nothing)
tc_strict (IfUnpackCo IfaceCoercion
if_co) = do { Coercion
co <- IfaceCoercion -> IfL Coercion
tcIfaceCo IfaceCoercion
if_co
; HsImplBang -> IOEnv (Env IfGblEnv IfLclEnv) HsImplBang
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Coercion -> HsImplBang
HsUnpack (Coercion -> Maybe Coercion
forall a. a -> Maybe a
Just Coercion
co)) }
src_strict :: IfaceSrcBang -> HsSrcBang
src_strict :: IfaceSrcBang -> HsSrcBang
src_strict (IfSrcBang SrcUnpackedness
unpk SrcStrictness
bang) = SourceText -> SrcUnpackedness -> SrcStrictness -> HsSrcBang
HsSrcBang SourceText
NoSourceText SrcUnpackedness
unpk SrcStrictness
bang
tcIfaceEqSpec :: IfaceEqSpec -> IfL [EqSpec]
tcIfaceEqSpec :: [IfaceTvBndr] -> IfL [EqSpec]
tcIfaceEqSpec [IfaceTvBndr]
spec
= (IfaceTvBndr -> IOEnv (Env IfGblEnv IfLclEnv) EqSpec)
-> [IfaceTvBndr] -> IfL [EqSpec]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceTvBndr -> IOEnv (Env IfGblEnv IfLclEnv) EqSpec
do_item [IfaceTvBndr]
spec
where
do_item :: IfaceTvBndr -> IOEnv (Env IfGblEnv IfLclEnv) EqSpec
do_item (FastString
occ, IfaceType
if_ty) = do { CoreBndr
tv <- FastString -> IfL CoreBndr
tcIfaceTyVar FastString
occ
; Type
ty <- IfaceType -> IfL Type
tcIfaceType IfaceType
if_ty
; EqSpec -> IOEnv (Env IfGblEnv IfLclEnv) EqSpec
forall (m :: * -> *) a. Monad m => a -> m a
return (CoreBndr -> Type -> EqSpec
mkEqSpec CoreBndr
tv Type
ty) }
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 -> IOEnv (Env IfGblEnv IfLclEnv) ClsInst
tcIfaceInst (IfaceClsInst { ifDFun :: IfaceClsInst -> Name
ifDFun = Name
dfun_name, ifOFlag :: IfaceClsInst -> OverlapFlag
ifOFlag = OverlapFlag
oflag
, ifInstCls :: IfaceClsInst -> Name
ifInstCls = Name
cls, ifInstTys :: IfaceClsInst -> [Maybe IfaceTyCon]
ifInstTys = [Maybe IfaceTyCon]
mb_tcs
, ifInstOrph :: IfaceClsInst -> IsOrphan
ifInstOrph = IsOrphan
orph })
= do { CoreBndr
dfun <- SDoc -> IfL CoreBndr -> IfL CoreBndr
forall a. SDoc -> IfL a -> IfL a
forkM (String -> SDoc
text String
"Dict fun" SDoc -> SDoc -> SDoc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
dfun_name) (IfL CoreBndr -> IfL CoreBndr) -> IfL CoreBndr -> IfL CoreBndr
forall a b. (a -> b) -> a -> b
$
(TyThing -> CoreBndr) -> IfL TyThing -> IfL CoreBndr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HasDebugCallStack => TyThing -> CoreBndr
TyThing -> CoreBndr
tyThingId (Name -> IfL TyThing
tcIfaceImplicit Name
dfun_name)
; let mb_tcs' :: [RoughMatchTc]
mb_tcs' = (Maybe IfaceTyCon -> RoughMatchTc)
-> [Maybe IfaceTyCon] -> [RoughMatchTc]
forall a b. (a -> b) -> [a] -> [b]
map Maybe IfaceTyCon -> RoughMatchTc
tcRoughTyCon [Maybe IfaceTyCon]
mb_tcs
; ClsInst -> IOEnv (Env IfGblEnv IfLclEnv) ClsInst
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 -> IOEnv (Env IfGblEnv IfLclEnv) FamInst
tcIfaceFamInst (IfaceFamInst { ifFamInstFam :: IfaceFamInst -> Name
ifFamInstFam = Name
fam, ifFamInstTys :: IfaceFamInst -> [Maybe IfaceTyCon]
ifFamInstTys = [Maybe IfaceTyCon]
mb_tcs
, ifFamInstAxiom :: IfaceFamInst -> Name
ifFamInstAxiom = Name
axiom_name } )
= do { CoAxiom Branched
axiom' <- SDoc -> IfL (CoAxiom Branched) -> IfL (CoAxiom Branched)
forall a. SDoc -> IfL a -> IfL a
forkM (String -> SDoc
text String
"Axiom" SDoc -> SDoc -> SDoc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
axiom_name) (IfL (CoAxiom Branched) -> IfL (CoAxiom Branched))
-> IfL (CoAxiom Branched) -> IfL (CoAxiom Branched)
forall a b. (a -> b) -> a -> b
$
Name -> IfL (CoAxiom Branched)
tcIfaceCoAxiom Name
axiom_name
; let axiom'' :: CoAxiom Unbranched
axiom'' = CoAxiom Branched -> CoAxiom Unbranched
forall (br :: BranchFlag). CoAxiom br -> CoAxiom Unbranched
toUnbranchedAxiom CoAxiom Branched
axiom'
mb_tcs' :: [RoughMatchTc]
mb_tcs' = (Maybe IfaceTyCon -> RoughMatchTc)
-> [Maybe IfaceTyCon] -> [RoughMatchTc]
forall a b. (a -> b) -> [a] -> [b]
map Maybe IfaceTyCon -> RoughMatchTc
tcRoughTyCon [Maybe IfaceTyCon]
mb_tcs
; FamInst -> IOEnv (Env IfGblEnv IfLclEnv) FamInst
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> [RoughMatchTc] -> CoAxiom Unbranched -> FamInst
mkImportedFamInst Name
fam [RoughMatchTc]
mb_tcs' CoAxiom Unbranched
axiom'') }
tcIfaceRules :: Bool
-> [IfaceRule]
-> IfL [CoreRule]
tcIfaceRules :: Bool -> [IfaceRule] -> IfL [CoreRule]
tcIfaceRules Bool
ignore_prags [IfaceRule]
if_rules
| Bool
ignore_prags = [CoreRule] -> IfL [CoreRule]
forall (m :: * -> *) a. Monad m => a -> m a
return []
| Bool
otherwise = (IfaceRule -> IOEnv (Env IfGblEnv IfLclEnv) CoreRule)
-> [IfaceRule] -> IfL [CoreRule]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceRule -> IOEnv (Env IfGblEnv IfLclEnv) CoreRule
tcIfaceRule [IfaceRule]
if_rules
tcIfaceRule :: IfaceRule -> IfL CoreRule
tcIfaceRule :: IfaceRule -> IOEnv (Env IfGblEnv IfLclEnv) CoreRule
tcIfaceRule (IfaceRule {ifRuleName :: IfaceRule -> 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') <-
SDoc
-> IfL ([CoreBndr], [CoreExpr], CoreExpr)
-> IfL ([CoreBndr], [CoreExpr], CoreExpr)
forall a. SDoc -> IfL a -> IfL a
forkM (String -> SDoc
text String
"Rule" SDoc -> SDoc -> SDoc
<+> FastString -> SDoc
pprRuleName FastString
name) (IfL ([CoreBndr], [CoreExpr], CoreExpr)
-> IfL ([CoreBndr], [CoreExpr], CoreExpr))
-> IfL ([CoreBndr], [CoreExpr], CoreExpr)
-> IfL ([CoreBndr], [CoreExpr], CoreExpr)
forall a b. (a -> b) -> a -> b
$
[IfaceBndr]
-> ([CoreBndr] -> IfL ([CoreBndr], [CoreExpr], CoreExpr))
-> IfL ([CoreBndr], [CoreExpr], CoreExpr)
forall a. [IfaceBndr] -> ([CoreBndr] -> IfL a) -> IfL a
bindIfaceBndrs [IfaceBndr]
bndrs (([CoreBndr] -> IfL ([CoreBndr], [CoreExpr], CoreExpr))
-> IfL ([CoreBndr], [CoreExpr], CoreExpr))
-> ([CoreBndr] -> IfL ([CoreBndr], [CoreExpr], CoreExpr))
-> IfL ([CoreBndr], [CoreExpr], CoreExpr)
forall a b. (a -> b) -> a -> b
$ \ [CoreBndr]
bndrs' ->
do { [CoreExpr]
args' <- (IfaceExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr)
-> [IfaceExpr] -> IOEnv (Env IfGblEnv IfLclEnv) [CoreExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
tcIfaceExpr [IfaceExpr]
args
; CoreExpr
rhs' <- IfaceExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
tcIfaceExpr IfaceExpr
rhs
; GeneralFlag
-> TcRnIf IfGblEnv IfLclEnv () -> TcRnIf IfGblEnv IfLclEnv ()
forall gbl lcl.
GeneralFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
whenGOptM GeneralFlag
Opt_DoCoreLinting (TcRnIf IfGblEnv IfLclEnv () -> TcRnIf IfGblEnv IfLclEnv ())
-> TcRnIf IfGblEnv IfLclEnv () -> TcRnIf IfGblEnv IfLclEnv ()
forall a b. (a -> b) -> a -> b
$ do
{ DynFlags
dflags <- IOEnv (Env IfGblEnv IfLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
; (IfGblEnv
_, IfLclEnv
lcl_env) <- TcRnIf IfGblEnv IfLclEnv (IfGblEnv, IfLclEnv)
forall gbl lcl. TcRnIf gbl lcl (gbl, lcl)
getEnvs
; let in_scope :: [Var]
in_scope :: [CoreBndr]
in_scope = ((UniqFM FastString CoreBndr -> [CoreBndr]
forall key elt. UniqFM key elt -> [elt]
nonDetEltsUFM (UniqFM FastString CoreBndr -> [CoreBndr])
-> UniqFM FastString CoreBndr -> [CoreBndr]
forall a b. (a -> b) -> a -> b
$ IfLclEnv -> UniqFM FastString CoreBndr
if_tv_env IfLclEnv
lcl_env) [CoreBndr] -> [CoreBndr] -> [CoreBndr]
forall a. [a] -> [a] -> [a]
++
(UniqFM FastString CoreBndr -> [CoreBndr]
forall key elt. UniqFM key elt -> [elt]
nonDetEltsUFM (UniqFM FastString CoreBndr -> [CoreBndr])
-> UniqFM FastString CoreBndr -> [CoreBndr]
forall a b. (a -> b) -> a -> b
$ IfLclEnv -> UniqFM FastString CoreBndr
if_id_env IfLclEnv
lcl_env) [CoreBndr] -> [CoreBndr] -> [CoreBndr]
forall a. [a] -> [a] -> [a]
++
[CoreBndr]
bndrs' [CoreBndr] -> [CoreBndr] -> [CoreBndr]
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 -> () -> TcRnIf IfGblEnv IfLclEnv ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just Bag SDoc
errs -> do
Logger
logger <- IOEnv (Env IfGblEnv IfLclEnv) Logger
forall (m :: * -> *). HasLogger m => m Logger
getLogger
IO () -> TcRnIf IfGblEnv IfLclEnv ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> TcRnIf IfGblEnv IfLclEnv ())
-> IO () -> TcRnIf IfGblEnv IfLclEnv ()
forall a b. (a -> b) -> a -> b
$ Logger -> DynFlags -> Bool -> SDoc -> SDoc -> WarnsAndErrs -> IO ()
displayLintResults Logger
logger DynFlags
dflags Bool
False SDoc
doc
(CoreExpr -> SDoc
forall b. OutputableBndr b => Expr b -> SDoc
pprCoreExpr CoreExpr
rhs')
(Bag SDoc
forall a. Bag a
emptyBag, Bag SDoc
errs) }
; ([CoreBndr], [CoreExpr], CoreExpr)
-> IfL ([CoreBndr], [CoreExpr], CoreExpr)
forall (m :: * -> *) a. Monad m => a -> m a
return ([CoreBndr]
bndrs', [CoreExpr]
args', CoreExpr
rhs') }
; let mb_tcs :: [Maybe Name]
mb_tcs = (IfaceExpr -> Maybe Name) -> [IfaceExpr] -> [Maybe Name]
forall a b. (a -> b) -> [a] -> [b]
map IfaceExpr -> Maybe Name
ifTopFreeName [IfaceExpr]
args
; Module
this_mod <- IfL Module
getIfModule
; CoreRule -> IOEnv (Env IfGblEnv IfLclEnv) CoreRule
forall (m :: * -> *) a. Monad m => a -> m a
return (Rule { 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 }) }
where
ifTopFreeName :: IfaceExpr -> Maybe Name
ifTopFreeName :: IfaceExpr -> Maybe Name
ifTopFreeName (IfaceType (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
_ )) = Name -> Maybe Name
forall a. a -> Maybe a
Just (IfaceTyCon -> Name
ifaceTyConName IfaceTyCon
tc)
ifTopFreeName (IfaceType (IfaceTupleTy TupleSort
s PromotionFlag
_ IfaceAppArgs
ts)) = Name -> Maybe Name
forall a. a -> Maybe a
Just (TupleSort -> Arity -> Name
tupleTyConName TupleSort
s (IfaceContext -> Arity
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) = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n
ifTopFreeName IfaceExpr
_ = Maybe Name
forall a. Maybe a
Nothing
doc :: SDoc
doc = String -> SDoc
text String
"Unfolding of" SDoc -> SDoc -> SDoc
<+> FastString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FastString
name
tcIfaceAnnotations :: [IfaceAnnotation] -> IfL [Annotation]
tcIfaceAnnotations :: [IfaceAnnotation] -> IfL [Annotation]
tcIfaceAnnotations = (IfaceAnnotation -> IOEnv (Env IfGblEnv IfLclEnv) Annotation)
-> [IfaceAnnotation] -> IfL [Annotation]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceAnnotation -> IOEnv (Env IfGblEnv IfLclEnv) Annotation
tcIfaceAnnotation
tcIfaceAnnotation :: IfaceAnnotation -> IfL Annotation
tcIfaceAnnotation :: IfaceAnnotation -> IOEnv (Env IfGblEnv IfLclEnv) Annotation
tcIfaceAnnotation (IfaceAnnotation IfaceAnnTarget
target AnnPayload
serialized) = do
AnnTarget Name
target' <- IfaceAnnTarget -> IfL (AnnTarget Name)
tcIfaceAnnTarget IfaceAnnTarget
target
Annotation -> IOEnv (Env IfGblEnv IfLclEnv) Annotation
forall (m :: * -> *) a. Monad m => a -> m a
return (Annotation -> IOEnv (Env IfGblEnv IfLclEnv) Annotation)
-> Annotation -> IOEnv (Env IfGblEnv IfLclEnv) Annotation
forall a b. (a -> b) -> a -> b
$ Annotation {
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) =
Name -> AnnTarget Name
forall name. name -> AnnTarget name
NamedTarget (Name -> AnnTarget Name)
-> TcRnIf IfGblEnv IfLclEnv Name -> IfL (AnnTarget Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OccName -> TcRnIf IfGblEnv IfLclEnv Name
lookupIfaceTop OccName
occ
tcIfaceAnnTarget (ModuleTarget Module
mod) =
AnnTarget Name -> IfL (AnnTarget Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (AnnTarget Name -> IfL (AnnTarget Name))
-> AnnTarget Name -> IfL (AnnTarget Name)
forall a b. (a -> b) -> a -> b
$ Module -> AnnTarget Name
forall name. Module -> AnnTarget name
ModuleTarget Module
mod
tcIfaceCompleteMatches :: [IfaceCompleteMatch] -> IfL [CompleteMatch]
tcIfaceCompleteMatches :: [IfaceCompleteMatch] -> IfL [CompleteMatch]
tcIfaceCompleteMatches = (IfaceCompleteMatch -> IOEnv (Env IfGblEnv IfLclEnv) CompleteMatch)
-> [IfaceCompleteMatch] -> IfL [CompleteMatch]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceCompleteMatch -> IOEnv (Env IfGblEnv IfLclEnv) CompleteMatch
tcIfaceCompleteMatch
tcIfaceCompleteMatch :: IfaceCompleteMatch -> IfL CompleteMatch
tcIfaceCompleteMatch :: IfaceCompleteMatch -> IOEnv (Env IfGblEnv IfLclEnv) CompleteMatch
tcIfaceCompleteMatch (IfaceCompleteMatch [Name]
ms Maybe IfaceTyCon
mtc) = SDoc
-> IOEnv (Env IfGblEnv IfLclEnv) CompleteMatch
-> IOEnv (Env IfGblEnv IfLclEnv) CompleteMatch
forall a. SDoc -> IfL a -> IfL a
forkM SDoc
doc (IOEnv (Env IfGblEnv IfLclEnv) CompleteMatch
-> IOEnv (Env IfGblEnv IfLclEnv) CompleteMatch)
-> IOEnv (Env IfGblEnv IfLclEnv) CompleteMatch
-> IOEnv (Env IfGblEnv IfLclEnv) CompleteMatch
forall a b. (a -> b) -> a -> b
$ do
UniqDSet ConLike
conlikes <- [ConLike] -> UniqDSet ConLike
forall a. Uniquable a => [a] -> UniqDSet a
mkUniqDSet ([ConLike] -> UniqDSet ConLike)
-> IOEnv (Env IfGblEnv IfLclEnv) [ConLike]
-> IOEnv (Env IfGblEnv IfLclEnv) (UniqDSet ConLike)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Name -> IOEnv (Env IfGblEnv IfLclEnv) ConLike)
-> [Name] -> IOEnv (Env IfGblEnv IfLclEnv) [ConLike]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> IOEnv (Env IfGblEnv IfLclEnv) ConLike
tcIfaceConLike [Name]
ms
Maybe TyCon
mtc' <- (IfaceTyCon -> IOEnv (Env IfGblEnv IfLclEnv) TyCon)
-> Maybe IfaceTyCon -> IOEnv (Env IfGblEnv IfLclEnv) (Maybe TyCon)
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
CompleteMatch -> IOEnv (Env IfGblEnv IfLclEnv) CompleteMatch
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
<+> [Name] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Name]
ms
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 (CoreBndr -> Type) -> IfL CoreBndr -> IfL Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FastString -> IfL CoreBndr
tcIfaceTyVar FastString
n
go (IfaceFreeTyVar CoreBndr
n) = String -> SDoc -> IfL Type
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tcIfaceType:IfaceFreeTyVar" (CoreBndr -> SDoc
forall a. Outputable a => a -> SDoc
ppr CoreBndr
n)
go (IfaceLitTy IfaceTyLit
l) = TyLit -> Type
LitTy (TyLit -> Type) -> IOEnv (Env IfGblEnv IfLclEnv) TyLit -> IfL Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceTyLit -> IOEnv (Env IfGblEnv IfLclEnv) TyLit
tcIfaceTyLit IfaceTyLit
l
go (IfaceFunTy AnonArgFlag
flag IfaceType
w IfaceType
t1 IfaceType
t2) = AnonArgFlag -> Type -> Type -> Type -> Type
FunTy AnonArgFlag
flag (Type -> Type -> Type -> Type)
-> IfL Type -> IOEnv (Env IfGblEnv IfLclEnv) (Type -> Type -> Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceType -> IfL Type
tcIfaceType IfaceType
w IOEnv (Env IfGblEnv IfLclEnv) (Type -> Type -> Type)
-> IfL Type -> IOEnv (Env IfGblEnv IfLclEnv) (Type -> Type)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IfaceType -> IfL Type
go IfaceType
t1 IOEnv (Env IfGblEnv IfLclEnv) (Type -> Type)
-> IfL Type -> IfL Type
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IfaceType -> IfL Type
go IfaceType
t2
go (IfaceTupleTy TupleSort
s PromotionFlag
i IfaceAppArgs
tks) = TupleSort -> PromotionFlag -> IfaceAppArgs -> IfL Type
tcIfaceTupleTy TupleSort
s PromotionFlag
i IfaceAppArgs
tks
go (IfaceAppTy IfaceType
t IfaceAppArgs
ts)
= do { Type
t' <- IfaceType -> IfL Type
go IfaceType
t
; ThetaType
ts' <- (IfaceType -> IfL Type) -> IfaceContext -> IfL ThetaType
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse IfaceType -> IfL Type
go (IfaceAppArgs -> IfaceContext
appArgsIfaceTypes IfaceAppArgs
ts)
; Type -> IfL Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Type -> Type -> Type) -> Type -> ThetaType -> Type
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Type -> Type -> Type
AppTy Type
t' ThetaType
ts') }
go (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
tks)
= do { TyCon
tc' <- IfaceTyCon -> IOEnv (Env IfGblEnv IfLclEnv) TyCon
tcIfaceTyCon IfaceTyCon
tc
; ThetaType
tks' <- (IfaceType -> IfL Type) -> IfaceContext -> IfL ThetaType
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceType -> IfL Type
go (IfaceAppArgs -> IfaceContext
appArgsIfaceTypes IfaceAppArgs
tks)
; Type -> IfL Type
forall (m :: * -> *) a. Monad m => a -> m a
return (TyCon -> ThetaType -> Type
mkTyConApp TyCon
tc' ThetaType
tks') }
go (IfaceForAllTy IfaceForAllBndr
bndr IfaceType
t)
= IfaceForAllBndr -> (CoreBndr -> ArgFlag -> IfL Type) -> IfL Type
forall vis a.
VarBndr IfaceBndr vis -> (CoreBndr -> vis -> IfL a) -> IfL a
bindIfaceForAllBndr IfaceForAllBndr
bndr ((CoreBndr -> ArgFlag -> IfL Type) -> IfL Type)
-> (CoreBndr -> ArgFlag -> IfL Type) -> IfL Type
forall a b. (a -> b) -> a -> b
$ \ CoreBndr
tv' ArgFlag
vis ->
TyCoVarBinder -> Type -> Type
ForAllTy (CoreBndr -> ArgFlag -> TyCoVarBinder
forall var argf. var -> argf -> VarBndr var argf
Bndr CoreBndr
tv' ArgFlag
vis) (Type -> Type) -> IfL Type -> IfL Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceType -> IfL Type
go IfaceType
t
go (IfaceCastTy IfaceType
ty IfaceCoercion
co) = Type -> Coercion -> Type
CastTy (Type -> Coercion -> Type)
-> IfL Type -> IOEnv (Env IfGblEnv IfLclEnv) (Coercion -> Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceType -> IfL Type
go IfaceType
ty IOEnv (Env IfGblEnv IfLclEnv) (Coercion -> Type)
-> IfL Coercion -> IfL Type
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IfaceCoercion -> IfL Coercion
tcIfaceCo IfaceCoercion
co
go (IfaceCoercionTy IfaceCoercion
co) = Coercion -> Type
CoercionTy (Coercion -> Type) -> IfL Coercion -> IfL Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceCoercion -> IfL Coercion
tcIfaceCo IfaceCoercion
co
tcIfaceTupleTy :: TupleSort -> PromotionFlag -> IfaceAppArgs -> IfL Type
tcIfaceTupleTy :: TupleSort -> PromotionFlag -> IfaceAppArgs -> IfL Type
tcIfaceTupleTy TupleSort
sort PromotionFlag
is_promoted IfaceAppArgs
args
= do { ThetaType
args' <- IfaceAppArgs -> IfL ThetaType
tcIfaceAppArgs IfaceAppArgs
args
; let arity :: Arity
arity = ThetaType -> 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
-> Type -> IfL Type
forall (m :: * -> *) a. Monad m => a -> m a
return (TyCon -> ThetaType -> Type
mkTyConApp TyCon
base_tc ThetaType
args')
PromotionFlag
IsPromoted
-> do { let tc :: TyCon
tc = DataCon -> TyCon
promoteDataCon (TyCon -> DataCon
tyConSingleDataCon TyCon
base_tc)
kind_args :: ThetaType
kind_args = (Type -> Type) -> ThetaType -> ThetaType
forall a b. (a -> b) -> [a] -> [b]
map HasDebugCallStack => Type -> Type
Type -> Type
typeKind ThetaType
args'
; Type -> IfL Type
forall (m :: * -> *) a. Monad m => a -> m a
return (TyCon -> ThetaType -> Type
mkTyConApp TyCon
tc (ThetaType
kind_args ThetaType -> ThetaType -> ThetaType
forall a. [a] -> [a] -> [a]
++ ThetaType
args')) } }
tcTupleTyCon :: Bool
-> TupleSort
-> 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 -> TyCon -> IOEnv (Env IfGblEnv IfLclEnv) TyCon
forall (m :: * -> *) a. Monad m => a -> m a
return (Arity -> TyCon
cTupleTyCon Arity
arity)
TupleSort
BoxedTuple -> TyCon -> IOEnv (Env IfGblEnv IfLclEnv) TyCon
forall (m :: * -> *) a. Monad m => a -> m a
return (Boxity -> Arity -> TyCon
tupleTyCon Boxity
Boxed Arity
arity)
TupleSort
UnboxedTuple -> TyCon -> IOEnv (Env IfGblEnv IfLclEnv) TyCon
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 Arity -> Arity -> Arity
forall a. Integral a => a -> a -> a
`div` Arity
2
| Bool
otherwise = Arity
arity
tcIfaceAppArgs :: IfaceAppArgs -> IfL [Type]
tcIfaceAppArgs :: IfaceAppArgs -> IfL ThetaType
tcIfaceAppArgs = (IfaceType -> IfL Type) -> IfaceContext -> IfL ThetaType
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceType -> IfL Type
tcIfaceType (IfaceContext -> IfL ThetaType)
-> (IfaceAppArgs -> IfaceContext) -> IfaceAppArgs -> IfL ThetaType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IfaceAppArgs -> IfaceContext
appArgsIfaceTypes
tcIfaceCtxt :: IfaceContext -> IfL ThetaType
tcIfaceCtxt :: IfaceContext -> IfL ThetaType
tcIfaceCtxt IfaceContext
sts = (IfaceType -> IfL Type) -> IfaceContext -> IfL ThetaType
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceType -> IfL Type
tcIfaceType IfaceContext
sts
tcIfaceTyLit :: IfaceTyLit -> IfL TyLit
tcIfaceTyLit :: IfaceTyLit -> IOEnv (Env IfGblEnv IfLclEnv) TyLit
tcIfaceTyLit (IfaceNumTyLit Integer
n) = TyLit -> IOEnv (Env IfGblEnv IfLclEnv) TyLit
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> TyLit
NumTyLit Integer
n)
tcIfaceTyLit (IfaceStrTyLit FastString
n) = TyLit -> IOEnv (Env IfGblEnv IfLclEnv) TyLit
forall (m :: * -> *) a. Monad m => a -> m a
return (FastString -> TyLit
StrTyLit FastString
n)
tcIfaceTyLit (IfaceCharTyLit Char
n) = TyLit -> IOEnv (Env IfGblEnv IfLclEnv) TyLit
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> TyLit
CharTyLit Char
n)
tcIfaceCo :: IfaceCoercion -> IfL Coercion
tcIfaceCo :: IfaceCoercion -> IfL Coercion
tcIfaceCo = IfaceCoercion -> IfL Coercion
go
where
go_mco :: IfaceMCoercion -> IOEnv (Env IfGblEnv IfLclEnv) MCoercion
go_mco IfaceMCoercion
IfaceMRefl = MCoercion -> IOEnv (Env IfGblEnv IfLclEnv) MCoercion
forall (f :: * -> *) a. Applicative f => a -> f a
pure MCoercion
MRefl
go_mco (IfaceMCo IfaceCoercion
co) = Coercion -> MCoercion
MCo (Coercion -> MCoercion)
-> IfL Coercion -> IOEnv (Env IfGblEnv IfLclEnv) MCoercion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IfaceCoercion -> IfL Coercion
go IfaceCoercion
co)
go :: IfaceCoercion -> IfL Coercion
go (IfaceReflCo IfaceType
t) = Type -> Coercion
Refl (Type -> Coercion) -> IfL Type -> IfL Coercion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceType -> IfL Type
tcIfaceType IfaceType
t
go (IfaceGReflCo Role
r IfaceType
t IfaceMCoercion
mco) = Role -> Type -> MCoercion -> Coercion
GRefl Role
r (Type -> MCoercion -> Coercion)
-> IfL Type
-> IOEnv (Env IfGblEnv IfLclEnv) (MCoercion -> Coercion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceType -> IfL Type
tcIfaceType IfaceType
t IOEnv (Env IfGblEnv IfLclEnv) (MCoercion -> Coercion)
-> IOEnv (Env IfGblEnv IfLclEnv) MCoercion -> IfL Coercion
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IfaceMCoercion -> IOEnv (Env IfGblEnv IfLclEnv) MCoercion
go_mco IfaceMCoercion
mco
go (IfaceFunCo Role
r IfaceCoercion
w IfaceCoercion
c1 IfaceCoercion
c2) = Role -> Coercion -> Coercion -> Coercion -> Coercion
mkFunCo Role
r (Coercion -> Coercion -> Coercion -> Coercion)
-> IfL Coercion
-> IOEnv (Env IfGblEnv IfLclEnv) (Coercion -> Coercion -> Coercion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceCoercion -> IfL Coercion
go IfaceCoercion
w IOEnv (Env IfGblEnv IfLclEnv) (Coercion -> Coercion -> Coercion)
-> IfL Coercion
-> IOEnv (Env IfGblEnv IfLclEnv) (Coercion -> Coercion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IfaceCoercion -> IfL Coercion
go IfaceCoercion
c1 IOEnv (Env IfGblEnv IfLclEnv) (Coercion -> Coercion)
-> IfL Coercion -> IfL Coercion
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IfaceCoercion -> IfL Coercion
go IfaceCoercion
c2
go (IfaceTyConAppCo Role
r IfaceTyCon
tc [IfaceCoercion]
cs)
= Role -> TyCon -> [Coercion] -> Coercion
TyConAppCo Role
r (TyCon -> [Coercion] -> Coercion)
-> IOEnv (Env IfGblEnv IfLclEnv) TyCon
-> IOEnv (Env IfGblEnv IfLclEnv) ([Coercion] -> Coercion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceTyCon -> IOEnv (Env IfGblEnv IfLclEnv) TyCon
tcIfaceTyCon IfaceTyCon
tc IOEnv (Env IfGblEnv IfLclEnv) ([Coercion] -> Coercion)
-> IOEnv (Env IfGblEnv IfLclEnv) [Coercion] -> IfL Coercion
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (IfaceCoercion -> IfL Coercion)
-> [IfaceCoercion] -> IOEnv (Env IfGblEnv IfLclEnv) [Coercion]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceCoercion -> IfL Coercion
go [IfaceCoercion]
cs
go (IfaceAppCo IfaceCoercion
c1 IfaceCoercion
c2) = Coercion -> Coercion -> Coercion
AppCo (Coercion -> Coercion -> Coercion)
-> IfL Coercion
-> IOEnv (Env IfGblEnv IfLclEnv) (Coercion -> Coercion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceCoercion -> IfL Coercion
go IfaceCoercion
c1 IOEnv (Env IfGblEnv IfLclEnv) (Coercion -> Coercion)
-> IfL Coercion -> IfL Coercion
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IfaceCoercion -> IfL Coercion
go IfaceCoercion
c2
go (IfaceForAllCo IfaceBndr
tv IfaceCoercion
k IfaceCoercion
c) = do { Coercion
k' <- IfaceCoercion -> IfL Coercion
go IfaceCoercion
k
; IfaceBndr -> (CoreBndr -> IfL Coercion) -> IfL Coercion
forall a. IfaceBndr -> (CoreBndr -> IfL a) -> IfL a
bindIfaceBndr IfaceBndr
tv ((CoreBndr -> IfL Coercion) -> IfL Coercion)
-> (CoreBndr -> IfL Coercion) -> IfL Coercion
forall a b. (a -> b) -> a -> b
$ \ CoreBndr
tv' ->
CoreBndr -> Coercion -> Coercion -> Coercion
ForAllCo CoreBndr
tv' Coercion
k' (Coercion -> Coercion) -> IfL Coercion -> IfL Coercion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceCoercion -> IfL Coercion
go IfaceCoercion
c }
go (IfaceCoVarCo FastString
n) = CoreBndr -> Coercion
CoVarCo (CoreBndr -> Coercion) -> IfL CoreBndr -> IfL Coercion
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 (CoAxiom Branched -> Arity -> [Coercion] -> Coercion)
-> IfL (CoAxiom Branched)
-> IOEnv (Env IfGblEnv IfLclEnv) (Arity -> [Coercion] -> Coercion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> IfL (CoAxiom Branched)
tcIfaceCoAxiom Name
n IOEnv (Env IfGblEnv IfLclEnv) (Arity -> [Coercion] -> Coercion)
-> IOEnv (Env IfGblEnv IfLclEnv) Arity
-> IOEnv (Env IfGblEnv IfLclEnv) ([Coercion] -> Coercion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Arity -> IOEnv (Env IfGblEnv IfLclEnv) Arity
forall (f :: * -> *) a. Applicative f => a -> f a
pure Arity
i IOEnv (Env IfGblEnv IfLclEnv) ([Coercion] -> Coercion)
-> IOEnv (Env IfGblEnv IfLclEnv) [Coercion] -> IfL Coercion
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (IfaceCoercion -> IfL Coercion)
-> [IfaceCoercion] -> IOEnv (Env IfGblEnv IfLclEnv) [Coercion]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceCoercion -> IfL Coercion
go [IfaceCoercion]
cs
go (IfaceUnivCo IfaceUnivCoProv
p Role
r IfaceType
t1 IfaceType
t2) = UnivCoProvenance -> Role -> Type -> Type -> Coercion
UnivCo (UnivCoProvenance -> Role -> Type -> Type -> Coercion)
-> IOEnv (Env IfGblEnv IfLclEnv) UnivCoProvenance
-> IOEnv (Env IfGblEnv IfLclEnv) (Role -> Type -> Type -> Coercion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceUnivCoProv -> IOEnv (Env IfGblEnv IfLclEnv) UnivCoProvenance
tcIfaceUnivCoProv IfaceUnivCoProv
p IOEnv (Env IfGblEnv IfLclEnv) (Role -> Type -> Type -> Coercion)
-> IOEnv (Env IfGblEnv IfLclEnv) Role
-> IOEnv (Env IfGblEnv IfLclEnv) (Type -> Type -> Coercion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Role -> IOEnv (Env IfGblEnv IfLclEnv) Role
forall (f :: * -> *) a. Applicative f => a -> f a
pure Role
r
IOEnv (Env IfGblEnv IfLclEnv) (Type -> Type -> Coercion)
-> IfL Type -> IOEnv (Env IfGblEnv IfLclEnv) (Type -> Coercion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IfaceType -> IfL Type
tcIfaceType IfaceType
t1 IOEnv (Env IfGblEnv IfLclEnv) (Type -> Coercion)
-> IfL Type -> IfL Coercion
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IfaceType -> IfL Type
tcIfaceType IfaceType
t2
go (IfaceSymCo IfaceCoercion
c) = Coercion -> Coercion
SymCo (Coercion -> Coercion) -> IfL Coercion -> IfL Coercion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceCoercion -> IfL Coercion
go IfaceCoercion
c
go (IfaceTransCo IfaceCoercion
c1 IfaceCoercion
c2) = Coercion -> Coercion -> Coercion
TransCo (Coercion -> Coercion -> Coercion)
-> IfL Coercion
-> IOEnv (Env IfGblEnv IfLclEnv) (Coercion -> Coercion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceCoercion -> IfL Coercion
go IfaceCoercion
c1
IOEnv (Env IfGblEnv IfLclEnv) (Coercion -> Coercion)
-> IfL Coercion -> IfL Coercion
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IfaceCoercion -> IfL Coercion
go IfaceCoercion
c2
go (IfaceInstCo IfaceCoercion
c1 IfaceCoercion
t2) = Coercion -> Coercion -> Coercion
InstCo (Coercion -> Coercion -> Coercion)
-> IfL Coercion
-> IOEnv (Env IfGblEnv IfLclEnv) (Coercion -> Coercion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceCoercion -> IfL Coercion
go IfaceCoercion
c1
IOEnv (Env IfGblEnv IfLclEnv) (Coercion -> Coercion)
-> IfL Coercion -> IfL Coercion
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IfaceCoercion -> IfL Coercion
go IfaceCoercion
t2
go (IfaceNthCo Arity
d IfaceCoercion
c) = do { Coercion
c' <- IfaceCoercion -> IfL Coercion
go IfaceCoercion
c
; Coercion -> IfL Coercion
forall (m :: * -> *) a. Monad m => a -> m a
return (Coercion -> IfL Coercion) -> Coercion -> IfL Coercion
forall a b. (a -> b) -> a -> b
$ HasDebugCallStack => Role -> Arity -> Coercion -> Coercion
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 (Coercion -> Coercion) -> IfL Coercion -> IfL Coercion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceCoercion -> IfL Coercion
go IfaceCoercion
c
go (IfaceKindCo IfaceCoercion
c) = Coercion -> Coercion
KindCo (Coercion -> Coercion) -> IfL Coercion -> IfL Coercion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceCoercion -> IfL Coercion
go IfaceCoercion
c
go (IfaceSubCo IfaceCoercion
c) = Coercion -> Coercion
SubCo (Coercion -> Coercion) -> IfL Coercion -> IfL Coercion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceCoercion -> IfL Coercion
go IfaceCoercion
c
go (IfaceAxiomRuleCo FastString
ax [IfaceCoercion]
cos) = CoAxiomRule -> [Coercion] -> Coercion
AxiomRuleCo (CoAxiomRule -> [Coercion] -> Coercion)
-> IOEnv (Env IfGblEnv IfLclEnv) CoAxiomRule
-> IOEnv (Env IfGblEnv IfLclEnv) ([Coercion] -> Coercion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FastString -> IOEnv (Env IfGblEnv IfLclEnv) CoAxiomRule
tcIfaceCoAxiomRule FastString
ax
IOEnv (Env IfGblEnv IfLclEnv) ([Coercion] -> Coercion)
-> IOEnv (Env IfGblEnv IfLclEnv) [Coercion] -> IfL Coercion
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (IfaceCoercion -> IfL Coercion)
-> [IfaceCoercion] -> IOEnv (Env IfGblEnv IfLclEnv) [Coercion]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceCoercion -> IfL Coercion
go [IfaceCoercion]
cos
go (IfaceFreeCoVar CoreBndr
c) = String -> SDoc -> IfL Coercion
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tcIfaceCo:IfaceFreeCoVar" (CoreBndr -> SDoc
forall a. Outputable a => a -> SDoc
ppr CoreBndr
c)
go (IfaceHoleCo CoreBndr
c) = String -> SDoc -> IfL Coercion
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tcIfaceCo:IfaceHoleCo" (CoreBndr -> SDoc
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 -> IOEnv (Env IfGblEnv IfLclEnv) UnivCoProvenance
tcIfaceUnivCoProv (IfacePhantomProv IfaceCoercion
kco) = Coercion -> UnivCoProvenance
PhantomProv (Coercion -> UnivCoProvenance)
-> IfL Coercion -> IOEnv (Env IfGblEnv IfLclEnv) UnivCoProvenance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceCoercion -> IfL Coercion
tcIfaceCo IfaceCoercion
kco
tcIfaceUnivCoProv (IfaceProofIrrelProv IfaceCoercion
kco) = Coercion -> UnivCoProvenance
ProofIrrelProv (Coercion -> UnivCoProvenance)
-> IfL Coercion -> IOEnv (Env IfGblEnv IfLclEnv) UnivCoProvenance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceCoercion -> IfL Coercion
tcIfaceCo IfaceCoercion
kco
tcIfaceUnivCoProv (IfacePluginProv String
str) = UnivCoProvenance -> IOEnv (Env IfGblEnv IfLclEnv) UnivCoProvenance
forall (m :: * -> *) a. Monad m => a -> m a
return (UnivCoProvenance
-> IOEnv (Env IfGblEnv IfLclEnv) UnivCoProvenance)
-> UnivCoProvenance
-> IOEnv (Env IfGblEnv IfLclEnv) UnivCoProvenance
forall a b. (a -> b) -> a -> b
$ String -> UnivCoProvenance
PluginProv String
str
tcIfaceExpr :: IfaceExpr -> IfL CoreExpr
tcIfaceExpr :: IfaceExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
tcIfaceExpr (IfaceType IfaceType
ty)
= Type -> CoreExpr
forall b. Type -> Expr b
Type (Type -> CoreExpr)
-> IfL Type -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceType -> IfL Type
tcIfaceType IfaceType
ty
tcIfaceExpr (IfaceCo IfaceCoercion
co)
= Coercion -> CoreExpr
forall b. Coercion -> Expr b
Coercion (Coercion -> CoreExpr)
-> IfL Coercion -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceCoercion -> IfL Coercion
tcIfaceCo IfaceCoercion
co
tcIfaceExpr (IfaceCast IfaceExpr
expr IfaceCoercion
co)
= CoreExpr -> Coercion -> CoreExpr
forall b. Expr b -> Coercion -> Expr b
Cast (CoreExpr -> Coercion -> CoreExpr)
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
-> IOEnv (Env IfGblEnv IfLclEnv) (Coercion -> CoreExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
tcIfaceExpr IfaceExpr
expr IOEnv (Env IfGblEnv IfLclEnv) (Coercion -> CoreExpr)
-> IfL Coercion -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IfaceCoercion -> IfL Coercion
tcIfaceCo IfaceCoercion
co
tcIfaceExpr (IfaceLcl FastString
name)
= CoreBndr -> CoreExpr
forall b. CoreBndr -> Expr b
Var (CoreBndr -> CoreExpr)
-> IfL CoreBndr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FastString -> IfL CoreBndr
tcIfaceLclId FastString
name
tcIfaceExpr (IfaceExt Name
gbl)
= CoreBndr -> CoreExpr
forall b. CoreBndr -> Expr b
Var (CoreBndr -> CoreExpr)
-> IfL CoreBndr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> IfL CoreBndr
tcIfaceExtId Name
gbl
tcIfaceExpr (IfaceLit Literal
lit)
= do Literal
lit' <- Literal -> IfL Literal
tcIfaceLit Literal
lit
CoreExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
lit')
tcIfaceExpr (IfaceFCall ForeignCall
cc IfaceType
ty) = do
Type
ty' <- IfaceType -> IfL Type
tcIfaceType IfaceType
ty
Unique
u <- TcRnIf IfGblEnv IfLclEnv Unique
forall gbl lcl. TcRnIf gbl lcl Unique
newUnique
DynFlags
dflags <- IOEnv (Env IfGblEnv IfLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
CoreExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (CoreBndr -> CoreExpr
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' <- (IfaceExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr)
-> [IfaceExpr] -> IOEnv (Env IfGblEnv IfLclEnv) [CoreExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
tcIfaceExpr [IfaceExpr]
args
; TyCon
tc <- Bool -> TupleSort -> Arity -> IOEnv (Env IfGblEnv IfLclEnv) TyCon
tcTupleTyCon Bool
False TupleSort
sort Arity
arity
; let con_tys :: ThetaType
con_tys = (CoreExpr -> Type) -> [CoreExpr] -> ThetaType
forall a b. (a -> b) -> [a] -> [b]
map CoreExpr -> Type
exprType [CoreExpr]
args'
some_con_args :: [CoreExpr]
some_con_args = (Type -> CoreExpr) -> ThetaType -> [CoreExpr]
forall a b. (a -> b) -> [a] -> [b]
map Type -> CoreExpr
forall b. Type -> Expr b
Type ThetaType
con_tys [CoreExpr] -> [CoreExpr] -> [CoreExpr]
forall a. [a] -> [a] -> [a]
++ [CoreExpr]
args'
con_args :: [CoreExpr]
con_args = case TupleSort
sort of
TupleSort
UnboxedTuple -> (Type -> CoreExpr) -> ThetaType -> [CoreExpr]
forall a b. (a -> b) -> [a] -> [b]
map (Type -> CoreExpr
forall b. Type -> Expr b
Type (Type -> CoreExpr) -> (Type -> Type) -> Type -> CoreExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasDebugCallStack => Type -> Type
Type -> Type
getRuntimeRep) ThetaType
con_tys [CoreExpr] -> [CoreExpr] -> [CoreExpr]
forall a. [a] -> [a] -> [a]
++ [CoreExpr]
some_con_args
TupleSort
_ -> [CoreExpr]
some_con_args
con_id :: CoreBndr
con_id = DataCon -> CoreBndr
dataConWorkId (TyCon -> DataCon
tyConSingleDataCon TyCon
tc)
; CoreExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (CoreExpr -> [CoreExpr] -> CoreExpr
forall b. Expr b -> [Expr b] -> Expr b
mkApps (CoreBndr -> CoreExpr
forall b. CoreBndr -> Expr b
Var CoreBndr
con_id) [CoreExpr]
con_args) }
where
arity :: Arity
arity = [IfaceExpr] -> Arity
forall (t :: * -> *) a. Foldable t => t a -> Arity
length [IfaceExpr]
args
tcIfaceExpr (IfaceLam (IfaceBndr
bndr, IfaceOneShot
os) IfaceExpr
body)
= IfaceBndr
-> (CoreBndr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr)
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall a. IfaceBndr -> (CoreBndr -> IfL a) -> IfL a
bindIfaceBndr IfaceBndr
bndr ((CoreBndr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr)
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr)
-> (CoreBndr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr)
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall a b. (a -> b) -> a -> b
$ \CoreBndr
bndr' ->
CoreBndr -> CoreExpr -> CoreExpr
forall b. b -> Expr b -> Expr b
Lam (IfaceOneShot -> CoreBndr -> CoreBndr
tcIfaceOneShot IfaceOneShot
os CoreBndr
bndr') (CoreExpr -> CoreExpr)
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
tcIfaceExpr IfaceExpr
body
where
tcIfaceOneShot :: IfaceOneShot -> CoreBndr -> CoreBndr
tcIfaceOneShot IfaceOneShot
IfaceOneShot CoreBndr
b = CoreBndr -> CoreBndr
setOneShotLambda CoreBndr
b
tcIfaceOneShot IfaceOneShot
_ CoreBndr
b = CoreBndr
b
tcIfaceExpr (IfaceApp IfaceExpr
fun IfaceExpr
arg)
= CoreExpr -> CoreExpr -> CoreExpr
forall b. Expr b -> Expr b -> Expr b
App (CoreExpr -> CoreExpr -> CoreExpr)
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
-> IOEnv (Env IfGblEnv IfLclEnv) (CoreExpr -> CoreExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IfaceExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
tcIfaceExpr IfaceExpr
fun IOEnv (Env IfGblEnv IfLclEnv) (CoreExpr -> CoreExpr)
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IfaceExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
tcIfaceExpr IfaceExpr
arg
tcIfaceExpr (IfaceECase IfaceExpr
scrut IfaceType
ty)
= do { CoreExpr
scrut' <- IfaceExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
tcIfaceExpr IfaceExpr
scrut
; Type
ty' <- IfaceType -> IfL Type
tcIfaceType IfaceType
ty
; CoreExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (CoreExpr -> Type -> CoreExpr
castBottomExpr CoreExpr
scrut' Type
ty') }
tcIfaceExpr (IfaceCase IfaceExpr
scrut FastString
case_bndr [IfaceAlt]
alts) = do
CoreExpr
scrut' <- IfaceExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
tcIfaceExpr IfaceExpr
scrut
Name
case_bndr_name <- OccName -> TcRnIf IfGblEnv IfLclEnv Name
newIfaceName (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
tc_app :: (TyCon, ThetaType)
tc_app = Type -> (TyCon, ThetaType)
splitTyConApp Type
scrut_ty
[CoreBndr]
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall a. [CoreBndr] -> IfL a -> IfL a
extendIfaceIdEnv [CoreBndr
case_bndr'] (IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr)
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall a b. (a -> b) -> a -> b
$ do
[CoreAlt]
alts' <- (IfaceAlt -> IOEnv (Env IfGblEnv IfLclEnv) CoreAlt)
-> [IfaceAlt] -> IOEnv (Env IfGblEnv IfLclEnv) [CoreAlt]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (CoreExpr
-> Type
-> (TyCon, ThetaType)
-> IfaceAlt
-> IOEnv (Env IfGblEnv IfLclEnv) CoreAlt
tcIfaceAlt CoreExpr
scrut' Type
case_mult (TyCon, ThetaType)
tc_app) [IfaceAlt]
alts
CoreExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (CoreExpr -> CoreBndr -> Type -> [CoreAlt] -> CoreExpr
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 -> TcRnIf 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
TopLevelFlag
NotTopLevel Name
name Type
ty' IfaceIdInfo
info
; let id :: CoreBndr
id = HasDebugCallStack => Name -> Type -> Type -> IdInfo -> CoreBndr
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 -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
tcIfaceExpr IfaceExpr
rhs
; CoreExpr
body' <- [CoreBndr]
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall a. [CoreBndr] -> IfL a -> IfL a
extendIfaceIdEnv [CoreBndr
id] (IfaceExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
tcIfaceExpr IfaceExpr
body)
; CoreExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (Bind CoreBndr -> CoreExpr -> CoreExpr
forall b. Bind b -> Expr b -> Expr b
Let (CoreBndr -> CoreExpr -> Bind CoreBndr
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 <- (IfaceLetBndr -> IfL CoreBndr)
-> [IfaceLetBndr] -> IOEnv (Env IfGblEnv IfLclEnv) [CoreBndr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceLetBndr -> IfL CoreBndr
tc_rec_bndr (((IfaceLetBndr, IfaceExpr) -> IfaceLetBndr)
-> [(IfaceLetBndr, IfaceExpr)] -> [IfaceLetBndr]
forall a b. (a -> b) -> [a] -> [b]
map (IfaceLetBndr, IfaceExpr) -> IfaceLetBndr
forall a b. (a, b) -> a
fst [(IfaceLetBndr, IfaceExpr)]
pairs)
; [CoreBndr]
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall a. [CoreBndr] -> IfL a -> IfL a
extendIfaceIdEnv [CoreBndr]
ids (IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr)
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall a b. (a -> b) -> a -> b
$ do
{ [(CoreBndr, CoreExpr)]
pairs' <- ((IfaceLetBndr, IfaceExpr)
-> CoreBndr -> IOEnv (Env IfGblEnv IfLclEnv) (CoreBndr, CoreExpr))
-> [(IfaceLetBndr, IfaceExpr)]
-> [CoreBndr]
-> IOEnv (Env IfGblEnv IfLclEnv) [(CoreBndr, CoreExpr)]
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 -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
tcIfaceExpr IfaceExpr
body
; CoreExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (Bind CoreBndr -> CoreExpr -> CoreExpr
forall b. Bind b -> Expr b -> Expr b
Let ([(CoreBndr, CoreExpr)] -> Bind CoreBndr
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 -> TcRnIf IfGblEnv IfLclEnv Name
newIfaceName (FastString -> OccName
mkVarOccFS FastString
fs)
; Type
ty' <- IfaceType -> IfL Type
tcIfaceType IfaceType
ty
; CoreBndr -> IfL CoreBndr
forall (m :: * -> *) a. Monad m => a -> m a
return (HasDebugCallStack => Name -> Type -> Type -> CoreBndr
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 -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
tcIfaceExpr IfaceExpr
rhs
; IdInfo
id_info <- Bool -> TopLevelFlag -> Name -> Type -> IfaceIdInfo -> IfL IdInfo
tcIdInfo Bool
False
TopLevelFlag
NotTopLevel (CoreBndr -> Name
idName CoreBndr
id) (CoreBndr -> Type
idType CoreBndr
id) IfaceIdInfo
info
; (CoreBndr, CoreExpr)
-> IOEnv (Env IfGblEnv IfLclEnv) (CoreBndr, CoreExpr)
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 -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
tcIfaceExpr IfaceExpr
expr
Arity
dbgLvl <- (DynFlags -> Arity)
-> IOEnv (Env IfGblEnv IfLclEnv) DynFlags
-> IOEnv (Env IfGblEnv IfLclEnv) Arity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DynFlags -> Arity
debugLevel IOEnv (Env IfGblEnv IfLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
case IfaceTickish
tickish of
IfaceSource{} | Arity
dbgLvl Arity -> Arity -> Bool
forall a. Eq a => a -> a -> Bool
== Arity
0
-> CoreExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
return CoreExpr
expr'
IfaceTickish
_otherwise -> do
CoreTickish
tickish' <- IfaceTickish -> IfM IfLclEnv CoreTickish
forall lcl. IfaceTickish -> IfM lcl CoreTickish
tcIfaceTickish IfaceTickish
tickish
CoreExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (CoreTickish -> CoreExpr -> CoreExpr
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) = CoreTickish -> IOEnv (Env IfGblEnv lcl) CoreTickish
forall (m :: * -> *) a. Monad m => a -> m a
return (Module -> Arity -> CoreTickish
forall (pass :: TickishPass). Module -> Arity -> GenTickish pass
HpcTick Module
modl Arity
ix)
tcIfaceTickish (IfaceSCC CostCentre
cc Bool
tick Bool
push) = CoreTickish -> IOEnv (Env IfGblEnv lcl) CoreTickish
forall (m :: * -> *) a. Monad m => a -> m a
return (CostCentre -> Bool -> Bool -> CoreTickish
forall (pass :: TickishPass).
CostCentre -> Bool -> Bool -> GenTickish pass
ProfNote CostCentre
cc Bool
tick Bool
push)
tcIfaceTickish (IfaceSource RealSrcSpan
src String
name) = CoreTickish -> IOEnv (Env IfGblEnv lcl) CoreTickish
forall (m :: * -> *) a. Monad m => a -> m a
return (RealSrcSpan -> String -> CoreTickish
forall (pass :: TickishPass).
RealSrcSpan -> String -> GenTickish pass
SourceNote RealSrcSpan
src String
name)
tcIfaceLit :: Literal -> IfL Literal
tcIfaceLit :: Literal -> IfL Literal
tcIfaceLit Literal
lit = Literal -> IfL Literal
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
-> IOEnv (Env IfGblEnv IfLclEnv) 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')
tcIfaceAlt CoreExpr
scrut Type
mult (TyCon
tycon, ThetaType
inst_tys) (IfaceAlt (IfaceDataAlt Name
data_occ) [FastString]
arg_strs IfaceExpr
rhs)
= do { DataCon
con <- Name -> IOEnv (Env IfGblEnv IfLclEnv) DataCon
tcIfaceDataCon Name
data_occ
; Bool -> TcRnIf IfGblEnv IfLclEnv () -> TcRnIf IfGblEnv IfLclEnv ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
debugIsOn Bool -> Bool -> Bool
&& Bool -> Bool
not (DataCon
con DataCon -> [DataCon] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` TyCon -> [DataCon]
tyConDataCons TyCon
tycon))
(SDoc -> TcRnIf IfGblEnv IfLclEnv ()
forall a. SDoc -> IfL a
failIfM (CoreExpr -> SDoc
forall a. Outputable a => a -> SDoc
ppr CoreExpr
scrut SDoc -> SDoc -> SDoc
$$ DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
con SDoc -> SDoc -> SDoc
$$ TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tycon SDoc -> SDoc -> SDoc
$$ [DataCon] -> SDoc
forall a. Outputable a => a -> SDoc
ppr (TyCon -> [DataCon]
tyConDataCons TyCon
tycon)))
; Type
-> DataCon
-> ThetaType
-> [FastString]
-> IfaceExpr
-> IOEnv (Env IfGblEnv IfLclEnv) 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
-> IOEnv (Env IfGblEnv IfLclEnv) CoreAlt
tcIfaceDataAlt Type
mult DataCon
con ThetaType
inst_tys [FastString]
arg_strs IfaceExpr
rhs
= do { UniqSupply
us <- TcRnIf IfGblEnv IfLclEnv UniqSupply
forall gbl lcl. TcRnIf gbl lcl UniqSupply
newUniqueSupply
; let uniqs :: [Unique]
uniqs = UniqSupply -> [Unique]
uniqsFromSupply UniqSupply
us
; let ([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' <- [CoreBndr]
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall a. [CoreBndr] -> IfL a -> IfL a
extendIfaceEnvs [CoreBndr]
ex_tvs (IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr)
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall a b. (a -> b) -> a -> b
$
[CoreBndr]
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall a. [CoreBndr] -> IfL a -> IfL a
extendIfaceIdEnv [CoreBndr]
arg_ids (IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr)
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
forall a b. (a -> b) -> a -> b
$
IfaceExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
tcIfaceExpr IfaceExpr
rhs
; CoreAlt -> IOEnv (Env IfGblEnv IfLclEnv) CoreAlt
forall (m :: * -> *) a. Monad m => a -> m a
return (AltCon -> [CoreBndr] -> CoreExpr -> CoreAlt
forall b. AltCon -> [b] -> Expr b -> Alt b
Alt (DataCon -> AltCon
DataAlt DataCon
con) ([CoreBndr]
ex_tvs [CoreBndr] -> [CoreBndr] -> [CoreBndr]
forall a. [a] -> [a] -> [a]
++ [CoreBndr]
arg_ids) CoreExpr
rhs') }
tcIdDetails :: Type -> IfaceIdDetails -> IfL IdDetails
tcIdDetails :: Type -> IfaceIdDetails -> IfL IdDetails
tcIdDetails Type
_ IfaceIdDetails
IfVanillaId = IdDetails -> IfL IdDetails
forall (m :: * -> *) a. Monad m => a -> m a
return IdDetails
VanillaId
tcIdDetails Type
ty IfaceIdDetails
IfDFunId
= IdDetails -> IfL IdDetails
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IdDetails
DFunId (TyCon -> Bool
isNewTyCon (Class -> TyCon
classTyCon Class
cls)))
where
([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' <- (IfaceTyCon -> IOEnv (Env IfGblEnv IfLclEnv) RecSelParent)
-> (IfaceDecl -> IOEnv (Env IfGblEnv IfLclEnv) RecSelParent)
-> Either IfaceTyCon IfaceDecl
-> IOEnv (Env IfGblEnv IfLclEnv) RecSelParent
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((TyCon -> RecSelParent)
-> IOEnv (Env IfGblEnv IfLclEnv) TyCon
-> IOEnv (Env IfGblEnv IfLclEnv) RecSelParent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TyCon -> RecSelParent
RecSelData (IOEnv (Env IfGblEnv IfLclEnv) TyCon
-> IOEnv (Env IfGblEnv IfLclEnv) RecSelParent)
-> (IfaceTyCon -> IOEnv (Env IfGblEnv IfLclEnv) TyCon)
-> IfaceTyCon
-> IOEnv (Env IfGblEnv IfLclEnv) RecSelParent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IfaceTyCon -> IOEnv (Env IfGblEnv IfLclEnv) TyCon
tcIfaceTyCon)
((TyThing -> RecSelParent)
-> IfL TyThing -> IOEnv (Env IfGblEnv IfLclEnv) RecSelParent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PatSyn -> RecSelParent
RecSelPatSyn (PatSyn -> RecSelParent)
-> (TyThing -> PatSyn) -> TyThing -> RecSelParent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyThing -> PatSyn
tyThingPatSyn) (IfL TyThing -> IOEnv (Env IfGblEnv IfLclEnv) RecSelParent)
-> (IfaceDecl -> IfL TyThing)
-> IfaceDecl
-> IOEnv (Env IfGblEnv IfLclEnv) RecSelParent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> IfaceDecl -> IfL TyThing
tcIfaceDecl Bool
False)
Either IfaceTyCon IfaceDecl
tc
; IdDetails -> IfL IdDetails
forall (m :: * -> *) a. Monad m => a -> m a
return (RecSelId { sel_tycon :: RecSelParent
sel_tycon = RecSelParent
tc', sel_naughty :: Bool
sel_naughty = Bool
naughty }) }
where
tyThingPatSyn :: TyThing -> PatSyn
tyThingPatSyn (AConLike (PatSynCon PatSyn
ps)) = PatSyn
ps
tyThingPatSyn TyThing
_ = String -> PatSyn
forall a. String -> a
panic String
"tcIdDetails: expecting patsyn"
tcIdInfo :: Bool -> TopLevelFlag -> Name -> Type -> IfaceIdInfo -> IfL IdInfo
tcIdInfo :: Bool -> TopLevelFlag -> Name -> Type -> IfaceIdInfo -> IfL IdInfo
tcIdInfo Bool
ignore_prags TopLevelFlag
toplvl Name
name Type
ty IfaceIdInfo
info = do
IfLclEnv
lcl_env <- TcRnIf IfGblEnv IfLclEnv IfLclEnv
forall gbl lcl. TcRnIf gbl lcl lcl
getLclEnv
let init_info :: IdInfo
init_info = if IfLclEnv -> IsBootInterface
if_boot IfLclEnv
lcl_env IsBootInterface -> IsBootInterface -> Bool
forall a. Eq a => a -> a -> Bool
== IsBootInterface
IsBoot
then IdInfo
vanillaIdInfo IdInfo -> Unfolding -> IdInfo
`setUnfoldingInfo` Unfolding
BootUnfolding
else IdInfo
vanillaIdInfo
(IdInfo -> IfaceInfoItem -> IfL IdInfo)
-> IdInfo -> IfaceIdInfo -> IfL IdInfo
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM IdInfo -> IfaceInfoItem -> IfL IdInfo
tcPrag IdInfo
init_info (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 = (IfaceInfoItem -> Bool) -> IfaceIdInfo -> IfaceIdInfo
forall a. (a -> Bool) -> [a] -> [a]
filter IfaceInfoItem -> Bool
need_prag IfaceIdInfo
items
need_prag :: IfaceInfoItem -> Bool
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 = IdInfo -> IfL IdInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (IdInfo
info IdInfo -> CafInfo -> IdInfo
`setCafInfo` CafInfo
NoCafRefs)
tcPrag IdInfo
info (HsArity Arity
arity) = IdInfo -> IfL IdInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (IdInfo
info IdInfo -> Arity -> IdInfo
`setArityInfo` Arity
arity)
tcPrag IdInfo
info (HsStrictness StrictSig
str) = IdInfo -> IfL IdInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (IdInfo
info IdInfo -> StrictSig -> IdInfo
`setStrictnessInfo` StrictSig
str)
tcPrag IdInfo
info (HsCpr CprSig
cpr) = IdInfo -> IfL IdInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (IdInfo
info IdInfo -> CprSig -> IdInfo
`setCprInfo` CprSig
cpr)
tcPrag IdInfo
info (HsInline InlinePragma
prag) = IdInfo -> IfL IdInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (IdInfo
info IdInfo -> InlinePragma -> IdInfo
`setInlinePragInfo` InlinePragma
prag)
tcPrag IdInfo
info IfaceInfoItem
HsLevity = IdInfo -> IfL IdInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (IdInfo
info HasDebugCallStack => IdInfo -> Type -> IdInfo
IdInfo -> Type -> IdInfo
`setNeverLevPoly` Type
ty)
tcPrag IdInfo
info (HsLFInfo IfaceLFInfo
lf_info) = do
LambdaFormInfo
lf_info <- IfaceLFInfo -> IfL LambdaFormInfo
tcLFInfo IfaceLFInfo
lf_info
IdInfo -> IfL IdInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (IdInfo
info IdInfo -> LambdaFormInfo -> IdInfo
`setLFInfo` LambdaFormInfo
lf_info)
tcPrag IdInfo
info (HsUnfold Bool
lb IfaceUnfolding
if_unf)
= do { Unfolding
unf <- TopLevelFlag
-> Name -> Type -> IdInfo -> IfaceUnfolding -> IfL Unfolding
tcUnfolding TopLevelFlag
toplvl Name
name Type
ty IdInfo
info IfaceUnfolding
if_unf
; let info1 :: IdInfo
info1 | Bool
lb = IdInfo
info IdInfo -> OccInfo -> IdInfo
`setOccInfo` OccInfo
strongLoopBreaker
| Bool
otherwise = IdInfo
info
; IdInfo -> IfL IdInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (IdInfo
info1 IdInfo -> Unfolding -> IdInfo
`setUnfoldingInfo` Unfolding
unf) }
tcJoinInfo :: IfaceJoinInfo -> Maybe JoinArity
tcJoinInfo :: IfaceJoinInfo -> Maybe Arity
tcJoinInfo (IfaceJoinPoint Arity
ar) = Arity -> Maybe Arity
forall a. a -> Maybe a
Just Arity
ar
tcJoinInfo IfaceJoinInfo
IfaceNotJoinPoint = Maybe Arity
forall a. Maybe a
Nothing
tcLFInfo :: IfaceLFInfo -> IfL LambdaFormInfo
tcLFInfo :: IfaceLFInfo -> IfL LambdaFormInfo
tcLFInfo IfaceLFInfo
lfi = case IfaceLFInfo
lfi of
IfLFReEntrant Arity
rep_arity ->
LambdaFormInfo -> IfL LambdaFormInfo
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 ->
LambdaFormInfo -> IfL LambdaFormInfo
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 ->
LambdaFormInfo -> IfL LambdaFormInfo
forall (m :: * -> *) a. Monad m => a -> m a
return LambdaFormInfo
LFUnlifted
IfLFCon Name
con_name ->
DataCon -> LambdaFormInfo
LFCon (DataCon -> LambdaFormInfo)
-> IOEnv (Env IfGblEnv IfLclEnv) DataCon -> IfL LambdaFormInfo
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Name -> IOEnv (Env IfGblEnv IfLclEnv) DataCon
tcIfaceDataCon Name
con_name
IfLFUnknown Bool
fun_flag ->
LambdaFormInfo -> IfL LambdaFormInfo
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 (DynFlags -> UnfoldingOpts)
-> IOEnv (Env IfGblEnv IfLclEnv) DynFlags
-> IOEnv (Env IfGblEnv IfLclEnv) UnfoldingOpts
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOEnv (Env IfGblEnv IfLclEnv) DynFlags
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
; Unfolding -> IfL Unfolding
forall (m :: * -> *) a. Monad m => a -> m a
return (Unfolding -> IfL Unfolding) -> Unfolding -> IfL Unfolding
forall a b. (a -> b) -> a -> b
$ case Maybe CoreExpr
mb_expr of
Maybe CoreExpr
Nothing -> Unfolding
NoUnfolding
Just CoreExpr
expr -> UnfoldingOpts
-> UnfoldingSource -> StrictSig -> CoreExpr -> Unfolding
mkFinalUnfolding UnfoldingOpts
uf_opts UnfoldingSource
unf_src StrictSig
strict_sig CoreExpr
expr
}
where
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
; Unfolding -> IfL Unfolding
forall (m :: * -> *) a. Monad m => a -> m a
return (case Maybe CoreExpr
mb_expr of
Maybe CoreExpr
Nothing -> Unfolding
NoUnfolding
Just CoreExpr
expr -> CoreExpr -> Unfolding
mkCompulsoryUnfolding' CoreExpr
expr) }
tcUnfolding TopLevelFlag
toplvl Name
name Type
_ IdInfo
_ (IfInlineRule 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
; Unfolding -> IfL Unfolding
forall (m :: * -> *) a. Monad m => a -> m a
return (case Maybe CoreExpr
mb_expr of
Maybe CoreExpr
Nothing -> Unfolding
NoUnfolding
Just CoreExpr
expr -> UnfoldingSource
-> Bool -> CoreExpr -> UnfoldingGuidance -> Unfolding
mkCoreUnfolding UnfoldingSource
InlineStable Bool
True CoreExpr
expr UnfoldingGuidance
guidance )}
where
guidance :: UnfoldingGuidance
guidance = UnfWhen { 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)
= [IfaceBndr] -> ([CoreBndr] -> IfL Unfolding) -> IfL Unfolding
forall a. [IfaceBndr] -> ([CoreBndr] -> IfL a) -> IfL a
bindIfaceBndrs [IfaceBndr]
bs (([CoreBndr] -> IfL Unfolding) -> IfL Unfolding)
-> ([CoreBndr] -> IfL Unfolding) -> IfL Unfolding
forall a b. (a -> b) -> a -> b
$ \ [CoreBndr]
bs' ->
do { Maybe [CoreExpr]
mb_ops1 <- SDoc
-> IOEnv (Env IfGblEnv IfLclEnv) [CoreExpr]
-> IfL (Maybe [CoreExpr])
forall a. SDoc -> IfL a -> IfL (Maybe a)
forkM_maybe SDoc
doc (IOEnv (Env IfGblEnv IfLclEnv) [CoreExpr]
-> IfL (Maybe [CoreExpr]))
-> IOEnv (Env IfGblEnv IfLclEnv) [CoreExpr]
-> IfL (Maybe [CoreExpr])
forall a b. (a -> b) -> a -> b
$ (IfaceExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr)
-> [IfaceExpr] -> IOEnv (Env IfGblEnv IfLclEnv) [CoreExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IfaceExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
tcIfaceExpr [IfaceExpr]
ops
; Unfolding -> IfL Unfolding
forall (m :: * -> *) a. Monad m => a -> m a
return (case Maybe [CoreExpr]
mb_ops1 of
Maybe [CoreExpr]
Nothing -> Unfolding
noUnfolding
Just [CoreExpr]
ops1 -> [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
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name
([CoreBndr]
_, ThetaType
_, Class
cls, ThetaType
_) = Type -> ([CoreBndr], ThetaType, Class, ThetaType)
tcSplitDFunTy Type
dfun_ty
tcPragExpr :: Bool
-> TopLevelFlag -> Name -> IfaceExpr -> IfL (Maybe CoreExpr)
tcPragExpr :: Bool -> TopLevelFlag -> Name -> IfaceExpr -> IfL (Maybe CoreExpr)
tcPragExpr Bool
is_compulsory TopLevelFlag
toplvl Name
name IfaceExpr
expr
= SDoc
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr -> IfL (Maybe CoreExpr)
forall a. SDoc -> IfL a -> IfL (Maybe a)
forkM_maybe SDoc
doc (IOEnv (Env IfGblEnv IfLclEnv) CoreExpr -> IfL (Maybe CoreExpr))
-> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr -> IfL (Maybe CoreExpr)
forall a b. (a -> b) -> a -> b
$ do
CoreExpr
core_expr' <- IfaceExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
tcIfaceExpr IfaceExpr
expr
Bool -> TcRnIf IfGblEnv IfLclEnv () -> TcRnIf IfGblEnv IfLclEnv ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TopLevelFlag -> Bool
isTopLevel TopLevelFlag
toplvl) (TcRnIf IfGblEnv IfLclEnv () -> TcRnIf IfGblEnv IfLclEnv ())
-> TcRnIf IfGblEnv IfLclEnv () -> TcRnIf IfGblEnv IfLclEnv ()
forall a b. (a -> b) -> a -> b
$
GeneralFlag
-> TcRnIf IfGblEnv IfLclEnv () -> TcRnIf IfGblEnv IfLclEnv ()
forall gbl lcl.
GeneralFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
whenGOptM GeneralFlag
Opt_DoCoreLinting (TcRnIf IfGblEnv IfLclEnv () -> TcRnIf IfGblEnv IfLclEnv ())
-> TcRnIf IfGblEnv IfLclEnv () -> TcRnIf IfGblEnv IfLclEnv ()
forall a b. (a -> b) -> a -> b
$ do
VarSet
in_scope <- IfL VarSet
get_in_scope
DynFlags
dflags <- IOEnv (Env IfGblEnv IfLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
Logger
logger <- IOEnv (Env IfGblEnv IfLclEnv) 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 -> () -> TcRnIf IfGblEnv IfLclEnv ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just Bag SDoc
errs -> IO () -> TcRnIf IfGblEnv IfLclEnv ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> TcRnIf IfGblEnv IfLclEnv ())
-> IO () -> TcRnIf IfGblEnv IfLclEnv ()
forall a b. (a -> b) -> a -> b
$
Logger -> DynFlags -> Bool -> SDoc -> SDoc -> WarnsAndErrs -> IO ()
displayLintResults Logger
logger DynFlags
dflags Bool
False SDoc
doc
(CoreExpr -> SDoc
forall b. OutputableBndr b => Expr b -> SDoc
pprCoreExpr CoreExpr
core_expr') (Bag SDoc
forall a. Bag a
emptyBag, Bag SDoc
errs)
CoreExpr -> IOEnv (Env IfGblEnv IfLclEnv) CoreExpr
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
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name
get_in_scope :: IfL VarSet
get_in_scope :: IfL VarSet
get_in_scope
= do { (IfGblEnv
gbl_env, IfLclEnv
lcl_env) <- TcRnIf IfGblEnv IfLclEnv (IfGblEnv, IfLclEnv)
forall gbl lcl. TcRnIf gbl lcl (gbl, lcl)
getEnvs
; [CoreBndr]
rec_ids <- case IfGblEnv -> Maybe (Module, IfG TypeEnv)
if_rec_types IfGblEnv
gbl_env of
Maybe (Module, IfG TypeEnv)
Nothing -> [CoreBndr] -> IOEnv (Env IfGblEnv IfLclEnv) [CoreBndr]
forall (m :: * -> *) a. Monad m => a -> m a
return []
Just (Module
_, IfG TypeEnv
get_env) -> do
{ TypeEnv
type_env <- () -> IfG TypeEnv -> IOEnv (Env IfGblEnv IfLclEnv) TypeEnv
forall lcl' gbl a lcl.
lcl' -> TcRnIf gbl lcl' a -> TcRnIf gbl lcl a
setLclEnv () IfG TypeEnv
get_env
; [CoreBndr] -> IOEnv (Env IfGblEnv IfLclEnv) [CoreBndr]
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeEnv -> [CoreBndr]
typeEnvIds TypeEnv
type_env) }
; VarSet -> IfL VarSet
forall (m :: * -> *) a. Monad m => a -> m a
return (UniqFM FastString CoreBndr -> VarSet
bindingsVars (IfLclEnv -> UniqFM FastString CoreBndr
if_tv_env IfLclEnv
lcl_env) VarSet -> VarSet -> VarSet
`unionVarSet`
UniqFM FastString CoreBndr -> VarSet
bindingsVars (IfLclEnv -> UniqFM FastString CoreBndr
if_id_env IfLclEnv
lcl_env) VarSet -> VarSet -> VarSet
`unionVarSet`
[CoreBndr] -> VarSet
mkVarSet [CoreBndr]
rec_ids) }
bindingsVars :: FastStringEnv Var -> VarSet
bindingsVars :: UniqFM FastString CoreBndr -> VarSet
bindingsVars UniqFM FastString CoreBndr
ufm = [CoreBndr] -> VarSet
mkVarSet ([CoreBndr] -> VarSet) -> [CoreBndr] -> VarSet
forall a b. (a -> b) -> a -> b
$ UniqFM FastString CoreBndr -> [CoreBndr]
forall key elt. UniqFM key elt -> [elt]
nonDetEltsUFM UniqFM FastString CoreBndr
ufm
tcIfaceOneShot :: IfaceOneShot -> OneShotInfo
tcIfaceOneShot :: IfaceOneShot -> OneShotInfo
tcIfaceOneShot IfaceOneShot
IfaceNoOneShot = OneShotInfo
NoOneShotInfo
tcIfaceOneShot IfaceOneShot
IfaceOneShot = OneShotInfo
OneShotLam
tcIfaceGlobal :: Name -> IfL TyThing
tcIfaceGlobal :: Name -> IfL TyThing
tcIfaceGlobal Name
name
| Just TyThing
thing <- Name -> Maybe TyThing
wiredInNameTyThing_maybe Name
name
= do { TyThing -> TcRnIf IfGblEnv IfLclEnv ()
ifCheckWiredInThing TyThing
thing; TyThing -> IfL TyThing
forall (m :: * -> *) a. Monad m => a -> m a
return TyThing
thing }
| Bool
otherwise
= do { IfGblEnv
env <- TcRnIf IfGblEnv IfLclEnv IfGblEnv
forall gbl lcl. TcRnIf gbl lcl gbl
getGblEnv
; case IfGblEnv -> Maybe (Module, IfG TypeEnv)
if_rec_types IfGblEnv
env of {
Just (Module
mod, IfG TypeEnv
get_type_env)
| Module -> Name -> Bool
nameIsLocalOrFrom Module
mod Name
name
-> do
{ TypeEnv
type_env <- () -> IfG TypeEnv -> IOEnv (Env IfGblEnv IfLclEnv) TypeEnv
forall lcl' gbl a lcl.
lcl' -> TcRnIf gbl lcl' a -> TcRnIf gbl lcl a
setLclEnv () IfG TypeEnv
get_type_env
; case TypeEnv -> Name -> Maybe TyThing
forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv TypeEnv
type_env Name
name of
Just TyThing
thing -> TyThing -> IfL TyThing
forall (m :: * -> *) a. Monad m => a -> m a
return TyThing
thing
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 <- TcRnIf IfGblEnv IfLclEnv HscEnv
forall gbl lcl. TcRnIf gbl lcl HscEnv
getTopEnv
; Maybe TyThing
mb_thing <- IO (Maybe TyThing) -> IOEnv (Env IfGblEnv IfLclEnv) (Maybe TyThing)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (HscEnv -> Name -> IO (Maybe TyThing)
lookupType HscEnv
hsc_env Name
name)
; case Maybe TyThing
mb_thing of {
Just TyThing
thing -> TyThing -> IfL TyThing
forall (m :: * -> *) a. Monad m => a -> m a
return TyThing
thing ;
Maybe TyThing
Nothing -> do
{ MaybeErr SDoc TyThing
mb_thing <- Name -> IfM IfLclEnv (MaybeErr SDoc TyThing)
forall lcl. Name -> IfM lcl (MaybeErr SDoc TyThing)
importDecl Name
name
; case MaybeErr SDoc TyThing
mb_thing of
Failed SDoc
err -> SDoc -> IfL TyThing
forall a. SDoc -> IfL a
failIfM SDoc
err
Succeeded TyThing
thing -> TyThing -> IfL TyThing
forall (m :: * -> *) a. Monad m => a -> m a
return TyThing
thing
}}}
tcIfaceTyCon :: IfaceTyCon -> IfL TyCon
tcIfaceTyCon :: IfaceTyCon -> IOEnv (Env IfGblEnv IfLclEnv) TyCon
tcIfaceTyCon (IfaceTyCon Name
name IfaceTyConInfo
info)
= do { TyThing
thing <- Name -> IfL TyThing
tcIfaceGlobal Name
name
; TyCon -> IOEnv (Env IfGblEnv IfLclEnv) TyCon
forall (m :: * -> *) a. Monad m => a -> m a
return (TyCon -> IOEnv (Env IfGblEnv IfLclEnv) TyCon)
-> TyCon -> IOEnv (Env IfGblEnv IfLclEnv) TyCon
forall a b. (a -> b) -> a -> b
$ case IfaceTyConInfo -> PromotionFlag
ifaceTyConIsPromoted IfaceTyConInfo
info of
PromotionFlag
NotPromoted -> HasDebugCallStack => TyThing -> TyCon
TyThing -> TyCon
tyThingTyCon TyThing
thing
PromotionFlag
IsPromoted -> DataCon -> TyCon
promoteDataCon (DataCon -> TyCon) -> DataCon -> TyCon
forall a b. (a -> b) -> a -> b
$ HasDebugCallStack => TyThing -> DataCon
TyThing -> DataCon
tyThingDataCon TyThing
thing }
tcIfaceCoAxiom :: Name -> IfL (CoAxiom Branched)
tcIfaceCoAxiom :: Name -> IfL (CoAxiom Branched)
tcIfaceCoAxiom Name
name = do { TyThing
thing <- Name -> IfL TyThing
tcIfaceImplicit Name
name
; CoAxiom Branched -> IfL (CoAxiom Branched)
forall (m :: * -> *) a. Monad m => a -> m a
return (HasDebugCallStack => TyThing -> CoAxiom Branched
TyThing -> CoAxiom Branched
tyThingCoAxiom TyThing
thing) }
tcIfaceCoAxiomRule :: IfLclName -> IfL CoAxiomRule
tcIfaceCoAxiomRule :: FastString -> IOEnv (Env IfGblEnv IfLclEnv) CoAxiomRule
tcIfaceCoAxiomRule FastString
n
= case UniqFM FastString CoAxiomRule -> FastString -> Maybe CoAxiomRule
forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
lookupUFM UniqFM FastString CoAxiomRule
typeNatCoAxiomRules FastString
n of
Just CoAxiomRule
ax -> CoAxiomRule -> IOEnv (Env IfGblEnv IfLclEnv) CoAxiomRule
forall (m :: * -> *) a. Monad m => a -> m a
return CoAxiomRule
ax
Maybe CoAxiomRule
_ -> String -> SDoc -> IOEnv (Env IfGblEnv IfLclEnv) CoAxiomRule
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tcIfaceCoAxiomRule" (FastString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FastString
n)
tcIfaceDataCon :: Name -> IfL DataCon
tcIfaceDataCon :: Name -> IOEnv (Env IfGblEnv IfLclEnv) DataCon
tcIfaceDataCon Name
name = do { TyThing
thing <- Name -> IfL TyThing
tcIfaceGlobal Name
name
; case TyThing
thing of
AConLike (RealDataCon DataCon
dc) -> DataCon -> IOEnv (Env IfGblEnv IfLclEnv) DataCon
forall (m :: * -> *) a. Monad m => a -> m a
return DataCon
dc
TyThing
_ -> String -> SDoc -> IOEnv (Env IfGblEnv IfLclEnv) DataCon
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tcIfaceDataCon" (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
nameSDoc -> SDoc -> SDoc
$$ TyThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyThing
thing) }
tcIfaceConLike :: Name -> IfL ConLike
tcIfaceConLike :: Name -> IOEnv (Env IfGblEnv IfLclEnv) ConLike
tcIfaceConLike Name
name = do { TyThing
thing <- Name -> IfL TyThing
tcIfaceGlobal Name
name
; case TyThing
thing of
AConLike ConLike
cl -> ConLike -> IOEnv (Env IfGblEnv IfLclEnv) ConLike
forall (m :: * -> *) a. Monad m => a -> m a
return ConLike
cl
TyThing
_ -> String -> SDoc -> IOEnv (Env IfGblEnv IfLclEnv) ConLike
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tcIfaceConLike" (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
nameSDoc -> SDoc -> SDoc
$$ TyThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyThing
thing) }
tcIfaceExtId :: Name -> IfL Id
tcIfaceExtId :: Name -> IfL CoreBndr
tcIfaceExtId Name
name = do { TyThing
thing <- Name -> IfL TyThing
tcIfaceGlobal Name
name
; case TyThing
thing of
AnId CoreBndr
id -> CoreBndr -> IfL CoreBndr
forall (m :: * -> *) a. Monad m => a -> m a
return CoreBndr
id
TyThing
_ -> String -> SDoc -> IfL CoreBndr
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tcIfaceExtId" (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
nameSDoc -> SDoc -> SDoc
$$ TyThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyThing
thing) }
tcIfaceImplicit :: Name -> IfL TyThing
tcIfaceImplicit :: Name -> IfL TyThing
tcIfaceImplicit Name
n = do
IfLclEnv
lcl_env <- TcRnIf IfGblEnv IfLclEnv IfLclEnv
forall gbl lcl. TcRnIf gbl lcl lcl
getLclEnv
case IfLclEnv -> Maybe 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 -> String -> SDoc -> IfL TyThing
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tcIfaceInst" (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n SDoc -> SDoc -> SDoc
$$ TypeEnv -> SDoc
forall a. Outputable a => a -> SDoc
ppr TypeEnv
tenv)
Just TyThing
tything -> TyThing -> IfL TyThing
forall (m :: * -> *) a. Monad m => a -> m a
return TyThing
tything
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 -> TcRnIf 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'
; [CoreBndr] -> IfL a -> IfL a
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
= IfaceIdBndr -> (CoreBndr -> IfL a) -> IfL a
forall a. IfaceIdBndr -> (CoreBndr -> IfL a) -> IfL a
bindIfaceId IfaceIdBndr
b ((CoreBndr -> IfL a) -> IfL a) -> (CoreBndr -> IfL a) -> IfL a
forall a b. (a -> b) -> a -> b
$ \CoreBndr
b' ->
[IfaceIdBndr] -> ([CoreBndr] -> IfL a) -> IfL a
forall a. [IfaceIdBndr] -> ([CoreBndr] -> IfL a) -> IfL a
bindIfaceIds [IfaceIdBndr]
bs (([CoreBndr] -> IfL a) -> IfL a) -> ([CoreBndr] -> IfL a) -> IfL a
forall a b. (a -> b) -> a -> b
$ \[CoreBndr]
bs' ->
[CoreBndr] -> IfL a
thing_inside (CoreBndr
b'CoreBndr -> [CoreBndr] -> [CoreBndr]
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
= IfaceIdBndr -> (CoreBndr -> IfL a) -> IfL a
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
= IfaceTvBndr -> (CoreBndr -> IfL a) -> IfL a
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
= IfaceBndr -> (CoreBndr -> IfL a) -> IfL a
forall a. IfaceBndr -> (CoreBndr -> IfL a) -> IfL a
bindIfaceBndr IfaceBndr
b ((CoreBndr -> IfL a) -> IfL a) -> (CoreBndr -> IfL a) -> IfL a
forall a b. (a -> b) -> a -> b
$ \ CoreBndr
b' ->
[IfaceBndr] -> ([CoreBndr] -> IfL a) -> IfL a
forall a. [IfaceBndr] -> ([CoreBndr] -> IfL a) -> IfL a
bindIfaceBndrs [IfaceBndr]
bs (([CoreBndr] -> IfL a) -> IfL a) -> ([CoreBndr] -> IfL a) -> IfL a
forall a b. (a -> b) -> a -> b
$ \ [CoreBndr]
bs' ->
[CoreBndr] -> IfL a
thing_inside (CoreBndr
b'CoreBndr -> [CoreBndr] -> [CoreBndr]
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
= VarBndr IfaceBndr vis -> (CoreBndr -> vis -> IfL a) -> IfL a
forall vis a.
VarBndr IfaceBndr vis -> (CoreBndr -> vis -> IfL a) -> IfL a
bindIfaceForAllBndr VarBndr IfaceBndr vis
bndr ((CoreBndr -> vis -> IfL a) -> IfL a)
-> (CoreBndr -> vis -> IfL a) -> IfL a
forall a b. (a -> b) -> a -> b
$ \CoreBndr
tv vis
vis ->
[VarBndr IfaceBndr vis]
-> ([VarBndr CoreBndr vis] -> IfL a) -> IfL a
forall vis a.
[VarBndr IfaceBndr vis]
-> ([VarBndr CoreBndr vis] -> IfL a) -> IfL a
bindIfaceForAllBndrs [VarBndr IfaceBndr vis]
bndrs (([VarBndr CoreBndr vis] -> IfL a) -> IfL a)
-> ([VarBndr CoreBndr vis] -> IfL a) -> IfL a
forall a b. (a -> b) -> a -> b
$ \[VarBndr CoreBndr vis]
bndrs' ->
[VarBndr CoreBndr vis] -> IfL a
thing_inside (CoreBndr -> vis -> VarBndr CoreBndr vis
forall var argf. var -> argf -> VarBndr var argf
Bndr CoreBndr
tv vis
vis VarBndr CoreBndr vis
-> [VarBndr CoreBndr vis] -> [VarBndr CoreBndr 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
= IfaceTvBndr -> (CoreBndr -> IfL a) -> IfL a
forall a. IfaceTvBndr -> (CoreBndr -> IfL a) -> IfL a
bindIfaceTyVar IfaceTvBndr
tv ((CoreBndr -> IfL a) -> IfL a) -> (CoreBndr -> IfL a) -> IfL a
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
= IfaceIdBndr -> (CoreBndr -> IfL a) -> IfL a
forall a. IfaceIdBndr -> (CoreBndr -> IfL a) -> IfL a
bindIfaceId IfaceIdBndr
tv ((CoreBndr -> IfL a) -> IfL a) -> (CoreBndr -> IfL a) -> IfL a
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 -> TcRnIf IfGblEnv IfLclEnv Name
newIfaceName (FastString -> OccName
mkTyVarOccFS FastString
occ)
; CoreBndr
tyvar <- Name -> IfaceType -> IfL CoreBndr
mk_iface_tyvar Name
name IfaceType
kind
; [CoreBndr] -> IfL a -> IfL a
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
= IfaceTvBndr -> (CoreBndr -> IfL a) -> IfL a
forall a. IfaceTvBndr -> (CoreBndr -> IfL a) -> IfL a
bindIfaceTyVar IfaceTvBndr
bndr ((CoreBndr -> IfL a) -> IfL a) -> (CoreBndr -> IfL a) -> IfL a
forall a b. (a -> b) -> a -> b
$ \CoreBndr
tv ->
[IfaceTvBndr] -> ([CoreBndr] -> IfL a) -> IfL a
forall a. [IfaceTvBndr] -> ([CoreBndr] -> IfL a) -> IfL a
bindIfaceTyVars [IfaceTvBndr]
bndrs (([CoreBndr] -> IfL a) -> IfL a) -> ([CoreBndr] -> IfL a) -> IfL a
forall a b. (a -> b) -> a -> b
$ \[CoreBndr]
tvs ->
[CoreBndr] -> IfL a
thing_inside (CoreBndr
tv CoreBndr -> [CoreBndr] -> [CoreBndr]
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
; CoreBndr -> IfL CoreBndr
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
= (IfaceBndr -> (CoreBndr -> IfL a) -> IfL a)
-> IfaceTyConBinder -> (TyConBinder -> IfL a) -> IfL a
forall a.
(IfaceBndr -> (CoreBndr -> IfL a) -> IfL a)
-> IfaceTyConBinder -> (TyConBinder -> IfL a) -> IfL a
bindIfaceTyConBinderX IfaceBndr -> (CoreBndr -> IfL a) -> IfL a
forall a. IfaceBndr -> (CoreBndr -> IfL a) -> IfL a
bindIfaceBndr IfaceTyConBinder
b ((TyConBinder -> IfL a) -> IfL a)
-> (TyConBinder -> IfL a) -> IfL a
forall a b. (a -> b) -> a -> b
$ \ TyConBinder
b' ->
[IfaceTyConBinder] -> ([TyConBinder] -> IfL a) -> IfL a
forall a. [IfaceTyConBinder] -> ([TyConBinder] -> IfL a) -> IfL a
bindIfaceTyConBinders [IfaceTyConBinder]
bs (([TyConBinder] -> IfL a) -> IfL a)
-> ([TyConBinder] -> IfL a) -> IfL a
forall a b. (a -> b) -> a -> b
$ \ [TyConBinder]
bs' ->
[TyConBinder] -> IfL a
thing_inside (TyConBinder
b'TyConBinder -> [TyConBinder] -> [TyConBinder]
forall a. a -> [a] -> [a]
:[TyConBinder]
bs')
bindIfaceTyConBinders_AT :: [IfaceTyConBinder]
-> ([TyConBinder] -> IfL a) -> IfL a
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
= (IfaceBndr -> (CoreBndr -> IfL a) -> IfL a)
-> IfaceTyConBinder -> (TyConBinder -> IfL a) -> IfL a
forall a.
(IfaceBndr -> (CoreBndr -> IfL a) -> IfL a)
-> IfaceTyConBinder -> (TyConBinder -> IfL a) -> IfL a
bindIfaceTyConBinderX IfaceBndr -> (CoreBndr -> IfL a) -> IfL a
forall a. IfaceBndr -> (CoreBndr -> IfL a) -> IfL a
bind_tv IfaceTyConBinder
b ((TyConBinder -> IfL a) -> IfL a)
-> (TyConBinder -> IfL a) -> IfL a
forall a b. (a -> b) -> a -> b
$ \TyConBinder
b' ->
[IfaceTyConBinder] -> ([TyConBinder] -> IfL a) -> IfL a
forall a. [IfaceTyConBinder] -> ([TyConBinder] -> IfL a) -> IfL a
bindIfaceTyConBinders_AT [IfaceTyConBinder]
bs (([TyConBinder] -> IfL a) -> IfL a)
-> ([TyConBinder] -> IfL a) -> IfL a
forall a b. (a -> b) -> a -> b
$ \[TyConBinder]
bs' ->
[TyConBinder] -> IfL a
thing_inside (TyConBinder
b'TyConBinder -> [TyConBinder] -> [TyConBinder]
forall a. a -> [a] -> [a]
:[TyConBinder]
bs')
where
bind_tv :: IfaceBndr
-> (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 -> IfaceBndr
-> (CoreBndr -> IOEnv (Env IfGblEnv IfLclEnv) b)
-> IOEnv (Env IfGblEnv IfLclEnv) b
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 ((CoreBndr -> IfL a) -> IfL a) -> (CoreBndr -> IfL a) -> IfL a
forall a b. (a -> b) -> a -> b
$ \CoreBndr
tv' ->
TyConBinder -> IfL a
thing_inside (CoreBndr -> TyConBndrVis -> TyConBinder
forall var argf. var -> argf -> VarBndr var argf
Bndr CoreBndr
tv' TyConBndrVis
vis)