{-# LANGUAGE NondecreasingIndentation #-}
module GHC.Iface.Make
( mkPartialIface
, mkFullIface
, mkIfaceTc
, mkIfaceExports
, coAxiomToIfaceDecl
, tyThingToIfaceDecl
)
where
import GHC.Prelude
import GHC.Hs
import GHC.StgToCmm.Types (CmmCgInfos (..))
import GHC.Tc.Utils.TcType
import GHC.Tc.Utils.Monad
import GHC.Iface.Syntax
import GHC.Iface.Recomp
import GHC.Iface.Load
import GHC.Iface.Ext.Fields
import GHC.CoreToIface
import qualified GHC.LanguageExtensions as LangExt
import GHC.Core
import GHC.Core.Class
import GHC.Core.TyCon
import GHC.Core.Coercion.Axiom
import GHC.Core.ConLike
import GHC.Core.DataCon
import GHC.Core.FVs ( orphNamesOfAxiomLHS )
import GHC.Core.Type
import GHC.Core.Multiplicity
import GHC.Core.InstEnv
import GHC.Core.FamInstEnv
import GHC.Core.Ppr
import GHC.Core.RoughMap( RoughMatchTc(..) )
import GHC.Driver.Config.HsToCore.Usage
import GHC.Driver.Env
import GHC.Driver.Backend
import GHC.Driver.Session
import GHC.Driver.Plugins
import GHC.Types.Id
import GHC.Types.Fixity.Env
import GHC.Types.SafeHaskell
import GHC.Types.Annotations
import GHC.Types.Var.Env
import GHC.Types.Var
import GHC.Types.Name
import GHC.Types.Avail
import GHC.Types.Name.Reader
import GHC.Types.Name.Env
import GHC.Types.Name.Set
import GHC.Types.Unique.DSet
import GHC.Types.Basic hiding ( SuccessFlag(..) )
import GHC.Types.TypeEnv
import GHC.Types.SourceFile
import GHC.Types.TyThing
import GHC.Types.HpcInfo
import GHC.Types.CompleteMatch
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.Panic.Plain
import GHC.Utils.Misc
import GHC.Utils.Logger
import GHC.Data.FastString
import GHC.Data.Maybe
import GHC.HsToCore.Docs
import GHC.HsToCore.Usage
import GHC.Unit
import GHC.Unit.Module.Warnings
import GHC.Unit.Module.ModIface
import GHC.Unit.Module.ModDetails
import GHC.Unit.Module.ModGuts
import GHC.Unit.Module.ModSummary
import GHC.Unit.Module.Deps
import Data.Function
import Data.List ( findIndex, mapAccumL, sortBy )
import Data.Ord
import Data.IORef
import GHC.Stg.Pipeline (StgCgInfos)
mkPartialIface :: HscEnv
-> CoreProgram
-> ModDetails
-> ModSummary
-> ModGuts
-> PartialModIface
mkPartialIface :: HscEnv
-> CoreProgram
-> ModDetails
-> ModSummary
-> ModGuts
-> PartialModIface
mkPartialIface HscEnv
hsc_env CoreProgram
core_prog ModDetails
mod_details ModSummary
mod_summary
ModGuts{ mg_module :: ModGuts -> Module
mg_module = Module
this_mod
, mg_hsc_src :: ModGuts -> HscSource
mg_hsc_src = HscSource
hsc_src
, mg_usages :: ModGuts -> [Usage]
mg_usages = [Usage]
usages
, mg_used_th :: ModGuts -> Bool
mg_used_th = Bool
used_th
, mg_deps :: ModGuts -> Dependencies
mg_deps = Dependencies
deps
, mg_rdr_env :: ModGuts -> GlobalRdrEnv
mg_rdr_env = GlobalRdrEnv
rdr_env
, mg_fix_env :: ModGuts -> FixityEnv
mg_fix_env = FixityEnv
fix_env
, mg_warns :: ModGuts -> Warnings GhcRn
mg_warns = Warnings GhcRn
warns
, mg_hpc_info :: ModGuts -> HpcInfo
mg_hpc_info = HpcInfo
hpc_info
, mg_safe_haskell :: ModGuts -> SafeHaskellMode
mg_safe_haskell = SafeHaskellMode
safe_mode
, mg_trust_pkg :: ModGuts -> Bool
mg_trust_pkg = Bool
self_trust
, mg_docs :: ModGuts -> Maybe Docs
mg_docs = Maybe Docs
docs
}
= HscEnv
-> Module
-> CoreProgram
-> HscSource
-> Bool
-> Dependencies
-> GlobalRdrEnv
-> FixityEnv
-> Warnings GhcRn
-> HpcInfo
-> Bool
-> SafeHaskellMode
-> [Usage]
-> Maybe Docs
-> ModSummary
-> ModDetails
-> PartialModIface
mkIface_ HscEnv
hsc_env Module
this_mod CoreProgram
core_prog HscSource
hsc_src Bool
used_th Dependencies
deps GlobalRdrEnv
rdr_env FixityEnv
fix_env Warnings GhcRn
warns HpcInfo
hpc_info Bool
self_trust
SafeHaskellMode
safe_mode [Usage]
usages Maybe Docs
docs ModSummary
mod_summary ModDetails
mod_details
mkFullIface :: HscEnv -> PartialModIface -> Maybe StgCgInfos -> Maybe CmmCgInfos -> IO ModIface
mkFullIface :: HscEnv
-> PartialModIface
-> Maybe StgCgInfos
-> Maybe CmmCgInfos
-> IO ModIface
mkFullIface HscEnv
hsc_env PartialModIface
partial_iface Maybe StgCgInfos
mb_stg_infos Maybe CmmCgInfos
mb_cmm_infos = do
let decls :: [IfaceDeclExts 'ModIfaceCore]
decls
| GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_OmitInterfacePragmas (HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env)
= PartialModIface -> [IfaceDeclExts 'ModIfaceCore]
forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceDeclExts phase]
mi_decls PartialModIface
partial_iface
| Bool
otherwise
= [IfaceDecl] -> Maybe StgCgInfos -> Maybe CmmCgInfos -> [IfaceDecl]
updateDecl (PartialModIface -> [IfaceDeclExts 'ModIfaceCore]
forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceDeclExts phase]
mi_decls PartialModIface
partial_iface) Maybe StgCgInfos
mb_stg_infos Maybe CmmCgInfos
mb_cmm_infos
ModIface
full_iface <-
{-# SCC "addFingerprints" #-}
HscEnv -> PartialModIface -> IO ModIface
addFingerprints HscEnv
hsc_env PartialModIface
partial_iface{ mi_decls = decls }
let unit_state :: UnitState
unit_state = (() :: Constraint) => HscEnv -> UnitState
HscEnv -> UnitState
hsc_units HscEnv
hsc_env
Logger -> DumpFlag -> String -> DumpFormat -> SDoc -> IO ()
putDumpFileMaybe (HscEnv -> Logger
hsc_logger HscEnv
hsc_env) DumpFlag
Opt_D_dump_hi String
"FINAL INTERFACE" DumpFormat
FormatText
(UnitState -> ModIface -> SDoc
pprModIface UnitState
unit_state ModIface
full_iface)
ModIface -> IO ModIface
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ModIface
full_iface
updateDecl :: [IfaceDecl] -> Maybe StgCgInfos -> Maybe CmmCgInfos -> [IfaceDecl]
updateDecl :: [IfaceDecl] -> Maybe StgCgInfos -> Maybe CmmCgInfos -> [IfaceDecl]
updateDecl [IfaceDecl]
decls Maybe StgCgInfos
Nothing Maybe CmmCgInfos
Nothing = [IfaceDecl]
decls
updateDecl [IfaceDecl]
decls Maybe StgCgInfos
m_stg_infos Maybe CmmCgInfos
m_cmm_infos
= (IfaceDecl -> IfaceDecl) -> [IfaceDecl] -> [IfaceDecl]
forall a b. (a -> b) -> [a] -> [b]
map IfaceDecl -> IfaceDecl
update_decl [IfaceDecl]
decls
where
(NameSet
non_cafs,ModuleLFInfos
lf_infos) = (NameSet, ModuleLFInfos)
-> (CmmCgInfos -> (NameSet, ModuleLFInfos))
-> Maybe CmmCgInfos
-> (NameSet, ModuleLFInfos)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (NameSet
forall a. Monoid a => a
mempty, ModuleLFInfos
forall a. Monoid a => a
mempty)
(\CmmCgInfos
cmm_info -> (NonCaffySet -> NameSet
ncs_nameSet (CmmCgInfos -> NonCaffySet
cgNonCafs CmmCgInfos
cmm_info), CmmCgInfos -> ModuleLFInfos
cgLFInfos CmmCgInfos
cmm_info))
Maybe CmmCgInfos
m_cmm_infos
tag_sigs :: StgCgInfos
tag_sigs = StgCgInfos -> Maybe StgCgInfos -> StgCgInfos
forall a. a -> Maybe a -> a
fromMaybe StgCgInfos
forall a. Monoid a => a
mempty Maybe StgCgInfos
m_stg_infos
update_decl :: IfaceDecl -> IfaceDecl
update_decl (IfaceId Name
nm IfaceType
ty IfaceIdDetails
details IfaceIdInfo
infos)
| let not_caffy :: Bool
not_caffy = Name -> NameSet -> Bool
elemNameSet Name
nm NameSet
non_cafs
, let mb_lf_info :: Maybe LambdaFormInfo
mb_lf_info = ModuleLFInfos -> Name -> Maybe LambdaFormInfo
forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv ModuleLFInfos
lf_infos Name
nm
, let sig :: Maybe TagSig
sig = StgCgInfos -> Name -> Maybe TagSig
forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv StgCgInfos
tag_sigs Name
nm
, Bool -> String -> SDoc -> Bool -> Bool
forall a. HasCallStack => Bool -> String -> SDoc -> a -> a
warnPprTrace (Maybe LambdaFormInfo -> Bool
forall a. Maybe a -> Bool
isNothing Maybe LambdaFormInfo
mb_lf_info) String
"updateDecl" (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Name without LFInfo:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
nm) Bool
True
, Maybe LambdaFormInfo -> Bool
forall a. Maybe a -> Bool
isJust Maybe LambdaFormInfo
mb_lf_info Bool -> Bool -> Bool
|| Bool
not_caffy Bool -> Bool -> Bool
|| Maybe TagSig -> Bool
forall a. Maybe a -> Bool
isJust Maybe TagSig
sig
= Name -> IfaceType -> IfaceIdDetails -> IfaceIdInfo -> IfaceDecl
IfaceId Name
nm IfaceType
ty IfaceIdDetails
details (IfaceIdInfo -> IfaceDecl) -> IfaceIdInfo -> IfaceDecl
forall a b. (a -> b) -> a -> b
$
(if Bool
not_caffy then (IfaceInfoItem
HsNoCafRefs IfaceInfoItem -> IfaceIdInfo -> IfaceIdInfo
forall a. a -> [a] -> [a]
:) else IfaceIdInfo -> IfaceIdInfo
forall a. a -> a
id) (IfaceIdInfo -> IfaceIdInfo) -> IfaceIdInfo -> IfaceIdInfo
forall a b. (a -> b) -> a -> b
$
(if Maybe TagSig -> Bool
forall a. Maybe a -> Bool
isJust Maybe TagSig
sig then (TagSig -> IfaceInfoItem
HsTagSig (Maybe TagSig -> TagSig
forall a. HasCallStack => Maybe a -> a
fromJust Maybe TagSig
sig)IfaceInfoItem -> IfaceIdInfo -> IfaceIdInfo
forall a. a -> [a] -> [a]
:) else IfaceIdInfo -> IfaceIdInfo
forall a. a -> a
id) (IfaceIdInfo -> IfaceIdInfo) -> IfaceIdInfo -> IfaceIdInfo
forall a b. (a -> b) -> a -> b
$
(case Maybe LambdaFormInfo
mb_lf_info of
Maybe LambdaFormInfo
Nothing -> IfaceIdInfo
infos
Just LambdaFormInfo
lf_info -> IfaceLFInfo -> IfaceInfoItem
HsLFInfo (Name -> LambdaFormInfo -> IfaceLFInfo
toIfaceLFInfo Name
nm LambdaFormInfo
lf_info) IfaceInfoItem -> IfaceIdInfo -> IfaceIdInfo
forall a. a -> [a] -> [a]
: IfaceIdInfo
infos)
update_decl IfaceDecl
decl
= IfaceDecl
decl
mkIfaceTc :: HscEnv
-> SafeHaskellMode
-> ModDetails
-> ModSummary
-> Maybe CoreProgram
-> TcGblEnv
-> IO ModIface
mkIfaceTc :: HscEnv
-> SafeHaskellMode
-> ModDetails
-> ModSummary
-> Maybe CoreProgram
-> TcGblEnv
-> IO ModIface
mkIfaceTc HscEnv
hsc_env SafeHaskellMode
safe_mode ModDetails
mod_details ModSummary
mod_summary Maybe CoreProgram
mb_program
tc_result :: TcGblEnv
tc_result@TcGblEnv{ tcg_mod :: TcGblEnv -> Module
tcg_mod = Module
this_mod,
tcg_src :: TcGblEnv -> HscSource
tcg_src = HscSource
hsc_src,
tcg_imports :: TcGblEnv -> ImportAvails
tcg_imports = ImportAvails
imports,
tcg_rdr_env :: TcGblEnv -> GlobalRdrEnv
tcg_rdr_env = GlobalRdrEnv
rdr_env,
tcg_fix_env :: TcGblEnv -> FixityEnv
tcg_fix_env = FixityEnv
fix_env,
tcg_merged :: TcGblEnv -> [(Module, Fingerprint)]
tcg_merged = [(Module, Fingerprint)]
merged,
tcg_warns :: TcGblEnv -> Warnings GhcRn
tcg_warns = Warnings GhcRn
warns,
tcg_hpc :: TcGblEnv -> Bool
tcg_hpc = Bool
other_hpc_info,
tcg_th_splice_used :: TcGblEnv -> TcRef Bool
tcg_th_splice_used = TcRef Bool
tc_splice_used,
tcg_dependent_files :: TcGblEnv -> TcRef [String]
tcg_dependent_files = TcRef [String]
dependent_files
}
= do
let used_names :: NameSet
used_names = TcGblEnv -> NameSet
mkUsedNames TcGblEnv
tc_result
let pluginModules :: [ModIface]
pluginModules = (LoadedPlugin -> ModIface) -> [LoadedPlugin] -> [ModIface]
forall a b. (a -> b) -> [a] -> [b]
map LoadedPlugin -> ModIface
lpModule (Plugins -> [LoadedPlugin]
loadedPlugins (HscEnv -> Plugins
hsc_plugins HscEnv
hsc_env))
let home_unit :: HomeUnit
home_unit = HscEnv -> HomeUnit
hsc_home_unit HscEnv
hsc_env
let deps :: Dependencies
deps = HomeUnit -> Module -> ImportAvails -> [Module] -> Dependencies
mkDependencies HomeUnit
home_unit
(TcGblEnv -> Module
tcg_mod TcGblEnv
tc_result)
(TcGblEnv -> ImportAvails
tcg_imports TcGblEnv
tc_result)
((ModIface -> Module) -> [ModIface] -> [Module]
forall a b. (a -> b) -> [a] -> [b]
map ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module [ModIface]
pluginModules)
let hpc_info :: HpcInfo
hpc_info = Bool -> HpcInfo
emptyHpcInfo Bool
other_hpc_info
Bool
used_th <- TcRef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef TcRef Bool
tc_splice_used
[String]
dep_files <- (TcRef [String] -> IO [String]
forall a. IORef a -> IO a
readIORef TcRef [String]
dependent_files)
([Linkable]
needed_links, PkgsLoaded
needed_pkgs) <- IORef ([Linkable], PkgsLoaded) -> IO ([Linkable], PkgsLoaded)
forall a. IORef a -> IO a
readIORef (TcGblEnv -> IORef ([Linkable], PkgsLoaded)
tcg_th_needed_deps TcGblEnv
tc_result)
let uc :: UsageConfig
uc = HscEnv -> UsageConfig
initUsageConfig HscEnv
hsc_env
plugins :: Plugins
plugins = HscEnv -> Plugins
hsc_plugins HscEnv
hsc_env
fc :: FinderCache
fc = HscEnv -> FinderCache
hsc_FC HscEnv
hsc_env
unit_env :: UnitEnv
unit_env = HscEnv -> UnitEnv
hsc_unit_env HscEnv
hsc_env
[Usage]
usages <- HscEnv -> IfG [Usage] -> IO [Usage]
forall a. HscEnv -> IfG a -> IO a
initIfaceLoad HscEnv
hsc_env (IfG [Usage] -> IO [Usage]) -> IfG [Usage] -> IO [Usage]
forall a b. (a -> b) -> a -> b
$ UsageConfig
-> Plugins
-> FinderCache
-> UnitEnv
-> Module
-> ImportedMods
-> NameSet
-> [String]
-> [(Module, Fingerprint)]
-> [Linkable]
-> PkgsLoaded
-> IfG [Usage]
mkUsageInfo UsageConfig
uc Plugins
plugins FinderCache
fc UnitEnv
unit_env Module
this_mod (ImportAvails -> ImportedMods
imp_mods ImportAvails
imports) NameSet
used_names
[String]
dep_files [(Module, Fingerprint)]
merged [Linkable]
needed_links PkgsLoaded
needed_pkgs
Maybe Docs
docs <- DynFlags -> TcGblEnv -> IO (Maybe Docs)
forall (m :: * -> *).
MonadIO m =>
DynFlags -> TcGblEnv -> m (Maybe Docs)
extractDocs (ModSummary -> DynFlags
ms_hspp_opts ModSummary
mod_summary) TcGblEnv
tc_result
let partial_iface :: PartialModIface
partial_iface = HscEnv
-> Module
-> CoreProgram
-> HscSource
-> Bool
-> Dependencies
-> GlobalRdrEnv
-> FixityEnv
-> Warnings GhcRn
-> HpcInfo
-> Bool
-> SafeHaskellMode
-> [Usage]
-> Maybe Docs
-> ModSummary
-> ModDetails
-> PartialModIface
mkIface_ HscEnv
hsc_env
Module
this_mod (CoreProgram -> Maybe CoreProgram -> CoreProgram
forall a. a -> Maybe a -> a
fromMaybe [] Maybe CoreProgram
mb_program) HscSource
hsc_src
Bool
used_th Dependencies
deps GlobalRdrEnv
rdr_env
FixityEnv
fix_env Warnings GhcRn
warns HpcInfo
hpc_info
(ImportAvails -> Bool
imp_trust_own_pkg ImportAvails
imports) SafeHaskellMode
safe_mode [Usage]
usages
Maybe Docs
docs ModSummary
mod_summary
ModDetails
mod_details
HscEnv
-> PartialModIface
-> Maybe StgCgInfos
-> Maybe CmmCgInfos
-> IO ModIface
mkFullIface HscEnv
hsc_env PartialModIface
partial_iface Maybe StgCgInfos
forall a. Maybe a
Nothing Maybe CmmCgInfos
forall a. Maybe a
Nothing
mkIface_ :: HscEnv -> Module -> CoreProgram -> HscSource
-> Bool -> Dependencies -> GlobalRdrEnv
-> NameEnv FixItem -> Warnings GhcRn -> HpcInfo
-> Bool
-> SafeHaskellMode
-> [Usage]
-> Maybe Docs
-> ModSummary
-> ModDetails
-> PartialModIface
mkIface_ :: HscEnv
-> Module
-> CoreProgram
-> HscSource
-> Bool
-> Dependencies
-> GlobalRdrEnv
-> FixityEnv
-> Warnings GhcRn
-> HpcInfo
-> Bool
-> SafeHaskellMode
-> [Usage]
-> Maybe Docs
-> ModSummary
-> ModDetails
-> PartialModIface
mkIface_ HscEnv
hsc_env
Module
this_mod CoreProgram
core_prog HscSource
hsc_src Bool
used_th Dependencies
deps GlobalRdrEnv
rdr_env FixityEnv
fix_env Warnings GhcRn
src_warns
HpcInfo
hpc_info Bool
pkg_trust_req SafeHaskellMode
safe_mode [Usage]
usages
Maybe Docs
docs ModSummary
mod_summary
ModDetails{ md_insts :: ModDetails -> InstEnv
md_insts = InstEnv
insts,
md_fam_insts :: ModDetails -> [FamInst]
md_fam_insts = [FamInst]
fam_insts,
md_rules :: ModDetails -> [CoreRule]
md_rules = [CoreRule]
rules,
md_anns :: ModDetails -> [Annotation]
md_anns = [Annotation]
anns,
md_types :: ModDetails -> TypeEnv
md_types = TypeEnv
type_env,
md_exports :: ModDetails -> [AvailInfo]
md_exports = [AvailInfo]
exports,
md_complete_matches :: ModDetails -> [CompleteMatch]
md_complete_matches = [CompleteMatch]
complete_matches }
= do
let home_unit :: HomeUnit
home_unit = HscEnv -> HomeUnit
hsc_home_unit HscEnv
hsc_env
semantic_mod :: Module
semantic_mod = HomeUnit -> ModuleName -> Module
homeModuleNameInstantiation HomeUnit
home_unit (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
this_mod)
entities :: [TyThing]
entities = TypeEnv -> [TyThing]
typeEnvElts TypeEnv
type_env
show_linear_types :: Bool
show_linear_types = Extension -> DynFlags -> Bool
xopt Extension
LangExt.LinearTypes (HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env)
extra_decls :: Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
extra_decls = if GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_WriteIfSimplifiedCore DynFlags
dflags then [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
-> Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
forall a. a -> Maybe a
Just [ Bind TyCoVar -> IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo
toIfaceTopBind Bind TyCoVar
b | Bind TyCoVar
b <- CoreProgram
core_prog ]
else Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
forall a. Maybe a
Nothing
decls :: [IfaceDecl]
decls = [ Bool -> TyThing -> IfaceDecl
tyThingToIfaceDecl Bool
show_linear_types TyThing
entity
| TyThing
entity <- [TyThing]
entities,
let name :: Name
name = TyThing -> Name
forall a. NamedThing a => a -> Name
getName TyThing
entity,
Bool -> Bool
not (TyThing -> Bool
isImplicitTyThing TyThing
entity),
Bool -> Bool
not (Name -> Bool
isWiredInName Name
name),
Module -> Name -> Bool
nameIsLocalOrFrom Module
semantic_mod Name
name ]
fixities :: [(OccName, Fixity)]
fixities = ((OccName, Fixity) -> (OccName, Fixity) -> Ordering)
-> [(OccName, Fixity)] -> [(OccName, Fixity)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((OccName, Fixity) -> OccName)
-> (OccName, Fixity) -> (OccName, Fixity) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (OccName, Fixity) -> OccName
forall a b. (a, b) -> a
fst)
[(OccName
occ,Fixity
fix) | FixItem OccName
occ Fixity
fix <- FixityEnv -> [FixItem]
forall a. NameEnv a -> [a]
nonDetNameEnvElts FixityEnv
fix_env]
warns :: Warnings GhcRn
warns = Warnings GhcRn
src_warns
iface_rules :: [IfaceRule]
iface_rules = (CoreRule -> IfaceRule) -> [CoreRule] -> [IfaceRule]
forall a b. (a -> b) -> [a] -> [b]
map CoreRule -> IfaceRule
coreRuleToIfaceRule [CoreRule]
rules
iface_insts :: [IfaceClsInst]
iface_insts = (ClsInst -> IfaceClsInst) -> [ClsInst] -> [IfaceClsInst]
forall a b. (a -> b) -> [a] -> [b]
map ClsInst -> IfaceClsInst
instanceToIfaceInst ([ClsInst] -> [IfaceClsInst]) -> [ClsInst] -> [IfaceClsInst]
forall a b. (a -> b) -> a -> b
$ SafeHaskellMode -> [ClsInst] -> [ClsInst]
fixSafeInstances SafeHaskellMode
safe_mode (InstEnv -> [ClsInst]
instEnvElts InstEnv
insts)
iface_fam_insts :: [IfaceFamInst]
iface_fam_insts = (FamInst -> IfaceFamInst) -> [FamInst] -> [IfaceFamInst]
forall a b. (a -> b) -> [a] -> [b]
map FamInst -> IfaceFamInst
famInstToIfaceFamInst [FamInst]
fam_insts
trust_info :: IfaceTrustInfo
trust_info = SafeHaskellMode -> IfaceTrustInfo
setSafeMode SafeHaskellMode
safe_mode
annotations :: [IfaceAnnotation]
annotations = (Annotation -> IfaceAnnotation)
-> [Annotation] -> [IfaceAnnotation]
forall a b. (a -> b) -> [a] -> [b]
map Annotation -> IfaceAnnotation
mkIfaceAnnotation [Annotation]
anns
icomplete_matches :: [IfaceCompleteMatch]
icomplete_matches = (CompleteMatch -> IfaceCompleteMatch)
-> [CompleteMatch] -> [IfaceCompleteMatch]
forall a b. (a -> b) -> [a] -> [b]
map CompleteMatch -> IfaceCompleteMatch
mkIfaceCompleteMatch [CompleteMatch]
complete_matches
ModIface {
mi_module :: Module
mi_module = Module
this_mod,
mi_sig_of :: Maybe Module
mi_sig_of = if Module
semantic_mod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
this_mod
then Maybe Module
forall a. Maybe a
Nothing
else Module -> Maybe Module
forall a. a -> Maybe a
Just Module
semantic_mod,
mi_hsc_src :: HscSource
mi_hsc_src = HscSource
hsc_src,
mi_deps :: Dependencies
mi_deps = Dependencies
deps,
mi_usages :: [Usage]
mi_usages = [Usage]
usages,
mi_exports :: [AvailInfo]
mi_exports = [AvailInfo] -> [AvailInfo]
mkIfaceExports [AvailInfo]
exports,
mi_insts :: [IfaceClsInst]
mi_insts = (IfaceClsInst -> IfaceClsInst -> Ordering)
-> [IfaceClsInst] -> [IfaceClsInst]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy IfaceClsInst -> IfaceClsInst -> Ordering
cmp_inst [IfaceClsInst]
iface_insts,
mi_fam_insts :: [IfaceFamInst]
mi_fam_insts = (IfaceFamInst -> IfaceFamInst -> Ordering)
-> [IfaceFamInst] -> [IfaceFamInst]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy IfaceFamInst -> IfaceFamInst -> Ordering
cmp_fam_inst [IfaceFamInst]
iface_fam_insts,
mi_rules :: [IfaceRule]
mi_rules = (IfaceRule -> IfaceRule -> Ordering) -> [IfaceRule] -> [IfaceRule]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy IfaceRule -> IfaceRule -> Ordering
cmp_rule [IfaceRule]
iface_rules,
mi_fixities :: [(OccName, Fixity)]
mi_fixities = [(OccName, Fixity)]
fixities,
mi_warns :: Warnings GhcRn
mi_warns = Warnings GhcRn
warns,
mi_anns :: [IfaceAnnotation]
mi_anns = [IfaceAnnotation]
annotations,
mi_globals :: Maybe GlobalRdrEnv
mi_globals = GlobalRdrEnv -> Maybe GlobalRdrEnv
maybeGlobalRdrEnv GlobalRdrEnv
rdr_env,
mi_used_th :: Bool
mi_used_th = Bool
used_th,
mi_decls :: [IfaceDeclExts 'ModIfaceCore]
mi_decls = [IfaceDecl]
[IfaceDeclExts 'ModIfaceCore]
decls,
mi_extra_decls :: Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
mi_extra_decls = Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
extra_decls,
mi_hpc :: Bool
mi_hpc = HpcInfo -> Bool
isHpcUsed HpcInfo
hpc_info,
mi_trust :: IfaceTrustInfo
mi_trust = IfaceTrustInfo
trust_info,
mi_trust_pkg :: Bool
mi_trust_pkg = Bool
pkg_trust_req,
mi_complete_matches :: [IfaceCompleteMatch]
mi_complete_matches = [IfaceCompleteMatch]
icomplete_matches,
mi_docs :: Maybe Docs
mi_docs = Maybe Docs
docs,
mi_final_exts :: IfaceBackendExts 'ModIfaceCore
mi_final_exts = (),
mi_ext_fields :: ExtensibleFields
mi_ext_fields = ExtensibleFields
emptyExtensibleFields,
mi_src_hash :: Fingerprint
mi_src_hash = ModSummary -> Fingerprint
ms_hs_hash ModSummary
mod_summary
}
where
cmp_rule :: IfaceRule -> IfaceRule -> Ordering
cmp_rule = FastString -> FastString -> Ordering
lexicalCompareFS (FastString -> FastString -> Ordering)
-> (IfaceRule -> FastString) -> IfaceRule -> IfaceRule -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` IfaceRule -> FastString
ifRuleName
cmp_inst :: IfaceClsInst -> IfaceClsInst -> Ordering
cmp_inst = (IfaceClsInst -> OccName)
-> IfaceClsInst -> IfaceClsInst -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Name -> OccName
nameOccName (Name -> OccName)
-> (IfaceClsInst -> Name) -> IfaceClsInst -> OccName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IfaceClsInst -> Name
ifDFun)
cmp_fam_inst :: IfaceFamInst -> IfaceFamInst -> Ordering
cmp_fam_inst = (IfaceFamInst -> OccName)
-> IfaceFamInst -> IfaceFamInst -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Name -> OccName
nameOccName (Name -> OccName)
-> (IfaceFamInst -> Name) -> IfaceFamInst -> OccName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IfaceFamInst -> Name
ifFamInstTcName)
dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
maybeGlobalRdrEnv :: GlobalRdrEnv -> Maybe GlobalRdrEnv
maybeGlobalRdrEnv :: GlobalRdrEnv -> Maybe GlobalRdrEnv
maybeGlobalRdrEnv GlobalRdrEnv
rdr_env
| Backend -> Bool
backendWantsGlobalBindings (DynFlags -> Backend
backend DynFlags
dflags) = GlobalRdrEnv -> Maybe GlobalRdrEnv
forall a. a -> Maybe a
Just GlobalRdrEnv
rdr_env
| Bool
otherwise = Maybe GlobalRdrEnv
forall a. Maybe a
Nothing
ifFamInstTcName :: IfaceFamInst -> Name
ifFamInstTcName = IfaceFamInst -> Name
ifFamInstFam
mkIfaceCompleteMatch :: CompleteMatch -> IfaceCompleteMatch
mkIfaceCompleteMatch :: CompleteMatch -> IfaceCompleteMatch
mkIfaceCompleteMatch (CompleteMatch UniqDSet ConLike
cls Maybe TyCon
mtc) =
[Name] -> Maybe IfaceTyCon -> IfaceCompleteMatch
IfaceCompleteMatch ((ConLike -> Name) -> [ConLike] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map ConLike -> Name
conLikeName (UniqDSet ConLike -> [ConLike]
forall a. UniqDSet a -> [a]
uniqDSetToList UniqDSet ConLike
cls)) (TyCon -> IfaceTyCon
toIfaceTyCon (TyCon -> IfaceTyCon) -> Maybe TyCon -> Maybe IfaceTyCon
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe TyCon
mtc)
mkIfaceAnnotation :: Annotation -> IfaceAnnotation
mkIfaceAnnotation :: Annotation -> IfaceAnnotation
mkIfaceAnnotation (Annotation { ann_target :: Annotation -> CoreAnnTarget
ann_target = CoreAnnTarget
target, ann_value :: Annotation -> AnnPayload
ann_value = AnnPayload
payload })
= IfaceAnnotation {
ifAnnotatedTarget :: IfaceAnnTarget
ifAnnotatedTarget = (Name -> OccName) -> CoreAnnTarget -> IfaceAnnTarget
forall a b. (a -> b) -> AnnTarget a -> AnnTarget b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Name -> OccName
nameOccName CoreAnnTarget
target,
ifAnnotatedValue :: AnnPayload
ifAnnotatedValue = AnnPayload
payload
}
mkIfaceExports :: [AvailInfo] -> [IfaceExport]
mkIfaceExports :: [AvailInfo] -> [AvailInfo]
mkIfaceExports [AvailInfo]
exports
= (AvailInfo -> AvailInfo -> Ordering) -> [AvailInfo] -> [AvailInfo]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy AvailInfo -> AvailInfo -> Ordering
stableAvailCmp ((AvailInfo -> AvailInfo) -> [AvailInfo] -> [AvailInfo]
forall a b. (a -> b) -> [a] -> [b]
map AvailInfo -> AvailInfo
sort_subs [AvailInfo]
exports)
where
sort_subs :: AvailInfo -> AvailInfo
sort_subs :: AvailInfo -> AvailInfo
sort_subs (Avail GreName
n) = GreName -> AvailInfo
Avail GreName
n
sort_subs (AvailTC Name
n []) = Name -> [GreName] -> AvailInfo
AvailTC Name
n []
sort_subs (AvailTC Name
n (GreName
m:[GreName]
ms))
| Name -> GreName
NormalGreName Name
nGreName -> GreName -> Bool
forall a. Eq a => a -> a -> Bool
==GreName
m = Name -> [GreName] -> AvailInfo
AvailTC Name
n (GreName
mGreName -> [GreName] -> [GreName]
forall a. a -> [a] -> [a]
:(GreName -> GreName -> Ordering) -> [GreName] -> [GreName]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy GreName -> GreName -> Ordering
stableGreNameCmp [GreName]
ms)
| Bool
otherwise = Name -> [GreName] -> AvailInfo
AvailTC Name
n ((GreName -> GreName -> Ordering) -> [GreName] -> [GreName]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy GreName -> GreName -> Ordering
stableGreNameCmp (GreName
mGreName -> [GreName] -> [GreName]
forall a. a -> [a] -> [a]
:[GreName]
ms))
tyThingToIfaceDecl :: Bool -> TyThing -> IfaceDecl
tyThingToIfaceDecl :: Bool -> TyThing -> IfaceDecl
tyThingToIfaceDecl Bool
_ (AnId TyCoVar
id) = TyCoVar -> IfaceDecl
idToIfaceDecl TyCoVar
id
tyThingToIfaceDecl Bool
_ (ATyCon TyCon
tycon) = (TidyEnv, IfaceDecl) -> IfaceDecl
forall a b. (a, b) -> b
snd (TidyEnv -> TyCon -> (TidyEnv, IfaceDecl)
tyConToIfaceDecl TidyEnv
emptyTidyEnv TyCon
tycon)
tyThingToIfaceDecl Bool
_ (ACoAxiom CoAxiom Branched
ax) = CoAxiom Branched -> IfaceDecl
forall (br :: BranchFlag). CoAxiom br -> IfaceDecl
coAxiomToIfaceDecl CoAxiom Branched
ax
tyThingToIfaceDecl Bool
show_linear_types (AConLike ConLike
cl) = case ConLike
cl of
RealDataCon DataCon
dc -> Bool -> DataCon -> IfaceDecl
dataConToIfaceDecl Bool
show_linear_types DataCon
dc
PatSynCon PatSyn
ps -> PatSyn -> IfaceDecl
patSynToIfaceDecl PatSyn
ps
idToIfaceDecl :: Id -> IfaceDecl
idToIfaceDecl :: TyCoVar -> IfaceDecl
idToIfaceDecl TyCoVar
id
= IfaceId { ifName :: Name
ifName = TyCoVar -> Name
forall a. NamedThing a => a -> Name
getName TyCoVar
id,
ifType :: IfaceType
ifType = Type -> IfaceType
toIfaceType (TyCoVar -> Type
idType TyCoVar
id),
ifIdDetails :: IfaceIdDetails
ifIdDetails = IdDetails -> IfaceIdDetails
toIfaceIdDetails (TyCoVar -> IdDetails
idDetails TyCoVar
id),
ifIdInfo :: IfaceIdInfo
ifIdInfo = IdInfo -> IfaceIdInfo
toIfaceIdInfo ((() :: Constraint) => TyCoVar -> IdInfo
TyCoVar -> IdInfo
idInfo TyCoVar
id) }
dataConToIfaceDecl :: Bool -> DataCon -> IfaceDecl
dataConToIfaceDecl :: Bool -> DataCon -> IfaceDecl
dataConToIfaceDecl Bool
show_linear_types DataCon
dataCon
= IfaceId { ifName :: Name
ifName = DataCon -> Name
forall a. NamedThing a => a -> Name
getName DataCon
dataCon,
ifType :: IfaceType
ifType = Type -> IfaceType
toIfaceType (Bool -> DataCon -> Type
dataConDisplayType Bool
show_linear_types DataCon
dataCon),
ifIdDetails :: IfaceIdDetails
ifIdDetails = IfaceIdDetails
IfVanillaId,
ifIdInfo :: IfaceIdInfo
ifIdInfo = [] }
coAxiomToIfaceDecl :: CoAxiom br -> IfaceDecl
coAxiomToIfaceDecl :: forall (br :: BranchFlag). CoAxiom br -> IfaceDecl
coAxiomToIfaceDecl ax :: CoAxiom br
ax@(CoAxiom { co_ax_tc :: forall (br :: BranchFlag). CoAxiom br -> TyCon
co_ax_tc = TyCon
tycon, co_ax_branches :: forall (br :: BranchFlag). CoAxiom br -> Branches br
co_ax_branches = Branches br
branches
, co_ax_role :: forall (br :: BranchFlag). CoAxiom br -> Role
co_ax_role = Role
role })
= IfaceAxiom { ifName :: Name
ifName = CoAxiom br -> Name
forall a. NamedThing a => a -> Name
getName CoAxiom br
ax
, ifTyCon :: IfaceTyCon
ifTyCon = TyCon -> IfaceTyCon
toIfaceTyCon TyCon
tycon
, ifRole :: Role
ifRole = Role
role
, ifAxBranches :: [IfaceAxBranch]
ifAxBranches = (CoAxBranch -> IfaceAxBranch) -> [CoAxBranch] -> [IfaceAxBranch]
forall a b. (a -> b) -> [a] -> [b]
map (TyCon -> [[Type]] -> CoAxBranch -> IfaceAxBranch
coAxBranchToIfaceBranch TyCon
tycon
((CoAxBranch -> [Type]) -> [CoAxBranch] -> [[Type]]
forall a b. (a -> b) -> [a] -> [b]
map CoAxBranch -> [Type]
coAxBranchLHS [CoAxBranch]
branch_list))
[CoAxBranch]
branch_list }
where
branch_list :: [CoAxBranch]
branch_list = Branches br -> [CoAxBranch]
forall (br :: BranchFlag). Branches br -> [CoAxBranch]
fromBranches Branches br
branches
coAxBranchToIfaceBranch :: TyCon -> [[Type]] -> CoAxBranch -> IfaceAxBranch
coAxBranchToIfaceBranch :: TyCon -> [[Type]] -> CoAxBranch -> IfaceAxBranch
coAxBranchToIfaceBranch TyCon
tc [[Type]]
lhs_s
(CoAxBranch { cab_tvs :: CoAxBranch -> [TyCoVar]
cab_tvs = [TyCoVar]
tvs, cab_cvs :: CoAxBranch -> [TyCoVar]
cab_cvs = [TyCoVar]
cvs
, cab_eta_tvs :: CoAxBranch -> [TyCoVar]
cab_eta_tvs = [TyCoVar]
eta_tvs
, cab_lhs :: CoAxBranch -> [Type]
cab_lhs = [Type]
lhs, cab_roles :: CoAxBranch -> [Role]
cab_roles = [Role]
roles
, cab_rhs :: CoAxBranch -> Type
cab_rhs = Type
rhs, cab_incomps :: CoAxBranch -> [CoAxBranch]
cab_incomps = [CoAxBranch]
incomps })
= IfaceAxBranch { ifaxbTyVars :: [IfaceTvBndr]
ifaxbTyVars = [TyCoVar] -> [IfaceTvBndr]
toIfaceTvBndrs [TyCoVar]
tvs
, ifaxbCoVars :: [IfaceIdBndr]
ifaxbCoVars = (TyCoVar -> IfaceIdBndr) -> [TyCoVar] -> [IfaceIdBndr]
forall a b. (a -> b) -> [a] -> [b]
map TyCoVar -> IfaceIdBndr
toIfaceIdBndr [TyCoVar]
cvs
, ifaxbEtaTyVars :: [IfaceTvBndr]
ifaxbEtaTyVars = [TyCoVar] -> [IfaceTvBndr]
toIfaceTvBndrs [TyCoVar]
eta_tvs
, ifaxbLHS :: IfaceAppArgs
ifaxbLHS = TyCon -> [Type] -> IfaceAppArgs
toIfaceTcArgs TyCon
tc [Type]
lhs
, ifaxbRoles :: [Role]
ifaxbRoles = [Role]
roles
, ifaxbRHS :: IfaceType
ifaxbRHS = Type -> IfaceType
toIfaceType Type
rhs
, ifaxbIncomps :: [BranchIndex]
ifaxbIncomps = [BranchIndex]
iface_incomps }
where
iface_incomps :: [BranchIndex]
iface_incomps = (CoAxBranch -> BranchIndex) -> [CoAxBranch] -> [BranchIndex]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Maybe BranchIndex -> BranchIndex
forall a. HasCallStack => String -> Maybe a -> a
expectJust String
"iface_incomps"
(Maybe BranchIndex -> BranchIndex)
-> (CoAxBranch -> Maybe BranchIndex) -> CoAxBranch -> BranchIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Type] -> Bool) -> [[Type]] -> Maybe BranchIndex)
-> [[Type]] -> ([Type] -> Bool) -> Maybe BranchIndex
forall a b c. (a -> b -> c) -> b -> a -> c
flip ([Type] -> Bool) -> [[Type]] -> Maybe BranchIndex
forall a. (a -> Bool) -> [a] -> Maybe BranchIndex
findIndex [[Type]]
lhs_s
(([Type] -> Bool) -> Maybe BranchIndex)
-> (CoAxBranch -> [Type] -> Bool)
-> CoAxBranch
-> Maybe BranchIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Type] -> [Type] -> Bool
eqTypes
([Type] -> [Type] -> Bool)
-> (CoAxBranch -> [Type]) -> CoAxBranch -> [Type] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoAxBranch -> [Type]
coAxBranchLHS) [CoAxBranch]
incomps
tyConToIfaceDecl :: TidyEnv -> TyCon -> (TidyEnv, IfaceDecl)
tyConToIfaceDecl :: TidyEnv -> TyCon -> (TidyEnv, IfaceDecl)
tyConToIfaceDecl TidyEnv
env TyCon
tycon
| Just Class
clas <- TyCon -> Maybe Class
tyConClass_maybe TyCon
tycon
= TidyEnv -> Class -> (TidyEnv, IfaceDecl)
classToIfaceDecl TidyEnv
env Class
clas
| Just Type
syn_rhs <- TyCon -> Maybe Type
synTyConRhs_maybe TyCon
tycon
= ( TidyEnv
tc_env1
, IfaceSynonym { ifName :: Name
ifName = TyCon -> Name
forall a. NamedThing a => a -> Name
getName TyCon
tycon,
ifRoles :: [Role]
ifRoles = TyCon -> [Role]
tyConRoles TyCon
tycon,
ifSynRhs :: IfaceType
ifSynRhs = Type -> IfaceType
if_syn_type Type
syn_rhs,
ifBinders :: [IfaceTyConBinder]
ifBinders = [IfaceTyConBinder]
if_binders,
ifResKind :: IfaceType
ifResKind = IfaceType
if_res_kind
})
| Just FamTyConFlav
fam_flav <- TyCon -> Maybe FamTyConFlav
famTyConFlav_maybe TyCon
tycon
= ( TidyEnv
tc_env1
, IfaceFamily { ifName :: Name
ifName = TyCon -> Name
forall a. NamedThing a => a -> Name
getName TyCon
tycon,
ifResVar :: Maybe FastString
ifResVar = Maybe FastString
if_res_var,
ifFamFlav :: IfaceFamTyConFlav
ifFamFlav = FamTyConFlav -> IfaceFamTyConFlav
to_if_fam_flav FamTyConFlav
fam_flav,
ifBinders :: [IfaceTyConBinder]
ifBinders = [IfaceTyConBinder]
if_binders,
ifResKind :: IfaceType
ifResKind = IfaceType
if_res_kind,
ifFamInj :: Injectivity
ifFamInj = TyCon -> Injectivity
tyConInjectivityInfo TyCon
tycon
})
| TyCon -> Bool
isAlgTyCon TyCon
tycon
= ( TidyEnv
tc_env1
, IfaceData { ifName :: Name
ifName = TyCon -> Name
forall a. NamedThing a => a -> Name
getName TyCon
tycon,
ifBinders :: [IfaceTyConBinder]
ifBinders = [IfaceTyConBinder]
if_binders,
ifResKind :: IfaceType
ifResKind = IfaceType
if_res_kind,
ifCType :: Maybe CType
ifCType = TyCon -> Maybe CType
tyConCType_maybe TyCon
tycon,
ifRoles :: [Role]
ifRoles = TyCon -> [Role]
tyConRoles TyCon
tycon,
ifCtxt :: IfaceContext
ifCtxt = TidyEnv -> [Type] -> IfaceContext
tidyToIfaceContext TidyEnv
tc_env1 (TyCon -> [Type]
tyConStupidTheta TyCon
tycon),
ifCons :: IfaceConDecls
ifCons = AlgTyConRhs -> IfaceConDecls
ifaceConDecls (TyCon -> AlgTyConRhs
algTyConRhs TyCon
tycon),
ifGadtSyntax :: Bool
ifGadtSyntax = TyCon -> Bool
isGadtSyntaxTyCon TyCon
tycon,
ifParent :: IfaceTyConParent
ifParent = IfaceTyConParent
parent })
| Bool
otherwise
= ( TidyEnv
env
, IfaceData { ifName :: Name
ifName = TyCon -> Name
forall a. NamedThing a => a -> Name
getName TyCon
tycon,
ifBinders :: [IfaceTyConBinder]
ifBinders = [IfaceTyConBinder]
if_binders,
ifResKind :: IfaceType
ifResKind = IfaceType
if_res_kind,
ifCType :: Maybe CType
ifCType = Maybe CType
forall a. Maybe a
Nothing,
ifRoles :: [Role]
ifRoles = TyCon -> [Role]
tyConRoles TyCon
tycon,
ifCtxt :: IfaceContext
ifCtxt = [],
ifCons :: IfaceConDecls
ifCons = Bool -> [IfaceConDecl] -> IfaceConDecls
IfDataTyCon Bool
False [],
ifGadtSyntax :: Bool
ifGadtSyntax = Bool
False,
ifParent :: IfaceTyConParent
ifParent = IfaceTyConParent
IfNoParent })
where
(TidyEnv
tc_env1, [TyConBinder]
tc_binders) = TidyEnv -> [TyConBinder] -> (TidyEnv, [TyConBinder])
tidyTyConBinders TidyEnv
env (TyCon -> [TyConBinder]
tyConBinders TyCon
tycon)
tc_tyvars :: [TyCoVar]
tc_tyvars = [TyConBinder] -> [TyCoVar]
forall tv argf. [VarBndr tv argf] -> [tv]
binderVars [TyConBinder]
tc_binders
if_binders :: [IfaceTyConBinder]
if_binders = [TyConBinder] -> [IfaceTyConBinder]
forall vis. [VarBndr TyCoVar vis] -> [VarBndr IfaceBndr vis]
toIfaceForAllBndrs [TyConBinder]
tc_binders
if_res_kind :: IfaceType
if_res_kind = TidyEnv -> Type -> IfaceType
tidyToIfaceType TidyEnv
tc_env1 (TyCon -> Type
tyConResKind TyCon
tycon)
if_syn_type :: Type -> IfaceType
if_syn_type Type
ty = TidyEnv -> Type -> IfaceType
tidyToIfaceType TidyEnv
tc_env1 Type
ty
if_res_var :: Maybe FastString
if_res_var = Name -> FastString
forall a. NamedThing a => a -> FastString
getOccFS (Name -> FastString) -> Maybe Name -> Maybe FastString
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` TyCon -> Maybe Name
tyConFamilyResVar_maybe TyCon
tycon
parent :: IfaceTyConParent
parent = case TyCon -> Maybe (TyCon, [Type], CoAxiom Unbranched)
tyConFamInstSig_maybe TyCon
tycon of
Just (TyCon
tc, [Type]
ty, CoAxiom Unbranched
ax) -> Name -> IfaceTyCon -> IfaceAppArgs -> IfaceTyConParent
IfDataInstance (CoAxiom Unbranched -> Name
forall (br :: BranchFlag). CoAxiom br -> Name
coAxiomName CoAxiom Unbranched
ax)
(TyCon -> IfaceTyCon
toIfaceTyCon TyCon
tc)
(TidyEnv -> TyCon -> [Type] -> IfaceAppArgs
tidyToIfaceTcArgs TidyEnv
tc_env1 TyCon
tc [Type]
ty)
Maybe (TyCon, [Type], CoAxiom Unbranched)
Nothing -> IfaceTyConParent
IfNoParent
to_if_fam_flav :: FamTyConFlav -> IfaceFamTyConFlav
to_if_fam_flav FamTyConFlav
OpenSynFamilyTyCon = IfaceFamTyConFlav
IfaceOpenSynFamilyTyCon
to_if_fam_flav FamTyConFlav
AbstractClosedSynFamilyTyCon = IfaceFamTyConFlav
IfaceAbstractClosedSynFamilyTyCon
to_if_fam_flav (DataFamilyTyCon {}) = IfaceFamTyConFlav
IfaceDataFamilyTyCon
to_if_fam_flav (BuiltInSynFamTyCon {}) = IfaceFamTyConFlav
IfaceBuiltInSynFamTyCon
to_if_fam_flav (ClosedSynFamilyTyCon Maybe (CoAxiom Branched)
Nothing) = Maybe (Name, [IfaceAxBranch]) -> IfaceFamTyConFlav
IfaceClosedSynFamilyTyCon Maybe (Name, [IfaceAxBranch])
forall a. Maybe a
Nothing
to_if_fam_flav (ClosedSynFamilyTyCon (Just CoAxiom Branched
ax))
= Maybe (Name, [IfaceAxBranch]) -> IfaceFamTyConFlav
IfaceClosedSynFamilyTyCon ((Name, [IfaceAxBranch]) -> Maybe (Name, [IfaceAxBranch])
forall a. a -> Maybe a
Just (Name
axn, [IfaceAxBranch]
ibr))
where defs :: [CoAxBranch]
defs = Branches Branched -> [CoAxBranch]
forall (br :: BranchFlag). Branches br -> [CoAxBranch]
fromBranches (Branches Branched -> [CoAxBranch])
-> Branches Branched -> [CoAxBranch]
forall a b. (a -> b) -> a -> b
$ CoAxiom Branched -> Branches Branched
forall (br :: BranchFlag). CoAxiom br -> Branches br
coAxiomBranches CoAxiom Branched
ax
lhss :: [[Type]]
lhss = (CoAxBranch -> [Type]) -> [CoAxBranch] -> [[Type]]
forall a b. (a -> b) -> [a] -> [b]
map CoAxBranch -> [Type]
coAxBranchLHS [CoAxBranch]
defs
ibr :: [IfaceAxBranch]
ibr = (CoAxBranch -> IfaceAxBranch) -> [CoAxBranch] -> [IfaceAxBranch]
forall a b. (a -> b) -> [a] -> [b]
map (TyCon -> [[Type]] -> CoAxBranch -> IfaceAxBranch
coAxBranchToIfaceBranch TyCon
tycon [[Type]]
lhss) [CoAxBranch]
defs
axn :: Name
axn = CoAxiom Branched -> Name
forall (br :: BranchFlag). CoAxiom br -> Name
coAxiomName CoAxiom Branched
ax
ifaceConDecls :: AlgTyConRhs -> IfaceConDecls
ifaceConDecls (NewTyCon { data_con :: AlgTyConRhs -> DataCon
data_con = DataCon
con }) = IfaceConDecl -> IfaceConDecls
IfNewTyCon (DataCon -> IfaceConDecl
ifaceConDecl DataCon
con)
ifaceConDecls (DataTyCon { data_cons :: AlgTyConRhs -> [DataCon]
data_cons = [DataCon]
cons, is_type_data :: AlgTyConRhs -> Bool
is_type_data = Bool
type_data })
= Bool -> [IfaceConDecl] -> IfaceConDecls
IfDataTyCon Bool
type_data ((DataCon -> IfaceConDecl) -> [DataCon] -> [IfaceConDecl]
forall a b. (a -> b) -> [a] -> [b]
map DataCon -> IfaceConDecl
ifaceConDecl [DataCon]
cons)
ifaceConDecls (TupleTyCon { data_con :: AlgTyConRhs -> DataCon
data_con = DataCon
con }) = Bool -> [IfaceConDecl] -> IfaceConDecls
IfDataTyCon Bool
False [DataCon -> IfaceConDecl
ifaceConDecl DataCon
con]
ifaceConDecls (SumTyCon { data_cons :: AlgTyConRhs -> [DataCon]
data_cons = [DataCon]
cons }) = Bool -> [IfaceConDecl] -> IfaceConDecls
IfDataTyCon Bool
False ((DataCon -> IfaceConDecl) -> [DataCon] -> [IfaceConDecl]
forall a b. (a -> b) -> [a] -> [b]
map DataCon -> IfaceConDecl
ifaceConDecl [DataCon]
cons)
ifaceConDecls AlgTyConRhs
AbstractTyCon = IfaceConDecls
IfAbstractTyCon
ifaceConDecl :: DataCon -> IfaceConDecl
ifaceConDecl DataCon
data_con
= IfCon { ifConName :: Name
ifConName = DataCon -> Name
dataConName DataCon
data_con,
ifConInfix :: Bool
ifConInfix = DataCon -> Bool
dataConIsInfix DataCon
data_con,
ifConWrapper :: Bool
ifConWrapper = Maybe TyCoVar -> Bool
forall a. Maybe a -> Bool
isJust (DataCon -> Maybe TyCoVar
dataConWrapId_maybe DataCon
data_con),
ifConExTCvs :: [IfaceBndr]
ifConExTCvs = (TyCoVar -> IfaceBndr) -> [TyCoVar] -> [IfaceBndr]
forall a b. (a -> b) -> [a] -> [b]
map TyCoVar -> IfaceBndr
toIfaceBndr [TyCoVar]
ex_tvs',
ifConUserTvBinders :: [IfaceForAllSpecBndr]
ifConUserTvBinders = [VarBndr TyCoVar Specificity] -> [IfaceForAllSpecBndr]
forall vis. [VarBndr TyCoVar vis] -> [VarBndr IfaceBndr vis]
toIfaceForAllBndrs [VarBndr TyCoVar Specificity]
user_bndrs',
ifConEqSpec :: [IfaceTvBndr]
ifConEqSpec = (EqSpec -> IfaceTvBndr) -> [EqSpec] -> [IfaceTvBndr]
forall a b. (a -> b) -> [a] -> [b]
map ((TyCoVar, Type) -> IfaceTvBndr
to_eq_spec ((TyCoVar, Type) -> IfaceTvBndr)
-> (EqSpec -> (TyCoVar, Type)) -> EqSpec -> IfaceTvBndr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EqSpec -> (TyCoVar, Type)
eqSpecPair) [EqSpec]
eq_spec,
ifConCtxt :: IfaceContext
ifConCtxt = TidyEnv -> [Type] -> IfaceContext
tidyToIfaceContext TidyEnv
con_env2 [Type]
theta,
ifConArgTys :: [(IfaceType, IfaceType)]
ifConArgTys =
(Scaled Type -> (IfaceType, IfaceType))
-> [Scaled Type] -> [(IfaceType, IfaceType)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Scaled Type
w Type
t) -> (TidyEnv -> Type -> IfaceType
tidyToIfaceType TidyEnv
con_env2 Type
w
, (TidyEnv -> Type -> IfaceType
tidyToIfaceType TidyEnv
con_env2 Type
t))) [Scaled Type]
arg_tys,
ifConFields :: [FieldLabel]
ifConFields = DataCon -> [FieldLabel]
dataConFieldLabels DataCon
data_con,
ifConStricts :: [IfaceBang]
ifConStricts = (HsImplBang -> IfaceBang) -> [HsImplBang] -> [IfaceBang]
forall a b. (a -> b) -> [a] -> [b]
map (TidyEnv -> HsImplBang -> IfaceBang
toIfaceBang TidyEnv
con_env2)
(DataCon -> [HsImplBang]
dataConImplBangs DataCon
data_con),
ifConSrcStricts :: [IfaceSrcBang]
ifConSrcStricts = (HsSrcBang -> IfaceSrcBang) -> [HsSrcBang] -> [IfaceSrcBang]
forall a b. (a -> b) -> [a] -> [b]
map HsSrcBang -> IfaceSrcBang
toIfaceSrcBang
(DataCon -> [HsSrcBang]
dataConSrcBangs DataCon
data_con)}
where
([TyCoVar]
univ_tvs, [TyCoVar]
ex_tvs, [EqSpec]
eq_spec, [Type]
theta, [Scaled Type]
arg_tys, Type
_)
= DataCon
-> ([TyCoVar], [TyCoVar], [EqSpec], [Type], [Scaled Type], Type)
dataConFullSig DataCon
data_con
user_bndrs :: [VarBndr TyCoVar Specificity]
user_bndrs = DataCon -> [VarBndr TyCoVar Specificity]
dataConUserTyVarBinders DataCon
data_con
con_env1 :: TidyEnv
con_env1 = (TidyEnv -> TidyOccEnv
forall a b. (a, b) -> a
fst TidyEnv
tc_env1, [(TyCoVar, TyCoVar)] -> VarEnv TyCoVar
forall a. [(TyCoVar, a)] -> VarEnv a
mkVarEnv (String -> [TyCoVar] -> [TyCoVar] -> [(TyCoVar, TyCoVar)]
forall a b. (() :: Constraint) => String -> [a] -> [b] -> [(a, b)]
zipEqual String
"ifaceConDecl" [TyCoVar]
univ_tvs [TyCoVar]
tc_tyvars))
(TidyEnv
con_env2, [TyCoVar]
ex_tvs') = TidyEnv -> [TyCoVar] -> (TidyEnv, [TyCoVar])
tidyVarBndrs TidyEnv
con_env1 [TyCoVar]
ex_tvs
user_bndrs' :: [VarBndr TyCoVar Specificity]
user_bndrs' = (VarBndr TyCoVar Specificity -> VarBndr TyCoVar Specificity)
-> [VarBndr TyCoVar Specificity] -> [VarBndr TyCoVar Specificity]
forall a b. (a -> b) -> [a] -> [b]
map (TidyEnv
-> VarBndr TyCoVar Specificity -> VarBndr TyCoVar Specificity
tidyUserForAllTyBinder TidyEnv
con_env2) [VarBndr TyCoVar Specificity]
user_bndrs
to_eq_spec :: (TyCoVar, Type) -> IfaceTvBndr
to_eq_spec (TyCoVar
tv,Type
ty) = (TidyEnv -> TyCoVar -> FastString
tidyTyVar TidyEnv
con_env2 TyCoVar
tv, TidyEnv -> Type -> IfaceType
tidyToIfaceType TidyEnv
con_env2 Type
ty)
tidyUserForAllTyBinder :: TidyEnv -> InvisTVBinder -> InvisTVBinder
tidyUserForAllTyBinder :: TidyEnv
-> VarBndr TyCoVar Specificity -> VarBndr TyCoVar Specificity
tidyUserForAllTyBinder TidyEnv
env (Bndr TyCoVar
tv Specificity
vis) =
TyCoVar -> Specificity -> VarBndr TyCoVar Specificity
forall var argf. var -> argf -> VarBndr var argf
Bndr (TidyEnv -> TyCoVar -> TyCoVar
tidyTyCoVarOcc TidyEnv
env TyCoVar
tv) Specificity
vis
classToIfaceDecl :: TidyEnv -> Class -> (TidyEnv, IfaceDecl)
classToIfaceDecl :: TidyEnv -> Class -> (TidyEnv, IfaceDecl)
classToIfaceDecl TidyEnv
env Class
clas
= ( TidyEnv
env1
, IfaceClass { ifName :: Name
ifName = TyCon -> Name
forall a. NamedThing a => a -> Name
getName TyCon
tycon,
ifRoles :: [Role]
ifRoles = TyCon -> [Role]
tyConRoles (Class -> TyCon
classTyCon Class
clas),
ifBinders :: [IfaceTyConBinder]
ifBinders = [TyConBinder] -> [IfaceTyConBinder]
forall vis. [VarBndr TyCoVar vis] -> [VarBndr IfaceBndr vis]
toIfaceForAllBndrs [TyConBinder]
tc_binders,
ifBody :: IfaceClassBody
ifBody = IfaceClassBody
body,
ifFDs :: [FunDep FastString]
ifFDs = (([TyCoVar], [TyCoVar]) -> FunDep FastString)
-> [([TyCoVar], [TyCoVar])] -> [FunDep FastString]
forall a b. (a -> b) -> [a] -> [b]
map ([TyCoVar], [TyCoVar]) -> FunDep FastString
toIfaceFD [([TyCoVar], [TyCoVar])]
clas_fds })
where
([TyCoVar]
_, [([TyCoVar], [TyCoVar])]
clas_fds, [Type]
sc_theta, [TyCoVar]
_, [ClassATItem]
clas_ats, [ClassOpItem]
op_stuff)
= Class
-> ([TyCoVar], [([TyCoVar], [TyCoVar])], [Type], [TyCoVar],
[ClassATItem], [ClassOpItem])
classExtraBigSig Class
clas
tycon :: TyCon
tycon = Class -> TyCon
classTyCon Class
clas
body :: IfaceClassBody
body | TyCon -> Bool
isAbstractTyCon TyCon
tycon = IfaceClassBody
IfAbstractClass
| Bool
otherwise
= IfConcreteClass {
ifClassCtxt :: IfaceContext
ifClassCtxt = TidyEnv -> [Type] -> IfaceContext
tidyToIfaceContext TidyEnv
env1 [Type]
sc_theta,
ifATs :: [IfaceAT]
ifATs = (ClassATItem -> IfaceAT) -> [ClassATItem] -> [IfaceAT]
forall a b. (a -> b) -> [a] -> [b]
map ClassATItem -> IfaceAT
toIfaceAT [ClassATItem]
clas_ats,
ifSigs :: [IfaceClassOp]
ifSigs = (ClassOpItem -> IfaceClassOp) -> [ClassOpItem] -> [IfaceClassOp]
forall a b. (a -> b) -> [a] -> [b]
map ClassOpItem -> IfaceClassOp
toIfaceClassOp [ClassOpItem]
op_stuff,
ifMinDef :: BooleanFormula FastString
ifMinDef = (Name -> FastString)
-> BooleanFormula Name -> BooleanFormula FastString
forall a b. (a -> b) -> BooleanFormula a -> BooleanFormula b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Name -> FastString
forall a. NamedThing a => a -> FastString
getOccFS (Class -> BooleanFormula Name
classMinimalDef Class
clas)
}
(TidyEnv
env1, [TyConBinder]
tc_binders) = TidyEnv -> [TyConBinder] -> (TidyEnv, [TyConBinder])
tidyTyConBinders TidyEnv
env (TyCon -> [TyConBinder]
tyConBinders TyCon
tycon)
toIfaceAT :: ClassATItem -> IfaceAT
toIfaceAT :: ClassATItem -> IfaceAT
toIfaceAT (ATI TyCon
tc Maybe (Type, ATValidityInfo)
def)
= IfaceDecl -> Maybe IfaceType -> IfaceAT
IfaceAT IfaceDecl
if_decl (((Type, ATValidityInfo) -> IfaceType)
-> Maybe (Type, ATValidityInfo) -> Maybe IfaceType
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TidyEnv -> Type -> IfaceType
tidyToIfaceType TidyEnv
env2 (Type -> IfaceType)
-> ((Type, ATValidityInfo) -> Type)
-> (Type, ATValidityInfo)
-> IfaceType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Type, ATValidityInfo) -> Type
forall a b. (a, b) -> a
fst) Maybe (Type, ATValidityInfo)
def)
where
(TidyEnv
env2, IfaceDecl
if_decl) = TidyEnv -> TyCon -> (TidyEnv, IfaceDecl)
tyConToIfaceDecl TidyEnv
env1 TyCon
tc
toIfaceClassOp :: ClassOpItem -> IfaceClassOp
toIfaceClassOp (TyCoVar
sel_id, Maybe (Name, DefMethSpec Type)
def_meth)
= Bool -> IfaceClassOp -> IfaceClassOp
forall a. HasCallStack => Bool -> a -> a
assert ([TyCoVar]
sel_tyvars [TyCoVar] -> [TyCoVar] -> Bool
forall a. Eq a => a -> a -> Bool
== [TyConBinder] -> [TyCoVar]
forall tv argf. [VarBndr tv argf] -> [tv]
binderVars [TyConBinder]
tc_binders) (IfaceClassOp -> IfaceClassOp) -> IfaceClassOp -> IfaceClassOp
forall a b. (a -> b) -> a -> b
$
Name -> IfaceType -> Maybe (DefMethSpec IfaceType) -> IfaceClassOp
IfaceClassOp (TyCoVar -> Name
forall a. NamedThing a => a -> Name
getName TyCoVar
sel_id)
(TidyEnv -> Type -> IfaceType
tidyToIfaceType TidyEnv
env1 Type
op_ty)
(((Name, DefMethSpec Type) -> DefMethSpec IfaceType)
-> Maybe (Name, DefMethSpec Type) -> Maybe (DefMethSpec IfaceType)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Name, DefMethSpec Type) -> DefMethSpec IfaceType
toDmSpec Maybe (Name, DefMethSpec Type)
def_meth)
where
([TyCoVar]
sel_tyvars, Type
rho_ty) = Type -> ([TyCoVar], Type)
splitForAllTyCoVars (TyCoVar -> Type
idType TyCoVar
sel_id)
op_ty :: Type
op_ty = (() :: Constraint) => Type -> Type
Type -> Type
funResultTy Type
rho_ty
toDmSpec :: (Name, DefMethSpec Type) -> DefMethSpec IfaceType
toDmSpec :: (Name, DefMethSpec Type) -> DefMethSpec IfaceType
toDmSpec (Name
_, DefMethSpec Type
VanillaDM) = DefMethSpec IfaceType
forall ty. DefMethSpec ty
VanillaDM
toDmSpec (Name
_, GenericDM Type
dm_ty) = IfaceType -> DefMethSpec IfaceType
forall ty. ty -> DefMethSpec ty
GenericDM (TidyEnv -> Type -> IfaceType
tidyToIfaceType TidyEnv
env1 Type
dm_ty)
toIfaceFD :: ([TyCoVar], [TyCoVar]) -> FunDep FastString
toIfaceFD ([TyCoVar]
tvs1, [TyCoVar]
tvs2) = ((TyCoVar -> FastString) -> [TyCoVar] -> [FastString]
forall a b. (a -> b) -> [a] -> [b]
map (TidyEnv -> TyCoVar -> FastString
tidyTyVar TidyEnv
env1) [TyCoVar]
tvs1
,(TyCoVar -> FastString) -> [TyCoVar] -> [FastString]
forall a b. (a -> b) -> [a] -> [b]
map (TidyEnv -> TyCoVar -> FastString
tidyTyVar TidyEnv
env1) [TyCoVar]
tvs2)
tidyTyConBinder :: TidyEnv -> TyConBinder -> (TidyEnv, TyConBinder)
tidyTyConBinder :: TidyEnv -> TyConBinder -> (TidyEnv, TyConBinder)
tidyTyConBinder env :: TidyEnv
env@(TidyOccEnv
_, VarEnv TyCoVar
subst) tvb :: TyConBinder
tvb@(Bndr TyCoVar
tv TyConBndrVis
vis)
= case VarEnv TyCoVar -> TyCoVar -> Maybe TyCoVar
forall a. VarEnv a -> TyCoVar -> Maybe a
lookupVarEnv VarEnv TyCoVar
subst TyCoVar
tv of
Just TyCoVar
tv' -> (TidyEnv
env, TyCoVar -> TyConBndrVis -> TyConBinder
forall var argf. var -> argf -> VarBndr var argf
Bndr TyCoVar
tv' TyConBndrVis
vis)
Maybe TyCoVar
Nothing -> TidyEnv -> TyConBinder -> (TidyEnv, TyConBinder)
forall vis.
TidyEnv -> VarBndr TyCoVar vis -> (TidyEnv, VarBndr TyCoVar vis)
tidyForAllTyBinder TidyEnv
env TyConBinder
tvb
tidyTyConBinders :: TidyEnv -> [TyConBinder] -> (TidyEnv, [TyConBinder])
tidyTyConBinders :: TidyEnv -> [TyConBinder] -> (TidyEnv, [TyConBinder])
tidyTyConBinders = (TidyEnv -> TyConBinder -> (TidyEnv, TyConBinder))
-> TidyEnv -> [TyConBinder] -> (TidyEnv, [TyConBinder])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL TidyEnv -> TyConBinder -> (TidyEnv, TyConBinder)
tidyTyConBinder
tidyTyVar :: TidyEnv -> TyVar -> FastString
tidyTyVar :: TidyEnv -> TyCoVar -> FastString
tidyTyVar (TidyOccEnv
_, VarEnv TyCoVar
subst) TyCoVar
tv = TyCoVar -> FastString
toIfaceTyVar (VarEnv TyCoVar -> TyCoVar -> Maybe TyCoVar
forall a. VarEnv a -> TyCoVar -> Maybe a
lookupVarEnv VarEnv TyCoVar
subst TyCoVar
tv Maybe TyCoVar -> TyCoVar -> TyCoVar
forall a. Maybe a -> a -> a
`orElse` TyCoVar
tv)
instanceToIfaceInst :: ClsInst -> IfaceClsInst
instanceToIfaceInst :: ClsInst -> IfaceClsInst
instanceToIfaceInst (ClsInst { is_dfun :: ClsInst -> TyCoVar
is_dfun = TyCoVar
dfun_id, is_flag :: ClsInst -> OverlapFlag
is_flag = OverlapFlag
oflag
, is_cls_nm :: ClsInst -> Name
is_cls_nm = Name
cls_name, is_cls :: ClsInst -> Class
is_cls = Class
cls
, is_tcs :: ClsInst -> [RoughMatchTc]
is_tcs = [RoughMatchTc]
rough_tcs
, is_orphan :: ClsInst -> IsOrphan
is_orphan = IsOrphan
orph })
= Bool -> IfaceClsInst -> IfaceClsInst
forall a. HasCallStack => Bool -> a -> a
assert (Name
cls_name Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Class -> Name
className Class
cls) (IfaceClsInst -> IfaceClsInst) -> IfaceClsInst -> IfaceClsInst
forall a b. (a -> b) -> a -> b
$
IfaceClsInst { ifDFun :: Name
ifDFun = TyCoVar -> Name
idName TyCoVar
dfun_id
, ifOFlag :: OverlapFlag
ifOFlag = OverlapFlag
oflag
, ifInstCls :: Name
ifInstCls = Name
cls_name
, ifInstTys :: [Maybe IfaceTyCon]
ifInstTys = [RoughMatchTc] -> [Maybe IfaceTyCon]
ifaceRoughMatchTcs ([RoughMatchTc] -> [Maybe IfaceTyCon])
-> [RoughMatchTc] -> [Maybe IfaceTyCon]
forall a b. (a -> b) -> a -> b
$ [RoughMatchTc] -> [RoughMatchTc]
forall a. HasCallStack => [a] -> [a]
tail [RoughMatchTc]
rough_tcs
, ifInstOrph :: IsOrphan
ifInstOrph = IsOrphan
orph }
famInstToIfaceFamInst :: FamInst -> IfaceFamInst
famInstToIfaceFamInst :: FamInst -> IfaceFamInst
famInstToIfaceFamInst (FamInst { fi_axiom :: FamInst -> CoAxiom Unbranched
fi_axiom = CoAxiom Unbranched
axiom,
fi_fam :: FamInst -> Name
fi_fam = Name
fam,
fi_tcs :: FamInst -> [RoughMatchTc]
fi_tcs = [RoughMatchTc]
rough_tcs })
= IfaceFamInst { ifFamInstAxiom :: Name
ifFamInstAxiom = CoAxiom Unbranched -> Name
forall (br :: BranchFlag). CoAxiom br -> Name
coAxiomName CoAxiom Unbranched
axiom
, ifFamInstFam :: Name
ifFamInstFam = Name
fam
, ifFamInstTys :: [Maybe IfaceTyCon]
ifFamInstTys = [RoughMatchTc] -> [Maybe IfaceTyCon]
ifaceRoughMatchTcs [RoughMatchTc]
rough_tcs
, ifFamInstOrph :: IsOrphan
ifFamInstOrph = IsOrphan
orph }
where
fam_decl :: Name
fam_decl = TyCon -> Name
tyConName (TyCon -> Name) -> TyCon -> Name
forall a b. (a -> b) -> a -> b
$ CoAxiom Unbranched -> TyCon
forall (br :: BranchFlag). CoAxiom br -> TyCon
coAxiomTyCon CoAxiom Unbranched
axiom
mod :: Module
mod = Bool -> Module -> Module
forall a. HasCallStack => Bool -> a -> a
assert (Name -> Bool
isExternalName (CoAxiom Unbranched -> Name
forall (br :: BranchFlag). CoAxiom br -> Name
coAxiomName CoAxiom Unbranched
axiom)) (Module -> Module) -> Module -> Module
forall a b. (a -> b) -> a -> b
$
(() :: Constraint) => Name -> Module
Name -> Module
nameModule (CoAxiom Unbranched -> Name
forall (br :: BranchFlag). CoAxiom br -> Name
coAxiomName CoAxiom Unbranched
axiom)
is_local :: Name -> Bool
is_local Name
name = Module -> Name -> Bool
nameIsLocalOrFrom Module
mod Name
name
lhs_names :: NameSet
lhs_names = (Name -> Bool) -> NameSet -> NameSet
filterNameSet Name -> Bool
is_local (CoAxiom Unbranched -> NameSet
forall (br :: BranchFlag). CoAxiom br -> NameSet
orphNamesOfAxiomLHS CoAxiom Unbranched
axiom)
orph :: IsOrphan
orph | Name -> Bool
is_local Name
fam_decl
= OccName -> IsOrphan
NotOrphan (Name -> OccName
nameOccName Name
fam_decl)
| Bool
otherwise
= NameSet -> IsOrphan
chooseOrphanAnchor NameSet
lhs_names
ifaceRoughMatchTcs :: [RoughMatchTc] -> [Maybe IfaceTyCon]
ifaceRoughMatchTcs :: [RoughMatchTc] -> [Maybe IfaceTyCon]
ifaceRoughMatchTcs [RoughMatchTc]
tcs = (RoughMatchTc -> Maybe IfaceTyCon)
-> [RoughMatchTc] -> [Maybe IfaceTyCon]
forall a b. (a -> b) -> [a] -> [b]
map RoughMatchTc -> Maybe IfaceTyCon
do_rough [RoughMatchTc]
tcs
where
do_rough :: RoughMatchTc -> Maybe IfaceTyCon
do_rough RoughMatchTc
RM_WildCard = Maybe IfaceTyCon
forall a. Maybe a
Nothing
do_rough (RM_KnownTc Name
n) = IfaceTyCon -> Maybe IfaceTyCon
forall a. a -> Maybe a
Just (Name -> IfaceTyCon
toIfaceTyCon_name Name
n)
coreRuleToIfaceRule :: CoreRule -> IfaceRule
coreRuleToIfaceRule :: CoreRule -> IfaceRule
coreRuleToIfaceRule rule :: CoreRule
rule@(BuiltinRule {})
= String -> SDoc -> IfaceRule
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"toHsRule:" (CoreRule -> SDoc
pprRule CoreRule
rule)
coreRuleToIfaceRule (Rule { ru_name :: CoreRule -> FastString
ru_name = FastString
name, ru_fn :: CoreRule -> Name
ru_fn = Name
fn,
ru_act :: CoreRule -> Activation
ru_act = Activation
act, ru_bndrs :: CoreRule -> [TyCoVar]
ru_bndrs = [TyCoVar]
bndrs,
ru_args :: CoreRule -> [CoreExpr]
ru_args = [CoreExpr]
args, ru_rhs :: CoreRule -> CoreExpr
ru_rhs = CoreExpr
rhs,
ru_orphan :: CoreRule -> IsOrphan
ru_orphan = IsOrphan
orph, ru_auto :: CoreRule -> Bool
ru_auto = Bool
auto })
= IfaceRule { ifRuleName :: FastString
ifRuleName = FastString
name, ifActivation :: Activation
ifActivation = Activation
act,
ifRuleBndrs :: [IfaceBndr]
ifRuleBndrs = (TyCoVar -> IfaceBndr) -> [TyCoVar] -> [IfaceBndr]
forall a b. (a -> b) -> [a] -> [b]
map TyCoVar -> IfaceBndr
toIfaceBndr [TyCoVar]
bndrs,
ifRuleHead :: Name
ifRuleHead = Name
fn,
ifRuleArgs :: [IfaceExpr]
ifRuleArgs = (CoreExpr -> IfaceExpr) -> [CoreExpr] -> [IfaceExpr]
forall a b. (a -> b) -> [a] -> [b]
map CoreExpr -> IfaceExpr
do_arg [CoreExpr]
args,
ifRuleRhs :: IfaceExpr
ifRuleRhs = CoreExpr -> IfaceExpr
toIfaceExpr CoreExpr
rhs,
ifRuleAuto :: Bool
ifRuleAuto = Bool
auto,
ifRuleOrph :: IsOrphan
ifRuleOrph = IsOrphan
orph }
where
do_arg :: CoreExpr -> IfaceExpr
do_arg (Type Type
ty) = IfaceType -> IfaceExpr
IfaceType (Type -> IfaceType
toIfaceType (Type -> Type
deNoteType Type
ty))
do_arg (Coercion Coercion
co) = IfaceCoercion -> IfaceExpr
IfaceCo (Coercion -> IfaceCoercion
toIfaceCoercion Coercion
co)
do_arg CoreExpr
arg = CoreExpr -> IfaceExpr
toIfaceExpr CoreExpr
arg