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

import GHC.Prelude

import GHC.Hs

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

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

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.ConLike
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.DynFlags
import GHC.Driver.Plugins

import GHC.Types.Id
import GHC.Types.Fixity.Env
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.Unique.DSet
import GHC.Types.TypeEnv
import GHC.Types.SourceFile
import GHC.Types.TyThing
import GHC.Types.HpcInfo
import GHC.Types.CompleteMatch
import GHC.Types.SourceText
import GHC.Types.SrcLoc ( unLoc )

import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.Panic.Plain
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 ( sortBy )
import Data.Ord
import Data.IORef


{-
************************************************************************
*                                                                      *
\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 = HasDebugCallStack => 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 Id -> IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo
toIfaceTopBind Bind Id
b | Bind Id
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 :: 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)
-> [CompleteMatch] -> [IfaceCompleteMatch]
forall a b. (a -> b) -> [a] -> [b]
map CompleteMatch -> IfaceCompleteMatch
mkIfaceCompleteMatch [CompleteMatch]
complete_matches
        !rdrs :: Maybe IfGlobalRdrEnv
rdrs = GlobalRdrEnv -> Maybe IfGlobalRdrEnv
maybeGlobalRdrEnv GlobalRdrEnv
rdr_env

    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 :: IfaceWarnings
mi_warns       = IfaceWarnings
warns,
          mi_anns :: [IfaceAnnotation]
mi_anns        = [IfaceAnnotation]
annotations,
          mi_globals :: Maybe IfGlobalRdrEnv
mi_globals     = Maybe IfGlobalRdrEnv
rdrs,
          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 IfGlobalRdrEnv
     maybeGlobalRdrEnv :: GlobalRdrEnv -> Maybe IfGlobalRdrEnv
maybeGlobalRdrEnv GlobalRdrEnv
rdr_env
        | Backend -> Bool
backendWantsGlobalBindings (DynFlags -> Backend
backend DynFlags
dflags)
        = IfGlobalRdrEnv -> Maybe IfGlobalRdrEnv
forall a. a -> Maybe a
Just (IfGlobalRdrEnv -> Maybe IfGlobalRdrEnv)
-> IfGlobalRdrEnv -> Maybe IfGlobalRdrEnv
forall a b. (a -> b) -> a -> b
$! GlobalRdrEnv -> IfGlobalRdrEnv
forall info. GlobalRdrEnvX info -> IfGlobalRdrEnv
forceGlobalRdrEnv GlobalRdrEnv
rdr_env
          -- See Note [Forcing GREInfo] in GHC.Types.GREInfo.
        | Bool
otherwise
        = Maybe IfGlobalRdrEnv
forall a. Maybe a
Nothing

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


--------------------------
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 })
  = 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 }

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

--------------------------
toIfaceWarnings :: Warnings GhcRn -> IfaceWarnings
toIfaceWarnings :: Warnings GhcRn -> IfaceWarnings
toIfaceWarnings (WarnAll WarningTxt GhcRn
txt) = IfaceWarningTxt -> IfaceWarnings
IfWarnAll (WarningTxt GhcRn -> IfaceWarningTxt
toIfaceWarningTxt WarningTxt GhcRn
txt)
toIfaceWarnings (WarnSome DeclWarnOccNames GhcRn
vs ExportWarnNames GhcRn
ds) = [(OccName, IfaceWarningTxt)]
-> [(Name, IfaceWarningTxt)] -> IfaceWarnings
IfWarnSome [(OccName, IfaceWarningTxt)]
vs' [(Name, IfaceWarningTxt)]
ds'
  where
    vs' :: [(OccName, IfaceWarningTxt)]
vs' = [(OccName
occ, WarningTxt GhcRn -> IfaceWarningTxt
toIfaceWarningTxt WarningTxt GhcRn
txt) | (OccName
occ, WarningTxt GhcRn
txt) <- DeclWarnOccNames GhcRn
vs]
    ds' :: [(Name, IfaceWarningTxt)]
ds' = [(Name
occ, WarningTxt GhcRn -> IfaceWarningTxt
toIfaceWarningTxt WarningTxt GhcRn
txt) | (Name
occ, WarningTxt GhcRn
txt) <- ExportWarnNames GhcRn
ds]

toIfaceWarningTxt :: WarningTxt GhcRn -> IfaceWarningTxt
toIfaceWarningTxt :: WarningTxt GhcRn -> IfaceWarningTxt
toIfaceWarningTxt (WarningTxt Maybe (Located InWarningCategory)
mb_cat Located SourceText
src [Located (WithHsDocIdentifiers StringLiteral GhcRn)]
strs) = Maybe WarningCategory
-> SourceText -> [(IfaceStringLiteral, [Name])] -> IfaceWarningTxt
IfWarningTxt (GenLocated SrcSpan WarningCategory -> WarningCategory
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpan WarningCategory -> WarningCategory)
-> (Located InWarningCategory
    -> GenLocated SrcSpan WarningCategory)
-> Located InWarningCategory
-> WarningCategory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InWarningCategory -> GenLocated SrcSpan WarningCategory
iwc_wc (InWarningCategory -> GenLocated SrcSpan WarningCategory)
-> (Located InWarningCategory -> InWarningCategory)
-> Located InWarningCategory
-> GenLocated SrcSpan WarningCategory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located InWarningCategory -> InWarningCategory
forall l e. GenLocated l e -> e
unLoc (Located InWarningCategory -> WarningCategory)
-> Maybe (Located InWarningCategory) -> Maybe WarningCategory
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Located InWarningCategory)
mb_cat) (Located SourceText -> SourceText
forall l e. GenLocated l e -> e
unLoc Located SourceText
src) ((Located (WithHsDocIdentifiers StringLiteral GhcRn)
 -> (IfaceStringLiteral, [Name]))
-> [Located (WithHsDocIdentifiers StringLiteral GhcRn)]
-> [(IfaceStringLiteral, [Name])]
forall a b. (a -> b) -> [a] -> [b]
map (WithHsDocIdentifiers StringLiteral GhcRn
-> (IfaceStringLiteral, [Name])
toIfaceStringLiteralWithNames (WithHsDocIdentifiers StringLiteral GhcRn
 -> (IfaceStringLiteral, [Name]))
-> (Located (WithHsDocIdentifiers StringLiteral GhcRn)
    -> WithHsDocIdentifiers StringLiteral GhcRn)
-> Located (WithHsDocIdentifiers StringLiteral GhcRn)
-> (IfaceStringLiteral, [Name])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (WithHsDocIdentifiers StringLiteral GhcRn)
-> WithHsDocIdentifiers StringLiteral GhcRn
forall l e. GenLocated l e -> e
unLoc) [Located (WithHsDocIdentifiers StringLiteral GhcRn)]
strs)
toIfaceWarningTxt (DeprecatedTxt Located SourceText
src [Located (WithHsDocIdentifiers StringLiteral GhcRn)]
strs) = SourceText -> [(IfaceStringLiteral, [Name])] -> IfaceWarningTxt
IfDeprecatedTxt (Located SourceText -> SourceText
forall l e. GenLocated l e -> e
unLoc Located SourceText
src) ((Located (WithHsDocIdentifiers StringLiteral GhcRn)
 -> (IfaceStringLiteral, [Name]))
-> [Located (WithHsDocIdentifiers StringLiteral GhcRn)]
-> [(IfaceStringLiteral, [Name])]
forall a b. (a -> b) -> [a] -> [b]
map (WithHsDocIdentifiers StringLiteral GhcRn
-> (IfaceStringLiteral, [Name])
toIfaceStringLiteralWithNames (WithHsDocIdentifiers StringLiteral GhcRn
 -> (IfaceStringLiteral, [Name]))
-> (Located (WithHsDocIdentifiers StringLiteral GhcRn)
    -> WithHsDocIdentifiers StringLiteral GhcRn)
-> Located (WithHsDocIdentifiers StringLiteral GhcRn)
-> (IfaceStringLiteral, [Name])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (WithHsDocIdentifiers StringLiteral GhcRn)
-> WithHsDocIdentifiers StringLiteral GhcRn
forall l e. GenLocated l e -> e
unLoc) [Located (WithHsDocIdentifiers StringLiteral GhcRn)]
strs)

toIfaceStringLiteralWithNames :: WithHsDocIdentifiers StringLiteral GhcRn -> (IfaceStringLiteral, [IfExtName])
toIfaceStringLiteralWithNames :: WithHsDocIdentifiers StringLiteral GhcRn
-> (IfaceStringLiteral, [Name])
toIfaceStringLiteralWithNames (WithHsDocIdentifiers StringLiteral
src [Located (IdP GhcRn)]
names) = (StringLiteral -> IfaceStringLiteral
toIfaceStringLiteral StringLiteral
src, (GenLocated SrcSpan Name -> Name)
-> [GenLocated SrcSpan Name] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpan Name -> Name
forall l e. GenLocated l e -> e
unLoc [Located (IdP GhcRn)]
[GenLocated SrcSpan Name]
names)

toIfaceStringLiteral :: StringLiteral -> IfaceStringLiteral
toIfaceStringLiteral :: StringLiteral -> IfaceStringLiteral
toIfaceStringLiteral (StringLiteral SourceText
sl FastString
fs Maybe RealSrcSpan
_) = SourceText -> FastString -> IfaceStringLiteral
IfStringLiteral SourceText
sl FastString
fs

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 -> [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 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 Name
n) = Name -> AvailInfo
Avail Name
n
    sort_subs (AvailTC Name
n []) = Name -> [Name] -> AvailInfo
AvailTC Name
n []
    sort_subs (AvailTC Name
n (Name
m:[Name]
ms))
       | Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
m
       = Name -> [Name] -> AvailInfo
AvailTC Name
n (Name
mName -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:(Name -> Name -> Ordering) -> [Name] -> [Name]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy Name -> Name -> Ordering
stableNameCmp [Name]
ms)
       | Bool
otherwise
       = Name -> [Name] -> AvailInfo
AvailTC Name
n ((Name -> Name -> Ordering) -> [Name] -> [Name]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy Name -> Name -> Ordering
stableNameCmp (Name
mName -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[Name]
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.
-}