{-# 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
   , mkRecompUsageInfo
   , mkIfaceExports
   )
where

import GHC.Prelude

import GHC.Hs

import GHC.Stg.EnforceEpt.TagSig (StgCgInfos)
import GHC.StgToCmm.Types (CmmCgInfos (..))

import GHC.Tc.Utils.TcType
import GHC.Tc.Utils.Monad

import GHC.Iface.Warnings
import GHC.Iface.Decl
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.Coercion.Axiom
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.DynFlags
import GHC.Driver.Plugins

import GHC.Types.Id
import GHC.Types.Fixity.Env
import GHC.Types.ForeignStubs (ForeignStubs (NoStubs))
import GHC.Types.SafeHaskell
import GHC.Types.Annotations
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.DefaultEnv ( ClassDefaults (..), DefaultEnv, defaultList )
import GHC.Types.Unique.DSet
import GHC.Types.TypeEnv
import GHC.Types.SourceFile
import GHC.Types.TyThing
import GHC.Types.CompleteMatch
import GHC.Types.Name.Cache

import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.Logger
import GHC.Utils.Binary
import GHC.Iface.Binary

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 GHC.Unit.Module.WholeCoreBindings (encodeIfaceForeign, emptyIfaceForeign)

import Data.Function
import Data.List ( sortBy )
import Data.Ord
import Data.IORef
import Data.Traversable

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

mkPartialIface :: HscEnv
               -> CoreProgram
               -> ModDetails
               -> ModSummary
               -> [ImportUserSpec]
               -> ModGuts
               -> IO PartialModIface
mkPartialIface :: HscEnv
-> CoreProgram
-> ModDetails
-> ModSummary
-> [ImportUserSpec]
-> ModGuts
-> IO PartialModIface
mkPartialIface HscEnv
hsc_env CoreProgram
core_prog ModDetails
mod_details ModSummary
mod_summary [ImportUserSpec]
import_decls
  ModGuts{ mg_module :: ModGuts -> Module
mg_module       = Module
this_mod
         , mg_hsc_src :: ModGuts -> HscSource
mg_hsc_src      = HscSource
hsc_src
         , mg_usages :: ModGuts -> Maybe [Usage]
mg_usages       = Maybe [Usage]
usages
         , 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_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
         }
  = do
      self_recomp <- ([Usage] -> IO IfaceSelfRecomp)
-> Maybe [Usage] -> IO (Maybe IfaceSelfRecomp)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse (HscEnv -> Module -> Fingerprint -> [Usage] -> IO IfaceSelfRecomp
mkSelfRecomp HscEnv
hsc_env Module
this_mod (ModSummary -> Fingerprint
ms_hs_hash ModSummary
mod_summary)) Maybe [Usage]
usages
      return $ mkIface_ hsc_env this_mod core_prog hsc_src deps rdr_env import_decls fix_env warns self_trust
                safe_mode self_recomp docs 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 -> ForeignStubs -> [(ForeignSrcLang, FilePath)] -> IO ModIface
mkFullIface :: HscEnv
-> PartialModIface
-> Maybe StgCgInfos
-> Maybe CmmCgInfos
-> ForeignStubs
-> [(ForeignSrcLang, FilePath)]
-> IO ModIface
mkFullIface HscEnv
hsc_env PartialModIface
partial_iface Maybe StgCgInfos
mb_stg_infos Maybe CmmCgInfos
mb_cmm_infos ForeignStubs
stubs [(ForeignSrcLang, FilePath)]
foreign_files = 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

    -- See Note [Foreign stubs and TH bytecode linking]
    mi_simplified_core <- Maybe IfaceSimplifiedCore
-> (IfaceSimplifiedCore -> IO IfaceSimplifiedCore)
-> IO (Maybe IfaceSimplifiedCore)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (PartialModIface -> Maybe IfaceSimplifiedCore
forall (phase :: ModIfacePhase).
ModIface_ phase -> Maybe IfaceSimplifiedCore
mi_simplified_core PartialModIface
partial_iface) ((IfaceSimplifiedCore -> IO IfaceSimplifiedCore)
 -> IO (Maybe IfaceSimplifiedCore))
-> (IfaceSimplifiedCore -> IO IfaceSimplifiedCore)
-> IO (Maybe IfaceSimplifiedCore)
forall a b. (a -> b) -> a -> b
$ \IfaceSimplifiedCore
simpl_core -> do
        fs <- Logger
-> DynFlags
-> ForeignStubs
-> [(ForeignSrcLang, FilePath)]
-> IO IfaceForeign
encodeIfaceForeign (HscEnv -> Logger
hsc_logger HscEnv
hsc_env) (HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env) ForeignStubs
stubs [(ForeignSrcLang, FilePath)]
foreign_files
        return $ (simpl_core { mi_sc_foreign = fs })

    full_iface <-
      {-# SCC "addFingerprints" #-}
      addFingerprints hsc_env $ set_mi_simplified_core mi_simplified_core $ set_mi_decls decls partial_iface

    -- Debug printing
    let unit_state = HasDebugCallStack => HscEnv -> UnitState
HscEnv -> UnitState
hsc_units HscEnv
hsc_env
    putDumpFileMaybe (hsc_logger hsc_env) Opt_D_dump_hi "FINAL INTERFACE" FormatText
      (pprModIface unit_state full_iface)
    final_iface <- shareIface (hsc_NC hsc_env) (flagsToIfCompression $ hsc_dflags hsc_env) full_iface
    return final_iface

-- | Compress an 'ModIface' and share as many values as possible, depending on the 'CompressionIFace' level.
-- See Note [Sharing of ModIface].
--
-- We compress the 'ModIface' by serialising the 'ModIface' to an in-memory byte array, and then deserialising it.
-- The deserialisation will deduplicate certain values depending on the 'CompressionIFace' level.
-- See Note [Deduplication during iface binary serialisation] for how we do that.
--
-- Additionally, we cache the serialised byte array, so if the 'ModIface' is not modified
-- after calling 'shareIface', 'writeBinIface' will reuse that buffer without serialising the 'ModIface' again.
-- Modifying the 'ModIface' forces us to re-serialise it again.
shareIface :: NameCache -> CompressionIFace -> ModIface -> IO ModIface
shareIface :: NameCache -> CompressionIFace -> ModIface -> IO ModIface
shareIface NameCache
_ CompressionIFace
NormalCompression ModIface
mi = do
  -- In 'NormalCompression', the sharing isn't reducing the memory usage, as 'Name's and 'FastString's are
  -- already shared, and at this compression level, we don't compress/share anything else.
  -- Thus, for a brief moment we simply double the memory residency for no reason.
  -- Therefore, we only try to share expensive values if the compression mode is higher than
  -- 'NormalCompression'
  ModIface -> IO ModIface
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ModIface
mi
shareIface NameCache
nc CompressionIFace
compressionLevel  ModIface
mi = do
  bh <- Int -> IO WriteBinHandle
openBinMem Int
initBinMemSize
  start <- tellBinWriter bh
  putIfaceWithExtFields QuietBinIFace compressionLevel bh mi
  rbh <- shrinkBinBuffer bh
  seekBinReader rbh start
  res <- getIfaceWithExtFields nc rbh
  forceModIface res
  return res

-- | Initial ram buffer to allocate for writing interface files.
initBinMemSize :: Int
initBinMemSize :: Int
initBinMemSize = Int
1024 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024 -- 1 MB

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 -> FilePath -> SDoc -> Bool -> Bool
forall a. HasCallStack => Bool -> FilePath -> SDoc -> a -> a
warnPprTrace (Maybe LambdaFormInfo -> Bool
forall a. Maybe a -> Bool
isNothing Maybe LambdaFormInfo
mb_lf_info) FilePath
"updateDecl" (FilePath -> SDoc
forall doc. IsLine doc => FilePath -> doc
text FilePath
"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_import_decls :: TcGblEnv -> [ImportUserSpec]
tcg_import_decls = [ImportUserSpec]
import_decls,
                      tcg_rdr_env :: TcGblEnv -> GlobalRdrEnv
tcg_rdr_env = GlobalRdrEnv
rdr_env,
                      tcg_fix_env :: TcGblEnv -> FixityEnv
tcg_fix_env = FixityEnv
fix_env,
                      tcg_warns :: TcGblEnv -> Warnings GhcRn
tcg_warns = Warnings GhcRn
warns
                    }
  = do
          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)

          usage <- HscEnv -> TcGblEnv -> IO (Maybe [Usage])
mkRecompUsageInfo HscEnv
hsc_env TcGblEnv
tc_result
          docs <- extractDocs (ms_hspp_opts mod_summary) tc_result
          self_recomp <- traverse (mkSelfRecomp hsc_env this_mod (ms_hs_hash mod_summary)) usage

          let partial_iface = HscEnv
-> Module
-> CoreProgram
-> HscSource
-> Dependencies
-> GlobalRdrEnv
-> [ImportUserSpec]
-> FixityEnv
-> Warnings GhcRn
-> Bool
-> SafeHaskellMode
-> Maybe IfaceSelfRecomp
-> Maybe Docs
-> 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
                   Dependencies
deps GlobalRdrEnv
rdr_env [ImportUserSpec]
import_decls
                   FixityEnv
fix_env Warnings GhcRn
warns
                   (ImportAvails -> Bool
imp_trust_own_pkg ImportAvails
imports) SafeHaskellMode
safe_mode Maybe IfaceSelfRecomp
self_recomp
                   Maybe Docs
docs
                   ModDetails
mod_details

          mkFullIface hsc_env partial_iface Nothing Nothing NoStubs []

mkRecompUsageInfo :: HscEnv -> TcGblEnv -> IO (Maybe [Usage])
mkRecompUsageInfo :: HscEnv -> TcGblEnv -> IO (Maybe [Usage])
mkRecompUsageInfo HscEnv
hsc_env TcGblEnv
tc_result = do
  let dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
  if Bool -> Bool
not (GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_WriteSelfRecompInfo DynFlags
dflags)
    then Maybe [Usage] -> IO (Maybe [Usage])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Usage]
forall a. Maybe a
Nothing
    else do
     let used_names :: NameSet
used_names = TcGblEnv -> NameSet
mkUsedNames TcGblEnv
tc_result
     dep_files <- (IORef [FilePath] -> IO [FilePath]
forall a. IORef a -> IO a
readIORef (TcGblEnv -> IORef [FilePath]
tcg_dependent_files TcGblEnv
tc_result))
     (needed_links, needed_pkgs) <- readIORef (tcg_th_needed_deps tc_result)
     let uc = HscEnv -> UsageConfig
initUsageConfig HscEnv
hsc_env
         plugins = HscEnv -> Plugins
hsc_plugins HscEnv
hsc_env
         fc = HscEnv -> FinderCache
hsc_FC HscEnv
hsc_env
         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]
     usages <- initIfaceLoad hsc_env $ mkUsageInfo uc plugins fc unit_env (tcg_mod tc_result) (imp_mods (tcg_imports tc_result)) used_names
                 dep_files (tcg_merged tc_result) needed_links needed_pkgs
     return (Just usages)

mkIface_ :: HscEnv -> Module -> CoreProgram -> HscSource
         -> Dependencies -> GlobalRdrEnv -> [ImportUserSpec]
         -> NameEnv FixItem -> Warnings GhcRn
         -> Bool
         -> SafeHaskellMode
         -> Maybe IfaceSelfRecomp
         -> Maybe Docs
         -> ModDetails
         -> PartialModIface
mkIface_ :: HscEnv
-> Module
-> CoreProgram
-> HscSource
-> Dependencies
-> GlobalRdrEnv
-> [ImportUserSpec]
-> FixityEnv
-> Warnings GhcRn
-> Bool
-> SafeHaskellMode
-> Maybe IfaceSelfRecomp
-> Maybe Docs
-> ModDetails
-> PartialModIface
mkIface_ HscEnv
hsc_env
         Module
this_mod CoreProgram
core_prog HscSource
hsc_src Dependencies
deps GlobalRdrEnv
rdr_env [ImportUserSpec]
import_decls FixityEnv
fix_env Warnings GhcRn
src_warns
         Bool
pkg_trust_req SafeHaskellMode
safe_mode Maybe IfaceSelfRecomp
self_recomp
         Maybe Docs
docs
         ModDetails{  md_defaults :: ModDetails -> DefaultEnv
md_defaults  = DefaultEnv
defaults,
                      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 -> CompleteMatches
md_complete_matches = CompleteMatches
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)

        simplified_core :: Maybe IfaceSimplifiedCore
simplified_core = if GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_WriteIfSimplifiedCore DynFlags
dflags then IfaceSimplifiedCore -> Maybe IfaceSimplifiedCore
forall a. a -> Maybe a
Just ([IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
-> IfaceForeign -> IfaceSimplifiedCore
IfaceSimplifiedCore [ Bind Id -> IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo
toIfaceTopBind Bind Id
b | Bind Id
b <- CoreProgram
core_prog ] IfaceForeign
emptyIfaceForeign)
                                                                   else Maybe IfaceSimplifiedCore
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 :: IfaceWarnings
warns       = Warnings GhcRn -> IfaceWarnings
toIfaceWarnings 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)
-> CompleteMatches -> [IfaceCompleteMatch]
forall a b. (a -> b) -> [a] -> [b]
map CompleteMatch -> IfaceCompleteMatch
mkIfaceCompleteMatch CompleteMatches
complete_matches
        !rdrs :: IfaceTopEnv
rdrs = GlobalRdrEnv -> IfaceTopEnv
mkIfaceTopEnv GlobalRdrEnv
rdr_env

    Module -> PartialModIface
emptyPartialModIface Module
this_mod
          -- Need to record this because it depends on the -instantiated-with flag
          -- which could change
          PartialModIface
-> (PartialModIface -> PartialModIface) -> PartialModIface
forall a b. a -> (a -> b) -> b
& Maybe Module -> PartialModIface -> PartialModIface
forall (phase :: ModIfacePhase).
Maybe Module -> ModIface_ phase -> ModIface_ phase
set_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)
          PartialModIface
-> (PartialModIface -> PartialModIface) -> PartialModIface
forall a b. a -> (a -> b) -> b
& HscSource -> PartialModIface -> PartialModIface
forall (phase :: ModIfacePhase).
HscSource -> ModIface_ phase -> ModIface_ phase
set_mi_hsc_src          HscSource
hsc_src
          PartialModIface
-> (PartialModIface -> PartialModIface) -> PartialModIface
forall a b. a -> (a -> b) -> b
& Maybe IfaceSelfRecomp -> PartialModIface -> PartialModIface
forall (phase :: ModIfacePhase).
Maybe IfaceSelfRecomp -> ModIface_ phase -> ModIface_ phase
set_mi_self_recomp      Maybe IfaceSelfRecomp
self_recomp
          PartialModIface
-> (PartialModIface -> PartialModIface) -> PartialModIface
forall a b. a -> (a -> b) -> b
& Dependencies -> PartialModIface -> PartialModIface
forall (phase :: ModIfacePhase).
Dependencies -> ModIface_ phase -> ModIface_ phase
set_mi_deps             Dependencies
deps
          PartialModIface
-> (PartialModIface -> PartialModIface) -> PartialModIface
forall a b. a -> (a -> b) -> b
& [AvailInfo] -> PartialModIface -> PartialModIface
forall (phase :: ModIfacePhase).
[AvailInfo] -> ModIface_ phase -> ModIface_ phase
set_mi_exports          ([AvailInfo] -> [AvailInfo]
mkIfaceExports [AvailInfo]
exports)

          PartialModIface
-> (PartialModIface -> PartialModIface) -> PartialModIface
forall a b. a -> (a -> b) -> b
& [IfaceDefault] -> PartialModIface -> PartialModIface
forall (phase :: ModIfacePhase).
[IfaceDefault] -> ModIface_ phase -> ModIface_ phase
set_mi_defaults         (DefaultEnv -> [IfaceDefault]
defaultsToIfaceDefaults DefaultEnv
defaults)

          -- Sort these lexicographically, so that
          -- the result is stable across compilations
          PartialModIface
-> (PartialModIface -> PartialModIface) -> PartialModIface
forall a b. a -> (a -> b) -> b
& [IfaceClsInst] -> PartialModIface -> PartialModIface
forall (phase :: ModIfacePhase).
[IfaceClsInst] -> ModIface_ phase -> ModIface_ phase
set_mi_insts            ((IfaceClsInst -> IfaceClsInst -> Ordering)
-> [IfaceClsInst] -> [IfaceClsInst]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy IfaceClsInst -> IfaceClsInst -> Ordering
cmp_inst     [IfaceClsInst]
iface_insts)
          PartialModIface
-> (PartialModIface -> PartialModIface) -> PartialModIface
forall a b. a -> (a -> b) -> b
& [IfaceFamInst] -> PartialModIface -> PartialModIface
forall (phase :: ModIfacePhase).
[IfaceFamInst] -> ModIface_ phase -> ModIface_ phase
set_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)
          PartialModIface
-> (PartialModIface -> PartialModIface) -> PartialModIface
forall a b. a -> (a -> b) -> b
& [IfaceRule] -> PartialModIface -> PartialModIface
forall (phase :: ModIfacePhase).
[IfaceRule] -> ModIface_ phase -> ModIface_ phase
set_mi_rules            ((IfaceRule -> IfaceRule -> Ordering) -> [IfaceRule] -> [IfaceRule]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy IfaceRule -> IfaceRule -> Ordering
cmp_rule     [IfaceRule]
iface_rules)

          PartialModIface
-> (PartialModIface -> PartialModIface) -> PartialModIface
forall a b. a -> (a -> b) -> b
& [(OccName, Fixity)] -> PartialModIface -> PartialModIface
forall (phase :: ModIfacePhase).
[(OccName, Fixity)] -> ModIface_ phase -> ModIface_ phase
set_mi_fixities         [(OccName, Fixity)]
fixities
          PartialModIface
-> (PartialModIface -> PartialModIface) -> PartialModIface
forall a b. a -> (a -> b) -> b
& IfaceWarnings -> PartialModIface -> PartialModIface
forall (phase :: ModIfacePhase).
IfaceWarnings -> ModIface_ phase -> ModIface_ phase
set_mi_warns            IfaceWarnings
warns
          PartialModIface
-> (PartialModIface -> PartialModIface) -> PartialModIface
forall a b. a -> (a -> b) -> b
& [IfaceAnnotation] -> PartialModIface -> PartialModIface
forall (phase :: ModIfacePhase).
[IfaceAnnotation] -> ModIface_ phase -> ModIface_ phase
set_mi_anns             [IfaceAnnotation]
annotations
          PartialModIface
-> (PartialModIface -> PartialModIface) -> PartialModIface
forall a b. a -> (a -> b) -> b
& IfaceTopEnv -> PartialModIface -> PartialModIface
forall (phase :: ModIfacePhase).
IfaceTopEnv -> ModIface_ phase -> ModIface_ phase
set_mi_top_env          IfaceTopEnv
rdrs
          PartialModIface
-> (PartialModIface -> PartialModIface) -> PartialModIface
forall a b. a -> (a -> b) -> b
& [IfaceDeclExts 'ModIfaceCore] -> PartialModIface -> PartialModIface
forall (phase :: ModIfacePhase).
[IfaceDeclExts phase] -> ModIface_ phase -> ModIface_ phase
set_mi_decls            [IfaceDecl]
[IfaceDeclExts 'ModIfaceCore]
decls
          PartialModIface
-> (PartialModIface -> PartialModIface) -> PartialModIface
forall a b. a -> (a -> b) -> b
& Maybe IfaceSimplifiedCore -> PartialModIface -> PartialModIface
forall (phase :: ModIfacePhase).
Maybe IfaceSimplifiedCore -> ModIface_ phase -> ModIface_ phase
set_mi_simplified_core  Maybe IfaceSimplifiedCore
simplified_core
          PartialModIface
-> (PartialModIface -> PartialModIface) -> PartialModIface
forall a b. a -> (a -> b) -> b
& IfaceTrustInfo -> PartialModIface -> PartialModIface
forall (phase :: ModIfacePhase).
IfaceTrustInfo -> ModIface_ phase -> ModIface_ phase
set_mi_trust            IfaceTrustInfo
trust_info
          PartialModIface
-> (PartialModIface -> PartialModIface) -> PartialModIface
forall a b. a -> (a -> b) -> b
& Bool -> PartialModIface -> PartialModIface
forall (phase :: ModIfacePhase).
Bool -> ModIface_ phase -> ModIface_ phase
set_mi_trust_pkg        Bool
pkg_trust_req
          PartialModIface
-> (PartialModIface -> PartialModIface) -> PartialModIface
forall a b. a -> (a -> b) -> b
& [IfaceCompleteMatch] -> PartialModIface -> PartialModIface
forall (phase :: ModIfacePhase).
[IfaceCompleteMatch] -> ModIface_ phase -> ModIface_ phase
set_mi_complete_matches ([IfaceCompleteMatch]
icomplete_matches)
          PartialModIface
-> (PartialModIface -> PartialModIface) -> PartialModIface
forall a b. a -> (a -> b) -> b
& Maybe Docs -> PartialModIface -> PartialModIface
forall (phase :: ModIfacePhase).
Maybe Docs -> ModIface_ phase -> ModIface_ phase
set_mi_docs             Maybe Docs
docs
          PartialModIface
-> (PartialModIface -> PartialModIface) -> PartialModIface
forall a b. a -> (a -> b) -> b
& IfaceAbiHashesExts 'ModIfaceCore
-> PartialModIface -> PartialModIface
forall (phase :: ModIfacePhase).
IfaceAbiHashesExts phase -> ModIface_ phase -> ModIface_ phase
set_mi_abi_hashes       ()
          PartialModIface
-> (PartialModIface -> PartialModIface) -> PartialModIface
forall a b. a -> (a -> b) -> b
& ExtensibleFields -> PartialModIface -> PartialModIface
forall (phase :: ModIfacePhase).
ExtensibleFields -> ModIface_ phase -> ModIface_ phase
set_mi_ext_fields       ExtensibleFields
emptyExtensibleFields
          PartialModIface
-> (PartialModIface -> PartialModIface) -> PartialModIface
forall a b. a -> (a -> b) -> b
& IfaceBinHandle 'ModIfaceCore -> PartialModIface -> PartialModIface
forall (phase :: ModIfacePhase).
IfaceBinHandle phase -> ModIface_ phase -> ModIface_ phase
set_mi_hi_bytes         IfaceBinHandle 'ModIfaceCore
PartialIfaceBinHandle

  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_top_env 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_top_env field is used
     -- by GHCi to decide whether the module has its full top-level
     -- scope available. (#5534)
     mkIfaceTopEnv :: GlobalRdrEnv -> IfaceTopEnv
     mkIfaceTopEnv :: GlobalRdrEnv -> IfaceTopEnv
mkIfaceTopEnv GlobalRdrEnv
rdr_env
        = let !exports :: DetOrdAvails
exports = [AvailInfo] -> DetOrdAvails
sortAvails ([AvailInfo] -> DetOrdAvails) -> [AvailInfo] -> DetOrdAvails
forall a b. (a -> b) -> a -> b
$ [GlobalRdrEltX GREInfo] -> [AvailInfo]
forall info. [GlobalRdrEltX info] -> [AvailInfo]
gresToAvailInfo ([GlobalRdrEltX GREInfo] -> [AvailInfo])
-> [GlobalRdrEltX GREInfo] -> [AvailInfo]
forall a b. (a -> b) -> a -> b
$ GlobalRdrEnv -> [GlobalRdrEltX GREInfo]
forall info. GlobalRdrEnvX info -> [GlobalRdrEltX info]
globalRdrEnvElts (GlobalRdrEnv -> [GlobalRdrEltX GREInfo])
-> GlobalRdrEnv -> [GlobalRdrEltX GREInfo]
forall a b. (a -> b) -> a -> b
$ GlobalRdrEnv -> GlobalRdrEnv
forall info. GlobalRdrEnvX info -> GlobalRdrEnvX info
globalRdrEnvLocal GlobalRdrEnv
rdr_env
              !imports :: [IfaceImport]
imports = [ImportUserSpec] -> [IfaceImport]
mkIfaceImports [ImportUserSpec]
import_decls
           in DetOrdAvails -> [IfaceImport] -> IfaceTopEnv
IfaceTopEnv DetOrdAvails
exports [IfaceImport]
imports

     ifFamInstTcName :: IfaceFamInst -> Name
ifFamInstTcName = IfaceFamInst -> Name
ifFamInstFam

--------------------------
defaultsToIfaceDefaults :: DefaultEnv -> [IfaceDefault]
defaultsToIfaceDefaults :: DefaultEnv -> [IfaceDefault]
defaultsToIfaceDefaults = (ClassDefaults -> IfaceDefault)
-> [ClassDefaults] -> [IfaceDefault]
forall a b. (a -> b) -> [a] -> [b]
map ClassDefaults -> IfaceDefault
toIface ([ClassDefaults] -> [IfaceDefault])
-> (DefaultEnv -> [ClassDefaults]) -> DefaultEnv -> [IfaceDefault]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DefaultEnv -> [ClassDefaults]
defaultList
  where
    toIface :: ClassDefaults -> IfaceDefault
toIface ClassDefaults { cd_class :: ClassDefaults -> Class
cd_class = Class
cls
                          , cd_types :: ClassDefaults -> [Type]
cd_types = [Type]
tys
                          , cd_warn :: ClassDefaults -> Maybe (WarningTxt GhcRn)
cd_warn = Maybe (WarningTxt GhcRn)
warn }
      = IfaceDefault { ifDefaultCls :: Name
ifDefaultCls = Class -> Name
className Class
cls
                     , ifDefaultTys :: [IfaceType]
ifDefaultTys = (Type -> IfaceType) -> [Type] -> [IfaceType]
forall a b. (a -> b) -> [a] -> [b]
map Type -> IfaceType
toIfaceType [Type]
tys
                     , ifDefaultWarn :: Maybe IfaceWarningTxt
ifDefaultWarn = (WarningTxt GhcRn -> IfaceWarningTxt)
-> Maybe (WarningTxt GhcRn) -> Maybe IfaceWarningTxt
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WarningTxt GhcRn -> IfaceWarningTxt
toIfaceWarningTxt Maybe (WarningTxt GhcRn)
warn }

--------------------------
instanceToIfaceInst :: ClsInst -> IfaceClsInst
instanceToIfaceInst :: ClsInst -> IfaceClsInst
instanceToIfaceInst (ClsInst { is_dfun :: ClsInst -> Id
is_dfun = Id
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
                             , is_warn :: ClsInst -> Maybe (WarningTxt GhcRn)
is_warn = Maybe (WarningTxt GhcRn)
warn })
  = 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     = Id -> Name
idName Id
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.mkImportedClsInst
                 , ifInstOrph :: IsOrphan
ifInstOrph = IsOrphan
orph
                 , ifInstWarn :: Maybe IfaceWarningTxt
ifInstWarn = (WarningTxt GhcRn -> IfaceWarningTxt)
-> Maybe (WarningTxt GhcRn) -> Maybe IfaceWarningTxt
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WarningTxt GhcRn -> IfaceWarningTxt
toIfaceWarningTxt Maybe (WarningTxt GhcRn)
warn }

--------------------------
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
                               , fi_orphan :: FamInst -> IsOrphan
fi_orphan   = IsOrphan
orphan })
  = 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
orphan }

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 {})
  = FilePath -> SDoc -> IfaceRule
forall a. HasCallStack => FilePath -> SDoc -> a
pprPanic FilePath
"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 -> [Id]
ru_bndrs = [Id]
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 = (Id -> IfaceBndr) -> [Id] -> [IfaceBndr]
forall a b. (a -> b) -> [a] -> [b]
map Id -> IfaceBndr
toIfaceBndr [Id]
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


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

mkIfaceCompleteMatch :: CompleteMatch -> IfaceCompleteMatch
mkIfaceCompleteMatch :: CompleteMatch -> IfaceCompleteMatch
mkIfaceCompleteMatch (CompleteMatch UniqDSet Name
cls Maybe Name
mtc) =
  -- NB: Sorting here means that COMPLETE {P, Q} and COMPLETE {Q, P} are
  -- considered identical, in particular for recompilation checking.
  [Name] -> Maybe Name -> IfaceCompleteMatch
IfaceCompleteMatch ((Name -> Name -> Ordering) -> [Name] -> [Name]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy Name -> Name -> Ordering
stableNameCmp ([Name] -> [Name]) -> [Name] -> [Name]
forall a b. (a -> b) -> a -> b
$ UniqDSet Name -> [Name]
forall a. UniqDSet a -> [a]
uniqDSetToList UniqDSet Name
cls) Maybe Name
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
    }

mkIfaceImports :: [ImportUserSpec] -> [IfaceImport]
mkIfaceImports :: [ImportUserSpec] -> [IfaceImport]
mkIfaceImports = (ImportUserSpec -> IfaceImport)
-> [ImportUserSpec] -> [IfaceImport]
forall a b. (a -> b) -> [a] -> [b]
map ImportUserSpec -> IfaceImport
go
  where
    go :: ImportUserSpec -> IfaceImport
go (ImpUserSpec ImpDeclSpec
decl ImpUserList
ImpUserAll) = ImpDeclSpec -> ImpIfaceList -> IfaceImport
IfaceImport ImpDeclSpec
decl ImpIfaceList
ImpIfaceAll
    go (ImpUserSpec ImpDeclSpec
decl (ImpUserExplicit [AvailInfo]
env)) = ImpDeclSpec -> ImpIfaceList -> IfaceImport
IfaceImport ImpDeclSpec
decl (DetOrdAvails -> ImpIfaceList
ImpIfaceExplicit ([AvailInfo] -> DetOrdAvails
sortAvails [AvailInfo]
env))
    go (ImpUserSpec ImpDeclSpec
decl (ImpUserEverythingBut NameSet
ns)) = ImpDeclSpec -> ImpIfaceList -> IfaceImport
IfaceImport ImpDeclSpec
decl ([Name] -> ImpIfaceList
ImpIfaceEverythingBut (NameSet -> [Name]
nameSetElemsStable NameSet
ns))

mkIfaceExports :: [AvailInfo] -> [IfaceExport] -- Sort to make canonical
mkIfaceExports :: [AvailInfo] -> [AvailInfo]
mkIfaceExports [AvailInfo]
as = case [AvailInfo] -> DetOrdAvails
sortAvails [AvailInfo]
as of DefinitelyDeterministicAvails [AvailInfo]
sas -> [AvailInfo]
sas

{-
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.
-}

{-
Note [Sharing of ModIface]
~~~~~~~~~~~~~~~~~~~~~~~~~~
A 'ModIface' contains many duplicated values such as 'Name', 'FastString' and 'IfaceType'.
'Name's and 'FastString's are already deduplicated by default using the 'NameCache' and
'FastStringTable' respectively.
However, 'IfaceType' can be quite expensive in terms of memory usage.
To improve the sharing of 'IfaceType', we introduced deduplication tables during
serialisation of 'ModIface', see Note [Deduplication during iface binary serialisation].

We can improve the sharing of 'ModIface' at run-time as well, by serialising the 'ModIface' to
an in-memory buffer, and then deserialising it again.
This implicitly shares duplicated values.

To avoid re-serialising the 'ModIface' when writing it to disk, we save the serialised 'ModIface' buffer
in 'mi_hi_bytes_' field of said 'ModIface'. This buffer is written to disk directly in 'putIfaceWithExtFields'.
If we have to modify the 'ModIface' after 'shareIface' is called, the buffer needs to be discarded.
-}