{-# LANGUAGE NondecreasingIndentation #-}

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

-- | Module for constructing @ModIface@ values (interface files),
-- writing them to disk and comparing two versions to see if
-- recompilation is required.
module GHC.Iface.Make
   ( mkPartialIface
   , mkFullIface
   , mkIfaceTc
   , mkIfaceExports
   , coAxiomToIfaceDecl
   , tyThingToIfaceDecl -- Converting things to their Iface equivalents
   )
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)


{-
************************************************************************
*                                                                      *
\subsection{Completing an interface}
*                                                                      *
************************************************************************
-}

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

-- | Fully instantiate an interface. Adds fingerprints and potentially code
-- generator produced information.
--
-- CmmCgInfos is not available when not generating code (-fno-code), or when not
-- generating interface pragmas (-fomit-interface-pragmas). See also
-- Note [Conveying CAF-info and LFInfo between modules] in GHC.StgToCmm.Types.
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 }

    -- Debug printing
    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
        -- Only allocate a new IfaceId if we're going to update the infos
      , 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 -- LFInfos not available when building .cmm files
             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




-- | Make an interface from the results of typechecking only.  Useful
-- for non-optimising compilation, or where we aren't generating any
-- object code at all ('NoBackend').
mkIfaceTc :: HscEnv
          -> SafeHaskellMode    -- The safe haskell mode
          -> ModDetails         -- gotten from mkBootModDetails, probably
          -> ModSummary
          -> Maybe CoreProgram
          -> TcGblEnv           -- Usages, deprecations, etc
          -> 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
          -- Do NOT use semantic module here; this_mod in mkUsageInfo
          -- is used solely to decide if we should record a dependency
          -- or not.  When we instantiate a signature, the semantic
          -- module is something we want to record dependencies for,
          -- but if you pass that in here, we'll decide it's the local
          -- module and does not need to be recorded as a dependency.
          -- See Note [Identity versus semantic module]
          [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 }
-- NB:  notice that mkIface does not look at the bindings
--      only at the TypeEnv.  The previous Tidy phase has
--      put exactly the info into the TypeEnv that we want
--      to expose in the interface

  = 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),
                      -- No implicit Ids and class tycons in the interface file
                   Bool -> Bool
not (Name -> Bool
isWiredInName Name
name),
                      -- Nor wired-in things; the compiler knows about them anyhow
                   Module -> Name -> Bool
nameIsLocalOrFrom Module
semantic_mod Name
name  ]
                      -- Sigh: see Note [Root-main Id] in GHC.Tc.Module
                      -- NB: ABSOLUTELY need to check against semantic_mod,
                      -- because all of the names in an hsig p[H=<H>]:H
                      -- are going to be for <H>, not the former id!
                      -- See Note [Identity versus semantic module]

        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]
          -- The order of fixities returned from nonDetNameEnvElts is not
          -- deterministic, so we sort by OccName to canonicalize it.
          -- See Note [Deterministic UniqFM] in GHC.Types.Unique.DFM for more details.
        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,
          -- Need to record this because it depends on the -instantiated-with flag
          -- which could change
          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,

          -- Sort these lexicographically, so that
          -- the result is stable across compilations
          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
     -- Compare these lexicographically by OccName, *not* by unique,
     -- because the latter is not stable across compilations:
     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

     -- We only fill in mi_globals if the module was compiled to byte
     -- code.  Otherwise, the compiler may not have retained all the
     -- top-level bindings and they won't be in the TypeEnv (see
     -- Desugar.addExportFlagsAndRules).  The mi_globals field is used
     -- by GHCi to decide whether the module has its full top-level
     -- scope available. (#5534)
     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


{-
************************************************************************
*                                                                      *
       COMPLETE Pragmas
*                                                                      *
************************************************************************
-}

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)


{-
************************************************************************
*                                                                      *
       Keeping track of what we've slurped, and fingerprints
*                                                                      *
************************************************************************
-}


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]  -- Sort to make canonical
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))
       -- Maintain the AvailTC Invariant

{-
Note [Original module]
~~~~~~~~~~~~~~~~~~~~~
Consider this:
        module X where { data family T }
        module Y( T(..) ) where { import X; data instance T Int = MkT Int }
The exported Avail from Y will look like
        X.T{X.T, Y.MkT}
That is, in Y,
  - only MkT is brought into scope by the data instance;
  - but the parent (used for grouping and naming in T(..) exports) is X.T
  - and in this case we export X.T too

In the result of mkIfaceExports, the names are grouped by defining module,
so we may need to split up a single Avail into multiple ones.
-}


{-
************************************************************************
*                                                                      *
                Converting things to their Iface equivalents
*                                                                      *
************************************************************************
-}

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 -- for ppr purposes only
    PatSynCon PatSyn
ps   -> PatSyn -> IfaceDecl
patSynToIfaceDecl PatSyn
ps

--------------------------
idToIfaceDecl :: Id -> IfaceDecl
-- The Id is already tidied, so that locally-bound names
-- (lambdas, for-alls) already have non-clashing OccNames
-- We can't tidy it here, locally, because it may have
-- free variables in its type or IdInfo
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
-- We *do* tidy Axioms, because they are not (and cannot
-- conveniently be) built in tidy form
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

-- 2nd parameter is the list of branch LHSs, in case of a closed type family,
-- for conversion from incompatible branches to incompatible indices.
-- For an open type family the list should be empty.
-- See Note [Storing compatibility] in GHC.Core.Coercion.Axiom
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)
-- We *do* tidy TyCons, because they are not (and cannot
-- conveniently be) built in tidy form
-- The returned TidyEnv is the one after tidying the tyConTyVars
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  -- FunTyCon, PrimTyCon, promoted TyCon/DataCon
  -- We only convert these TyCons to IfaceTyCons when we are
  -- just about to pretty-print them, not because we are going
  -- to put them into interface files
  = ( 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
    -- NOTE: Not all TyCons have `tyConTyVars` field. Forcing this when `tycon`
    -- is one of these TyCons (FunTyCon, PrimTyCon, PromotedDataCon) will cause
    -- an error.
    (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
                     -- No tidying of the binders; they are already tidy
    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
        -- The AbstractTyCon case happens when a TyCon has been trimmed
        -- during tidying.
        -- Furthermore, tyThingToIfaceDecl is also used in GHC.Tc.Module
        -- for GHCi, when browsing a module, in which case the
        -- AbstractTyCon and TupleTyCon cases are perfectly sensible.
        -- (Tuple declarations are not serialised into interface files.)

    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

          -- Tidy the univ_tvs of the data constructor to be identical
          -- to the tyConTyVars of the type constructor.  This means
          -- (a) we don't need to redundantly put them into the interface file
          -- (b) when pretty-printing an Iface data declaration in H98-style syntax,
          --     we know that the type variables will line up
          -- The latter (b) is important because we pretty-print type constructors
          -- by converting to Iface syntax and pretty-printing that
          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))
                     -- A bit grimy, perhaps, but it's simple!

          (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)

          -- By this point, we have tidied every universal and existential
          -- tyvar. Because of the dcUserForAllTyBinders invariant
          -- (see Note [DataCon user type variable binders]), *every*
          -- user-written tyvar must be contained in the substitution that
          -- tidying produced. Therefore, tidying the user-written tyvars is a
          -- simple matter of looking up each variable in the substitution,
          -- which tidyTyCoVarOcc accomplishes.
          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
                -- Be careful when splitting the type, because of things
                -- like         class Foo a where
                --                op :: (?x :: String) => a -> a
                -- and          class Baz a where
                --                op :: (Ord a) => a -> a
          ([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)
-- If the type variable "binder" is in scope, don't re-bind it
-- In a class decl, for example, the ATD binders mention
-- (amd must mention) the class tyvars
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
                   -- N.B. Drop the class name from the rough match template
                   --      It is put back by GHC.Core.InstEnv.mkImportedInstance
                 , 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
-- A plugin that installs a BuiltinRule in a CoreDoPluginPass should
-- ensure that there's another CoreDoPluginPass that removes the rule.
-- Otherwise a module using the plugin and compiled with -fno-omit-interface-pragmas
-- would cause panic when the rule is attempted to be written to the interface file.
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
        -- For type args we must remove synonyms from the outermost
        -- level.  Reason: so that when we read it back in we'll
        -- construct the same ru_rough field as we have right now;
        -- see tcIfaceRule
    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