{-# LANGUAGE CPP                      #-}
{-# LANGUAGE NondecreasingIndentation #-}

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

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

#include "HsVersions.h"

import GHC.Prelude

import GHC.Hs

import GHC.StgToCmm.Types (CgInfos (..))

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

import GHC.Iface.Syntax
import GHC.Iface.Recomp
import GHC.Iface.Load
import GHC.Iface.Ext.Fields

import GHC.CoreToIface

import qualified GHC.LanguageExtensions as LangExt
import GHC.Core
import GHC.Core.Class
import GHC.Core.TyCon
import GHC.Core.Coercion.Axiom
import GHC.Core.ConLike
import GHC.Core.DataCon
import GHC.Core.Type
import GHC.Core.Multiplicity
import GHC.Core.InstEnv
import GHC.Core.FamInstEnv
import GHC.Core.Unify( RoughMatchTc(..) )

import GHC.Driver.Env
import GHC.Driver.Backend
import GHC.Driver.Session
import GHC.Driver.Ppr
import GHC.Driver.Plugins (LoadedPlugin(..))

import GHC.Types.Id
import GHC.Types.Fixity.Env
import GHC.Types.SafeHaskell
import GHC.Types.Annotations
import GHC.Types.Var.Env
import GHC.Types.Var
import GHC.Types.Name
import GHC.Types.Avail
import GHC.Types.Name.Reader
import GHC.Types.Name.Env
import GHC.Types.Name.Set
import GHC.Types.Unique.DSet
import GHC.Types.Basic hiding ( SuccessFlag(..) )
import GHC.Types.TypeEnv
import GHC.Types.SourceFile
import GHC.Types.TyThing
import GHC.Types.HpcInfo
import GHC.Types.CompleteMatch

import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.Misc  hiding ( eqListBy )
import GHC.Utils.Logger

import GHC.Data.FastString
import GHC.Data.Maybe

import GHC.HsToCore.Docs
import GHC.HsToCore.Usage ( mkUsageInfo, mkUsedNames, mkDependencies )

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.Deps

import Data.Function
import Data.List ( findIndex, mapAccumL, sortBy )
import Data.Ord
import Data.IORef

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

mkPartialIface :: HscEnv
               -> ModDetails
               -> ModGuts
               -> PartialModIface
mkPartialIface :: HscEnv -> ModDetails -> ModGuts -> PartialModIface
mkPartialIface HscEnv
hsc_env ModDetails
mod_details
  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
mg_warns        = Warnings
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_doc_hdr :: ModGuts -> Maybe HsDocString
mg_doc_hdr      = Maybe HsDocString
doc_hdr
         , mg_decl_docs :: ModGuts -> DeclDocMap
mg_decl_docs    = DeclDocMap
decl_docs
         , mg_arg_docs :: ModGuts -> ArgDocMap
mg_arg_docs     = ArgDocMap
arg_docs
         }
  = HscEnv
-> Module
-> HscSource
-> Bool
-> Dependencies
-> GlobalRdrEnv
-> FixityEnv
-> Warnings
-> HpcInfo
-> Bool
-> SafeHaskellMode
-> [Usage]
-> Maybe HsDocString
-> DeclDocMap
-> ArgDocMap
-> ModDetails
-> PartialModIface
mkIface_ HscEnv
hsc_env Module
this_mod HscSource
hsc_src Bool
used_th Dependencies
deps GlobalRdrEnv
rdr_env FixityEnv
fix_env Warnings
warns HpcInfo
hpc_info Bool
self_trust
             SafeHaskellMode
safe_mode [Usage]
usages Maybe HsDocString
doc_hdr DeclDocMap
decl_docs ArgDocMap
arg_docs ModDetails
mod_details

-- | Fully instantiate an interface. Adds fingerprints and potentially code
-- generator produced information.
--
-- CgInfos 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 CgInfos -> IO ModIface
mkFullIface :: HscEnv -> PartialModIface -> Maybe CgInfos -> IO ModIface
mkFullIface HscEnv
hsc_env PartialModIface
partial_iface Maybe CgInfos
mb_cg_infos = do
    let decls :: [IfaceDeclExts 'ModIfaceCore]
decls
          | GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_OmitInterfacePragmas (HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env)
          = forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceDeclExts phase]
mi_decls PartialModIface
partial_iface
          | Bool
otherwise
          = [IfaceDecl] -> Maybe CgInfos -> [IfaceDecl]
updateDecl (forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceDeclExts phase]
mi_decls PartialModIface
partial_iface) Maybe CgInfos
mb_cg_infos

    ModIface
full_iface <-
      {-# SCC "addFingerprints" #-}
      HscEnv -> PartialModIface -> IO ModIface
addFingerprints HscEnv
hsc_env PartialModIface
partial_iface{ mi_decls :: [IfaceDeclExts 'ModIfaceCore]
mi_decls = [IfaceDeclExts 'ModIfaceCore]
decls }

    -- Debug printing
    let unit_state :: UnitState
unit_state = HscEnv -> UnitState
hsc_units HscEnv
hsc_env
    Logger
-> DynFlags -> DumpFlag -> String -> DumpFormat -> SDoc -> IO ()
dumpIfSet_dyn (HscEnv -> Logger
hsc_logger HscEnv
hsc_env) (HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env) DumpFlag
Opt_D_dump_hi String
"FINAL INTERFACE" DumpFormat
FormatText
      (UnitState -> ModIface -> SDoc
pprModIface UnitState
unit_state ModIface
full_iface)

    forall (m :: * -> *) a. Monad m => a -> m a
return ModIface
full_iface

updateDecl :: [IfaceDecl] -> Maybe CgInfos -> [IfaceDecl]
updateDecl :: [IfaceDecl] -> Maybe CgInfos -> [IfaceDecl]
updateDecl [IfaceDecl]
decls Maybe CgInfos
Nothing = [IfaceDecl]
decls
updateDecl [IfaceDecl]
decls (Just CgInfos{ cgNonCafs :: CgInfos -> NonCaffySet
cgNonCafs = NonCaffySet NameSet
non_cafs, cgLFInfos :: CgInfos -> ModuleLFInfos
cgLFInfos = ModuleLFInfos
lf_infos }) = forall a b. (a -> b) -> [a] -> [b]
map IfaceDecl -> IfaceDecl
update_decl [IfaceDecl]
decls
  where
    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 = forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv ModuleLFInfos
lf_infos Name
nm
      , WARN( isNothing mb_lf_info, text "Name without LFInfo:" <+> ppr nm ) True
        -- Only allocate a new IfaceId if we're going to update the infos
      , forall a. Maybe a -> Bool
isJust Maybe LambdaFormInfo
mb_lf_info Bool -> Bool -> Bool
|| Bool
not_caffy
      = Name -> IfaceType -> IfaceIdDetails -> IfaceIdInfo -> IfaceDecl
IfaceId Name
nm IfaceType
ty IfaceIdDetails
details forall a b. (a -> b) -> a -> b
$
          (if Bool
not_caffy then (IfaceInfoItem
HsNoCafRefs forall a. a -> [a] -> [a]
:) else forall a. a -> a
id)
          (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) 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
          -> TcGblEnv           -- Usages, deprecations, etc
          -> IO ModIface
mkIfaceTc :: HscEnv -> SafeHaskellMode -> ModDetails -> TcGblEnv -> IO ModIface
mkIfaceTc HscEnv
hsc_env SafeHaskellMode
safe_mode ModDetails
mod_details
  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
tcg_warns = Warnings
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 = forall a b. (a -> b) -> [a] -> [b]
map LoadedPlugin -> ModIface
lpModule (HscEnv -> [LoadedPlugin]
hsc_plugins HscEnv
hsc_env)
          let home_unit :: HomeUnit
home_unit = HscEnv -> HomeUnit
hsc_home_unit HscEnv
hsc_env
          Dependencies
deps <- UnitId -> [Module] -> TcGblEnv -> IO Dependencies
mkDependencies (forall u. GenHomeUnit u -> UnitId
homeUnitId HomeUnit
home_unit)
                    (forall a b. (a -> b) -> [a] -> [b]
map forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module [ModIface]
pluginModules) TcGblEnv
tc_result
          let hpc_info :: HpcInfo
hpc_info = Bool -> HpcInfo
emptyHpcInfo Bool
other_hpc_info
          Bool
used_th <- forall a. IORef a -> IO a
readIORef TcRef Bool
tc_splice_used
          [String]
dep_files <- (forall a. IORef a -> IO a
readIORef TcRef [String]
dependent_files)
          -- 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
-> Module
-> ImportedMods
-> NameSet
-> [String]
-> [(Module, Fingerprint)]
-> [ModIface]
-> IO [Usage]
mkUsageInfo HscEnv
hsc_env Module
this_mod (ImportAvails -> ImportedMods
imp_mods ImportAvails
imports) NameSet
used_names
                      [String]
dep_files [(Module, Fingerprint)]
merged [ModIface]
pluginModules

          (Maybe HsDocString
doc_hdr', DeclDocMap
doc_map, ArgDocMap
arg_map) <- forall (m :: * -> *).
MonadIO m =>
TcGblEnv -> m (Maybe HsDocString, DeclDocMap, ArgDocMap)
extractDocs TcGblEnv
tc_result

          let partial_iface :: PartialModIface
partial_iface = HscEnv
-> Module
-> HscSource
-> Bool
-> Dependencies
-> GlobalRdrEnv
-> FixityEnv
-> Warnings
-> HpcInfo
-> Bool
-> SafeHaskellMode
-> [Usage]
-> Maybe HsDocString
-> DeclDocMap
-> ArgDocMap
-> ModDetails
-> PartialModIface
mkIface_ HscEnv
hsc_env
                   Module
this_mod HscSource
hsc_src
                   Bool
used_th Dependencies
deps GlobalRdrEnv
rdr_env
                   FixityEnv
fix_env Warnings
warns HpcInfo
hpc_info
                   (ImportAvails -> Bool
imp_trust_own_pkg ImportAvails
imports) SafeHaskellMode
safe_mode [Usage]
usages
                   Maybe HsDocString
doc_hdr' DeclDocMap
doc_map ArgDocMap
arg_map
                   ModDetails
mod_details

          HscEnv -> PartialModIface -> Maybe CgInfos -> IO ModIface
mkFullIface HscEnv
hsc_env PartialModIface
partial_iface forall a. Maybe a
Nothing

mkIface_ :: HscEnv -> Module -> HscSource
         -> Bool -> Dependencies -> GlobalRdrEnv
         -> NameEnv FixItem -> Warnings -> HpcInfo
         -> Bool
         -> SafeHaskellMode
         -> [Usage]
         -> Maybe HsDocString
         -> DeclDocMap
         -> ArgDocMap
         -> ModDetails
         -> PartialModIface
mkIface_ :: HscEnv
-> Module
-> HscSource
-> Bool
-> Dependencies
-> GlobalRdrEnv
-> FixityEnv
-> Warnings
-> HpcInfo
-> Bool
-> SafeHaskellMode
-> [Usage]
-> Maybe HsDocString
-> DeclDocMap
-> ArgDocMap
-> ModDetails
-> PartialModIface
mkIface_ HscEnv
hsc_env
         Module
this_mod HscSource
hsc_src Bool
used_th Dependencies
deps GlobalRdrEnv
rdr_env FixityEnv
fix_env Warnings
src_warns
         HpcInfo
hpc_info Bool
pkg_trust_req SafeHaskellMode
safe_mode [Usage]
usages
         Maybe HsDocString
doc_hdr DeclDocMap
decl_docs ArgDocMap
arg_docs
         ModDetails{  md_insts :: ModDetails -> [ClsInst]
md_insts     = [ClsInst]
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 (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)
        decls :: [IfaceDecl]
decls  = [ Bool -> TyThing -> IfaceDecl
tyThingToIfaceDecl Bool
show_linear_types TyThing
entity
                 | TyThing
entity <- [TyThing]
entities,
                   let name :: Name
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    = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall a b. (a, b) -> a
fst)
          [(OccName
occ,Fixity
fix) | FixItem OccName
occ Fixity
fix <- forall a. NameEnv a -> [a]
nameEnvElts FixityEnv
fix_env]
          -- The order of fixities returned from nameEnvElts is not
          -- deterministic, so we sort by OccName to canonicalize it.
          -- See Note [Deterministic UniqFM] in GHC.Types.Unique.DFM for more details.
        warns :: Warnings
warns       = Warnings
src_warns
        iface_rules :: [IfaceRule]
iface_rules = forall a b. (a -> b) -> [a] -> [b]
map CoreRule -> IfaceRule
coreRuleToIfaceRule [CoreRule]
rules
        iface_insts :: [IfaceClsInst]
iface_insts = forall a b. (a -> b) -> [a] -> [b]
map ClsInst -> IfaceClsInst
instanceToIfaceInst forall a b. (a -> b) -> a -> b
$ SafeHaskellMode -> [ClsInst] -> [ClsInst]
fixSafeInstances SafeHaskellMode
safe_mode [ClsInst]
insts
        iface_fam_insts :: [IfaceFamInst]
iface_fam_insts = 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 = forall a b. (a -> b) -> [a] -> [b]
map Annotation -> IfaceAnnotation
mkIfaceAnnotation [Annotation]
anns
        icomplete_matches :: [IfaceCompleteMatch]
icomplete_matches = forall a b. (a -> b) -> [a] -> [b]
map CompleteMatch -> IfaceCompleteMatch
mkIfaceCompleteMatch [CompleteMatch]
complete_matches

    ModIface {
          mi_module :: Module
mi_module      = Module
this_mod,
          -- Need to record this because it depends on the -instantiated-with flag
          -- which could change
          mi_sig_of :: Maybe Module
mi_sig_of      = if Module
semantic_mod forall a. Eq a => a -> a -> Bool
== Module
this_mod
                            then forall a. Maybe a
Nothing
                            else 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       = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy IfaceClsInst -> IfaceClsInst -> Ordering
cmp_inst     [IfaceClsInst]
iface_insts,
          mi_fam_insts :: [IfaceFamInst]
mi_fam_insts   = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy IfaceFamInst -> IfaceFamInst -> Ordering
cmp_fam_inst [IfaceFamInst]
iface_fam_insts,
          mi_rules :: [IfaceRule]
mi_rules       = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy IfaceRule -> IfaceRule -> Ordering
cmp_rule     [IfaceRule]
iface_rules,

          mi_fixities :: [(OccName, Fixity)]
mi_fixities    = [(OccName, Fixity)]
fixities,
          mi_warns :: Warnings
mi_warns       = Warnings
warns,
          mi_anns :: [IfaceAnnotation]
mi_anns        = [IfaceAnnotation]
annotations,
          mi_globals :: Maybe GlobalRdrEnv
mi_globals     = GlobalRdrEnv -> Maybe GlobalRdrEnv
maybeGlobalRdrEnv GlobalRdrEnv
rdr_env,
          mi_used_th :: Bool
mi_used_th     = Bool
used_th,
          mi_decls :: [IfaceDeclExts 'ModIfaceCore]
mi_decls       = [IfaceDecl]
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_doc_hdr :: Maybe HsDocString
mi_doc_hdr     = Maybe HsDocString
doc_hdr,
          mi_decl_docs :: DeclDocMap
mi_decl_docs   = DeclDocMap
decl_docs,
          mi_arg_docs :: ArgDocMap
mi_arg_docs    = ArgDocMap
arg_docs,
          mi_final_exts :: IfaceBackendExts 'ModIfaceCore
mi_final_exts  = (),
          mi_ext_fields :: ExtensibleFields
mi_ext_fields  = ExtensibleFields
emptyExtensibleFields }
  where
     cmp_rule :: IfaceRule -> IfaceRule -> Ordering
cmp_rule     = FastString -> FastString -> Ordering
lexicalCompareFS 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     = forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Name -> OccName
nameOccName forall b c a. (b -> c) -> (a -> b) -> a -> c
. IfaceClsInst -> Name
ifDFun)
     cmp_fam_inst :: IfaceFamInst -> IfaceFamInst -> Ordering
cmp_fam_inst = forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Name -> OccName
nameOccName forall b c a. (b -> c) -> (a -> b) -> a -> c
. IfaceFamInst -> Name
ifFamInstTcName)

     dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env

     -- We only fill in mi_globals if the module was compiled to byte
     -- code.  Otherwise, the compiler may not have retained all the
     -- top-level bindings and they won't be in the TypeEnv (see
     -- Desugar.addExportFlagsAndRules).  The mi_globals field is used
     -- by GHCi to decide whether the module has its full top-level
     -- scope available. (#5534)
     maybeGlobalRdrEnv :: GlobalRdrEnv -> Maybe GlobalRdrEnv
     maybeGlobalRdrEnv :: GlobalRdrEnv -> Maybe GlobalRdrEnv
maybeGlobalRdrEnv GlobalRdrEnv
rdr_env
         | Backend -> Bool
backendRetainsAllBindings (DynFlags -> Backend
backend DynFlags
dflags) = forall a. a -> Maybe a
Just GlobalRdrEnv
rdr_env
         | Bool
otherwise                                  = forall a. Maybe a
Nothing

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


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

mkIfaceCompleteMatch :: CompleteMatch -> IfaceCompleteMatch
mkIfaceCompleteMatch :: CompleteMatch -> IfaceCompleteMatch
mkIfaceCompleteMatch (CompleteMatch UniqDSet ConLike
cls Maybe TyCon
mtc) =
  [Name] -> Maybe IfaceTyCon -> IfaceCompleteMatch
IfaceCompleteMatch (forall a b. (a -> b) -> [a] -> [b]
map ConLike -> Name
conLikeName (forall a. UniqDSet a -> [a]
uniqDSetToList UniqDSet ConLike
cls)) (TyCon -> IfaceTyCon
toIfaceTyCon 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 = 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
  = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy AvailInfo -> AvailInfo -> Ordering
stableAvailCmp (forall a b. (a -> b) -> [a] -> [b]
map AvailInfo -> AvailInfo
sort_subs [AvailInfo]
exports)
  where
    sort_subs :: AvailInfo -> AvailInfo
    sort_subs :: AvailInfo -> AvailInfo
sort_subs (Avail GreName
n) = GreName -> AvailInfo
Avail GreName
n
    sort_subs (AvailTC Name
n []) = Name -> [GreName] -> AvailInfo
AvailTC Name
n []
    sort_subs (AvailTC Name
n (GreName
m:[GreName]
ms))
       | Name -> GreName
NormalGreName Name
nforall a. Eq a => a -> a -> Bool
==GreName
m  = Name -> [GreName] -> AvailInfo
AvailTC Name
n (GreName
mforall a. a -> [a] -> [a]
:forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy GreName -> GreName -> Ordering
stableGreNameCmp [GreName]
ms)
       | Bool
otherwise = Name -> [GreName] -> AvailInfo
AvailTC Name
n (forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy GreName -> GreName -> Ordering
stableGreNameCmp (GreName
mforall a. a -> [a] -> [a]
:[GreName]
ms))
       -- Maintain the AvailTC Invariant

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

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


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

tyThingToIfaceDecl :: Bool -> TyThing -> IfaceDecl
tyThingToIfaceDecl :: Bool -> TyThing -> IfaceDecl
tyThingToIfaceDecl Bool
_ (AnId TyCoVar
id)      = TyCoVar -> IfaceDecl
idToIfaceDecl TyCoVar
id
tyThingToIfaceDecl Bool
_ (ATyCon TyCon
tycon) = forall a b. (a, b) -> b
snd (TidyEnv -> TyCon -> (TidyEnv, IfaceDecl)
tyConToIfaceDecl TidyEnv
emptyTidyEnv TyCon
tycon)
tyThingToIfaceDecl Bool
_ (ACoAxiom CoAxiom Branched
ax)  = forall (br :: BranchFlag). CoAxiom br -> IfaceDecl
coAxiomToIfaceDecl CoAxiom Branched
ax
tyThingToIfaceDecl Bool
show_linear_types (AConLike ConLike
cl)  = case ConLike
cl of
    RealDataCon DataCon
dc -> Bool -> DataCon -> IfaceDecl
dataConToIfaceDecl Bool
show_linear_types DataCon
dc -- for ppr purposes only
    PatSynCon PatSyn
ps   -> PatSyn -> IfaceDecl
patSynToIfaceDecl PatSyn
ps

--------------------------
idToIfaceDecl :: Id -> IfaceDecl
-- The Id is already tidied, so that locally-bound names
-- (lambdas, for-alls) already have non-clashing OccNames
-- We can't tidy it here, locally, because it may have
-- free variables in its type or IdInfo
idToIfaceDecl :: TyCoVar -> IfaceDecl
idToIfaceDecl TyCoVar
id
  = IfaceId { ifName :: Name
ifName      = forall a. NamedThing a => a -> Name
getName TyCoVar
id,
              ifType :: IfaceType
ifType      = Type -> IfaceType
toIfaceType (TyCoVar -> Type
idType TyCoVar
id),
              ifIdDetails :: IfaceIdDetails
ifIdDetails = IdDetails -> IfaceIdDetails
toIfaceIdDetails (TyCoVar -> IdDetails
idDetails TyCoVar
id),
              ifIdInfo :: IfaceIdInfo
ifIdInfo    = IdInfo -> IfaceIdInfo
toIfaceIdInfo (HasDebugCallStack => TyCoVar -> IdInfo
idInfo TyCoVar
id) }

--------------------------
dataConToIfaceDecl :: Bool -> DataCon -> IfaceDecl
dataConToIfaceDecl :: Bool -> DataCon -> IfaceDecl
dataConToIfaceDecl Bool
show_linear_types DataCon
dataCon
  = IfaceId { ifName :: Name
ifName      = forall a. NamedThing a => a -> Name
getName DataCon
dataCon,
              ifType :: IfaceType
ifType      = Type -> IfaceType
toIfaceType (Bool -> DataCon -> Type
dataConDisplayType Bool
show_linear_types DataCon
dataCon),
              ifIdDetails :: IfaceIdDetails
ifIdDetails = IfaceIdDetails
IfVanillaId,
              ifIdInfo :: IfaceIdInfo
ifIdInfo    = [] }

--------------------------
coAxiomToIfaceDecl :: CoAxiom br -> IfaceDecl
-- We *do* tidy Axioms, because they are not (and cannot
-- conveniently be) built in tidy form
coAxiomToIfaceDecl :: forall (br :: BranchFlag). CoAxiom br -> IfaceDecl
coAxiomToIfaceDecl ax :: CoAxiom br
ax@(CoAxiom { co_ax_tc :: forall (br :: BranchFlag). CoAxiom br -> TyCon
co_ax_tc = TyCon
tycon, co_ax_branches :: forall (br :: BranchFlag). CoAxiom br -> Branches br
co_ax_branches = Branches br
branches
                               , co_ax_role :: forall (br :: BranchFlag). CoAxiom br -> Role
co_ax_role = Role
role })
 = IfaceAxiom { ifName :: Name
ifName       = forall a. NamedThing a => a -> Name
getName CoAxiom br
ax
              , ifTyCon :: IfaceTyCon
ifTyCon      = TyCon -> IfaceTyCon
toIfaceTyCon TyCon
tycon
              , ifRole :: Role
ifRole       = Role
role
              , ifAxBranches :: [IfaceAxBranch]
ifAxBranches = forall a b. (a -> b) -> [a] -> [b]
map (TyCon -> [[Type]] -> CoAxBranch -> IfaceAxBranch
coAxBranchToIfaceBranch TyCon
tycon
                                     (forall a b. (a -> b) -> [a] -> [b]
map CoAxBranch -> [Type]
coAxBranchLHS [CoAxBranch]
branch_list))
                                   [CoAxBranch]
branch_list }
 where
   branch_list :: [CoAxBranch]
branch_list = forall (br :: BranchFlag). Branches br -> [CoAxBranch]
fromBranches Branches br
branches

-- 2nd parameter is the list of branch LHSs, in case of a closed type family,
-- for conversion from incompatible branches to incompatible indices.
-- For an open type family the list should be empty.
-- See Note [Storing compatibility] in GHC.Core.Coercion.Axiom
coAxBranchToIfaceBranch :: TyCon -> [[Type]] -> CoAxBranch -> IfaceAxBranch
coAxBranchToIfaceBranch :: TyCon -> [[Type]] -> CoAxBranch -> IfaceAxBranch
coAxBranchToIfaceBranch TyCon
tc [[Type]]
lhs_s
                        (CoAxBranch { cab_tvs :: CoAxBranch -> [TyCoVar]
cab_tvs = [TyCoVar]
tvs, cab_cvs :: CoAxBranch -> [TyCoVar]
cab_cvs = [TyCoVar]
cvs
                                    , cab_eta_tvs :: CoAxBranch -> [TyCoVar]
cab_eta_tvs = [TyCoVar]
eta_tvs
                                    , cab_lhs :: CoAxBranch -> [Type]
cab_lhs = [Type]
lhs, cab_roles :: CoAxBranch -> [Role]
cab_roles = [Role]
roles
                                    , cab_rhs :: CoAxBranch -> Type
cab_rhs = Type
rhs, cab_incomps :: CoAxBranch -> [CoAxBranch]
cab_incomps = [CoAxBranch]
incomps })

  = IfaceAxBranch { ifaxbTyVars :: [IfaceTvBndr]
ifaxbTyVars  = [TyCoVar] -> [IfaceTvBndr]
toIfaceTvBndrs [TyCoVar]
tvs
                  , ifaxbCoVars :: [IfaceIdBndr]
ifaxbCoVars  = forall a b. (a -> b) -> [a] -> [b]
map TyCoVar -> IfaceIdBndr
toIfaceIdBndr [TyCoVar]
cvs
                  , ifaxbEtaTyVars :: [IfaceTvBndr]
ifaxbEtaTyVars = [TyCoVar] -> [IfaceTvBndr]
toIfaceTvBndrs [TyCoVar]
eta_tvs
                  , ifaxbLHS :: IfaceAppArgs
ifaxbLHS     = TyCon -> [Type] -> IfaceAppArgs
toIfaceTcArgs TyCon
tc [Type]
lhs
                  , ifaxbRoles :: [Role]
ifaxbRoles   = [Role]
roles
                  , ifaxbRHS :: IfaceType
ifaxbRHS     = Type -> IfaceType
toIfaceType Type
rhs
                  , ifaxbIncomps :: [Int]
ifaxbIncomps = [Int]
iface_incomps }
  where
    iface_incomps :: [Int]
iface_incomps = forall a b. (a -> b) -> [a] -> [b]
map (forall a. HasCallStack => String -> Maybe a -> a
expectJust String
"iface_incomps"
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex [[Type]]
lhs_s
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Type] -> [Type] -> Bool
eqTypes
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoAxBranch -> [Type]
coAxBranchLHS) [CoAxBranch]
incomps

-----------------
tyConToIfaceDecl :: TidyEnv -> TyCon -> (TidyEnv, IfaceDecl)
-- We *do* tidy TyCons, because they are not (and cannot
-- conveniently be) built in tidy form
-- The returned TidyEnv is the one after tidying the tyConTyVars
tyConToIfaceDecl :: TidyEnv -> TyCon -> (TidyEnv, IfaceDecl)
tyConToIfaceDecl TidyEnv
env TyCon
tycon
  | Just Class
clas <- TyCon -> Maybe Class
tyConClass_maybe TyCon
tycon
  = TidyEnv -> Class -> (TidyEnv, IfaceDecl)
classToIfaceDecl TidyEnv
env Class
clas

  | Just Type
syn_rhs <- TyCon -> Maybe Type
synTyConRhs_maybe TyCon
tycon
  = ( TidyEnv
tc_env1
    , IfaceSynonym { ifName :: Name
ifName    = forall a. NamedThing a => a -> Name
getName TyCon
tycon,
                     ifRoles :: [Role]
ifRoles   = TyCon -> [Role]
tyConRoles TyCon
tycon,
                     ifSynRhs :: IfaceType
ifSynRhs  = Type -> IfaceType
if_syn_type Type
syn_rhs,
                     ifBinders :: [IfaceTyConBinder]
ifBinders = [IfaceTyConBinder]
if_binders,
                     ifResKind :: IfaceType
ifResKind = IfaceType
if_res_kind
                   })

  | Just FamTyConFlav
fam_flav <- TyCon -> Maybe FamTyConFlav
famTyConFlav_maybe TyCon
tycon
  = ( TidyEnv
tc_env1
    , IfaceFamily { ifName :: Name
ifName    = forall a. NamedThing a => a -> Name
getName TyCon
tycon,
                    ifResVar :: Maybe FastString
ifResVar  = Maybe FastString
if_res_var,
                    ifFamFlav :: IfaceFamTyConFlav
ifFamFlav = FamTyConFlav -> IfaceFamTyConFlav
to_if_fam_flav FamTyConFlav
fam_flav,
                    ifBinders :: [IfaceTyConBinder]
ifBinders = [IfaceTyConBinder]
if_binders,
                    ifResKind :: IfaceType
ifResKind = IfaceType
if_res_kind,
                    ifFamInj :: Injectivity
ifFamInj  = TyCon -> Injectivity
tyConInjectivityInfo TyCon
tycon
                  })

  | TyCon -> Bool
isAlgTyCon TyCon
tycon
  = ( TidyEnv
tc_env1
    , IfaceData { ifName :: Name
ifName    = forall a. NamedThing a => a -> Name
getName TyCon
tycon,
                  ifBinders :: [IfaceTyConBinder]
ifBinders = [IfaceTyConBinder]
if_binders,
                  ifResKind :: IfaceType
ifResKind = IfaceType
if_res_kind,
                  ifCType :: Maybe CType
ifCType   = TyCon -> Maybe CType
tyConCType TyCon
tycon,
                  ifRoles :: [Role]
ifRoles   = TyCon -> [Role]
tyConRoles TyCon
tycon,
                  ifCtxt :: IfaceContext
ifCtxt    = TidyEnv -> [Type] -> IfaceContext
tidyToIfaceContext TidyEnv
tc_env1 (TyCon -> [Type]
tyConStupidTheta TyCon
tycon),
                  ifCons :: IfaceConDecls
ifCons    = AlgTyConRhs -> IfaceConDecls
ifaceConDecls (TyCon -> AlgTyConRhs
algTyConRhs TyCon
tycon),
                  ifGadtSyntax :: Bool
ifGadtSyntax = TyCon -> Bool
isGadtSyntaxTyCon TyCon
tycon,
                  ifParent :: IfaceTyConParent
ifParent  = IfaceTyConParent
parent })

  | Bool
otherwise  -- FunTyCon, PrimTyCon, promoted TyCon/DataCon
  -- We only convert these TyCons to IfaceTyCons when we are
  -- just about to pretty-print them, not because we are going
  -- to put them into interface files
  = ( TidyEnv
env
    , IfaceData { ifName :: Name
ifName       = forall a. NamedThing a => a -> Name
getName TyCon
tycon,
                  ifBinders :: [IfaceTyConBinder]
ifBinders    = [IfaceTyConBinder]
if_binders,
                  ifResKind :: IfaceType
ifResKind    = IfaceType
if_res_kind,
                  ifCType :: Maybe CType
ifCType      = forall a. Maybe a
Nothing,
                  ifRoles :: [Role]
ifRoles      = TyCon -> [Role]
tyConRoles TyCon
tycon,
                  ifCtxt :: IfaceContext
ifCtxt       = [],
                  ifCons :: IfaceConDecls
ifCons       = [IfaceConDecl] -> IfaceConDecls
IfDataTyCon [],
                  ifGadtSyntax :: Bool
ifGadtSyntax = Bool
False,
                  ifParent :: IfaceTyConParent
ifParent     = IfaceTyConParent
IfNoParent })
  where
    -- NOTE: Not all TyCons have `tyConTyVars` field. Forcing this when `tycon`
    -- is one of these TyCons (FunTyCon, PrimTyCon, PromotedDataCon) will cause
    -- an error.
    (TidyEnv
tc_env1, [TyConBinder]
tc_binders) = TidyEnv -> [TyConBinder] -> (TidyEnv, [TyConBinder])
tidyTyConBinders TidyEnv
env (TyCon -> [TyConBinder]
tyConBinders TyCon
tycon)
    tc_tyvars :: [TyCoVar]
tc_tyvars      = forall tv argf. [VarBndr tv argf] -> [tv]
binderVars [TyConBinder]
tc_binders
    if_binders :: [IfaceTyConBinder]
if_binders     = forall vis. [VarBndr TyCoVar vis] -> [VarBndr IfaceBndr vis]
toIfaceTyCoVarBinders [TyConBinder]
tc_binders
                     -- No tidying of the binders; they are already tidy
    if_res_kind :: IfaceType
if_res_kind    = TidyEnv -> Type -> IfaceType
tidyToIfaceType TidyEnv
tc_env1 (TyCon -> Type
tyConResKind TyCon
tycon)
    if_syn_type :: Type -> IfaceType
if_syn_type Type
ty = TidyEnv -> Type -> IfaceType
tidyToIfaceType TidyEnv
tc_env1 Type
ty
    if_res_var :: Maybe FastString
if_res_var     = forall a. NamedThing a => a -> FastString
getOccFS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` TyCon -> Maybe Name
tyConFamilyResVar_maybe TyCon
tycon

    parent :: IfaceTyConParent
parent = case TyCon -> Maybe (TyCon, [Type], CoAxiom Unbranched)
tyConFamInstSig_maybe TyCon
tycon of
               Just (TyCon
tc, [Type]
ty, CoAxiom Unbranched
ax) -> Name -> IfaceTyCon -> IfaceAppArgs -> IfaceTyConParent
IfDataInstance (forall (br :: BranchFlag). CoAxiom br -> Name
coAxiomName CoAxiom Unbranched
ax)
                                                   (TyCon -> IfaceTyCon
toIfaceTyCon TyCon
tc)
                                                   (TidyEnv -> TyCon -> [Type] -> IfaceAppArgs
tidyToIfaceTcArgs TidyEnv
tc_env1 TyCon
tc [Type]
ty)
               Maybe (TyCon, [Type], CoAxiom Unbranched)
Nothing           -> IfaceTyConParent
IfNoParent

    to_if_fam_flav :: FamTyConFlav -> IfaceFamTyConFlav
to_if_fam_flav FamTyConFlav
OpenSynFamilyTyCon             = IfaceFamTyConFlav
IfaceOpenSynFamilyTyCon
    to_if_fam_flav FamTyConFlav
AbstractClosedSynFamilyTyCon   = IfaceFamTyConFlav
IfaceAbstractClosedSynFamilyTyCon
    to_if_fam_flav (DataFamilyTyCon {})           = IfaceFamTyConFlav
IfaceDataFamilyTyCon
    to_if_fam_flav (BuiltInSynFamTyCon {})        = IfaceFamTyConFlav
IfaceBuiltInSynFamTyCon
    to_if_fam_flav (ClosedSynFamilyTyCon Maybe (CoAxiom Branched)
Nothing) = Maybe (Name, [IfaceAxBranch]) -> IfaceFamTyConFlav
IfaceClosedSynFamilyTyCon forall a. Maybe a
Nothing
    to_if_fam_flav (ClosedSynFamilyTyCon (Just CoAxiom Branched
ax))
      = Maybe (Name, [IfaceAxBranch]) -> IfaceFamTyConFlav
IfaceClosedSynFamilyTyCon (forall a. a -> Maybe a
Just (Name
axn, [IfaceAxBranch]
ibr))
      where defs :: [CoAxBranch]
defs = forall (br :: BranchFlag). Branches br -> [CoAxBranch]
fromBranches forall a b. (a -> b) -> a -> b
$ forall (br :: BranchFlag). CoAxiom br -> Branches br
coAxiomBranches CoAxiom Branched
ax
            lhss :: [[Type]]
lhss = forall a b. (a -> b) -> [a] -> [b]
map CoAxBranch -> [Type]
coAxBranchLHS [CoAxBranch]
defs
            ibr :: [IfaceAxBranch]
ibr  = forall a b. (a -> b) -> [a] -> [b]
map (TyCon -> [[Type]] -> CoAxBranch -> IfaceAxBranch
coAxBranchToIfaceBranch TyCon
tycon [[Type]]
lhss) [CoAxBranch]
defs
            axn :: Name
axn  = forall (br :: BranchFlag). CoAxiom br -> Name
coAxiomName CoAxiom Branched
ax

    ifaceConDecls :: AlgTyConRhs -> IfaceConDecls
ifaceConDecls (NewTyCon { data_con :: AlgTyConRhs -> DataCon
data_con = DataCon
con })    = IfaceConDecl -> IfaceConDecls
IfNewTyCon  (DataCon -> IfaceConDecl
ifaceConDecl DataCon
con)
    ifaceConDecls (DataTyCon { data_cons :: AlgTyConRhs -> [DataCon]
data_cons = [DataCon]
cons }) = [IfaceConDecl] -> IfaceConDecls
IfDataTyCon (forall a b. (a -> b) -> [a] -> [b]
map DataCon -> IfaceConDecl
ifaceConDecl [DataCon]
cons)
    ifaceConDecls (TupleTyCon { data_con :: AlgTyConRhs -> DataCon
data_con = DataCon
con })  = [IfaceConDecl] -> IfaceConDecls
IfDataTyCon [DataCon -> IfaceConDecl
ifaceConDecl DataCon
con]
    ifaceConDecls (SumTyCon { data_cons :: AlgTyConRhs -> [DataCon]
data_cons = [DataCon]
cons })  = [IfaceConDecl] -> IfaceConDecls
IfDataTyCon (forall a b. (a -> b) -> [a] -> [b]
map DataCon -> IfaceConDecl
ifaceConDecl [DataCon]
cons)
    ifaceConDecls AlgTyConRhs
AbstractTyCon                    = IfaceConDecls
IfAbstractTyCon
        -- The AbstractTyCon case happens when a TyCon has been trimmed
        -- during tidying.
        -- Furthermore, tyThingToIfaceDecl is also used in GHC.Tc.Module
        -- for GHCi, when browsing a module, in which case the
        -- AbstractTyCon and TupleTyCon cases are perfectly sensible.
        -- (Tuple declarations are not serialised into interface files.)

    ifaceConDecl :: DataCon -> IfaceConDecl
ifaceConDecl DataCon
data_con
        = IfCon   { ifConName :: Name
ifConName    = DataCon -> Name
dataConName DataCon
data_con,
                    ifConInfix :: Bool
ifConInfix   = DataCon -> Bool
dataConIsInfix DataCon
data_con,
                    ifConWrapper :: Bool
ifConWrapper = forall a. Maybe a -> Bool
isJust (DataCon -> Maybe TyCoVar
dataConWrapId_maybe DataCon
data_con),
                    ifConExTCvs :: [IfaceBndr]
ifConExTCvs  = forall a b. (a -> b) -> [a] -> [b]
map TyCoVar -> IfaceBndr
toIfaceBndr [TyCoVar]
ex_tvs',
                    ifConUserTvBinders :: [IfaceForAllSpecBndr]
ifConUserTvBinders = forall a b. (a -> b) -> [a] -> [b]
map forall flag. VarBndr TyCoVar flag -> VarBndr IfaceBndr flag
toIfaceForAllBndr [InvisTVBinder]
user_bndrs',
                    ifConEqSpec :: [IfaceTvBndr]
ifConEqSpec  = forall a b. (a -> b) -> [a] -> [b]
map ((TyCoVar, Type) -> IfaceTvBndr
to_eq_spec forall b c a. (b -> c) -> (a -> b) -> a -> c
. EqSpec -> (TyCoVar, Type)
eqSpecPair) [EqSpec]
eq_spec,
                    ifConCtxt :: IfaceContext
ifConCtxt    = TidyEnv -> [Type] -> IfaceContext
tidyToIfaceContext TidyEnv
con_env2 [Type]
theta,
                    ifConArgTys :: [(IfaceType, IfaceType)]
ifConArgTys  =
                      forall a b. (a -> b) -> [a] -> [b]
map (\(Scaled Type
w Type
t) -> (TidyEnv -> Type -> IfaceType
tidyToIfaceType TidyEnv
con_env2 Type
w
                                          , (TidyEnv -> Type -> IfaceType
tidyToIfaceType TidyEnv
con_env2 Type
t))) [Scaled Type]
arg_tys,
                    ifConFields :: [FieldLabel]
ifConFields  = DataCon -> [FieldLabel]
dataConFieldLabels DataCon
data_con,
                    ifConStricts :: [IfaceBang]
ifConStricts = forall a b. (a -> b) -> [a] -> [b]
map (TidyEnv -> HsImplBang -> IfaceBang
toIfaceBang TidyEnv
con_env2)
                                       (DataCon -> [HsImplBang]
dataConImplBangs DataCon
data_con),
                    ifConSrcStricts :: [IfaceSrcBang]
ifConSrcStricts = forall a b. (a -> b) -> [a] -> [b]
map HsSrcBang -> IfaceSrcBang
toIfaceSrcBang
                                          (DataCon -> [HsSrcBang]
dataConSrcBangs DataCon
data_con)}
        where
          ([TyCoVar]
univ_tvs, [TyCoVar]
ex_tvs, [EqSpec]
eq_spec, [Type]
theta, [Scaled Type]
arg_tys, Type
_)
            = DataCon
-> ([TyCoVar], [TyCoVar], [EqSpec], [Type], [Scaled Type], Type)
dataConFullSig DataCon
data_con
          user_bndrs :: [InvisTVBinder]
user_bndrs = DataCon -> [InvisTVBinder]
dataConUserTyVarBinders DataCon
data_con

          -- Tidy the univ_tvs of the data constructor to be identical
          -- to the tyConTyVars of the type constructor.  This means
          -- (a) we don't need to redundantly put them into the interface file
          -- (b) when pretty-printing an Iface data declaration in H98-style syntax,
          --     we know that the type variables will line up
          -- The latter (b) is important because we pretty-print type constructors
          -- by converting to Iface syntax and pretty-printing that
          con_env1 :: TidyEnv
con_env1 = (forall a b. (a, b) -> a
fst TidyEnv
tc_env1, forall a. [(TyCoVar, a)] -> VarEnv a
mkVarEnv (forall a b. String -> [a] -> [b] -> [(a, b)]
zipEqual String
"ifaceConDecl" [TyCoVar]
univ_tvs [TyCoVar]
tc_tyvars))
                     -- A bit grimy, perhaps, but it's simple!

          (TidyEnv
con_env2, [TyCoVar]
ex_tvs') = TidyEnv -> [TyCoVar] -> (TidyEnv, [TyCoVar])
tidyVarBndrs TidyEnv
con_env1 [TyCoVar]
ex_tvs
          user_bndrs' :: [InvisTVBinder]
user_bndrs' = forall a b. (a -> b) -> [a] -> [b]
map (TidyEnv -> InvisTVBinder -> InvisTVBinder
tidyUserTyCoVarBinder TidyEnv
con_env2) [InvisTVBinder]
user_bndrs
          to_eq_spec :: (TyCoVar, Type) -> IfaceTvBndr
to_eq_spec (TyCoVar
tv,Type
ty) = (TidyEnv -> TyCoVar -> FastString
tidyTyVar TidyEnv
con_env2 TyCoVar
tv, TidyEnv -> Type -> IfaceType
tidyToIfaceType TidyEnv
con_env2 Type
ty)

          -- By this point, we have tidied every universal and existential
          -- tyvar. Because of the dcUserTyCoVarBinders invariant
          -- (see Note [DataCon user type variable binders]), *every*
          -- user-written tyvar must be contained in the substitution that
          -- tidying produced. Therefore, tidying the user-written tyvars is a
          -- simple matter of looking up each variable in the substitution,
          -- which tidyTyCoVarOcc accomplishes.
          tidyUserTyCoVarBinder :: TidyEnv -> InvisTVBinder -> InvisTVBinder
          tidyUserTyCoVarBinder :: TidyEnv -> InvisTVBinder -> InvisTVBinder
tidyUserTyCoVarBinder TidyEnv
env (Bndr TyCoVar
tv Specificity
vis) =
            forall var argf. var -> argf -> VarBndr var argf
Bndr (TidyEnv -> TyCoVar -> TyCoVar
tidyTyCoVarOcc TidyEnv
env TyCoVar
tv) Specificity
vis

classToIfaceDecl :: TidyEnv -> Class -> (TidyEnv, IfaceDecl)
classToIfaceDecl :: TidyEnv -> Class -> (TidyEnv, IfaceDecl)
classToIfaceDecl TidyEnv
env Class
clas
  = ( TidyEnv
env1
    , IfaceClass { ifName :: Name
ifName   = forall a. NamedThing a => a -> Name
getName TyCon
tycon,
                   ifRoles :: [Role]
ifRoles  = TyCon -> [Role]
tyConRoles (Class -> TyCon
classTyCon Class
clas),
                   ifBinders :: [IfaceTyConBinder]
ifBinders = forall vis. [VarBndr TyCoVar vis] -> [VarBndr IfaceBndr vis]
toIfaceTyCoVarBinders [TyConBinder]
tc_binders,
                   ifBody :: IfaceClassBody
ifBody   = IfaceClassBody
body,
                   ifFDs :: [FunDep FastString]
ifFDs    = forall a b. (a -> b) -> [a] -> [b]
map ([TyCoVar], [TyCoVar]) -> FunDep FastString
toIfaceFD [([TyCoVar], [TyCoVar])]
clas_fds })
  where
    ([TyCoVar]
_, [([TyCoVar], [TyCoVar])]
clas_fds, [Type]
sc_theta, [TyCoVar]
_, [ClassATItem]
clas_ats, [ClassOpItem]
op_stuff)
      = Class
-> ([TyCoVar], [([TyCoVar], [TyCoVar])], [Type], [TyCoVar],
    [ClassATItem], [ClassOpItem])
classExtraBigSig Class
clas
    tycon :: TyCon
tycon = Class -> TyCon
classTyCon Class
clas

    body :: IfaceClassBody
body | TyCon -> Bool
isAbstractTyCon TyCon
tycon = IfaceClassBody
IfAbstractClass
         | Bool
otherwise
         = IfConcreteClass {
                ifClassCtxt :: IfaceContext
ifClassCtxt   = TidyEnv -> [Type] -> IfaceContext
tidyToIfaceContext TidyEnv
env1 [Type]
sc_theta,
                ifATs :: [IfaceAT]
ifATs    = forall a b. (a -> b) -> [a] -> [b]
map ClassATItem -> IfaceAT
toIfaceAT [ClassATItem]
clas_ats,
                ifSigs :: [IfaceClassOp]
ifSigs   = forall a b. (a -> b) -> [a] -> [b]
map ClassOpItem -> IfaceClassOp
toIfaceClassOp [ClassOpItem]
op_stuff,
                ifMinDef :: BooleanFormula FastString
ifMinDef = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. NamedThing a => a -> FastString
getOccFS (Class -> ClassMinimalDef
classMinimalDef Class
clas)
            }

    (TidyEnv
env1, [TyConBinder]
tc_binders) = TidyEnv -> [TyConBinder] -> (TidyEnv, [TyConBinder])
tidyTyConBinders TidyEnv
env (TyCon -> [TyConBinder]
tyConBinders TyCon
tycon)

    toIfaceAT :: ClassATItem -> IfaceAT
    toIfaceAT :: ClassATItem -> IfaceAT
toIfaceAT (ATI TyCon
tc Maybe (Type, ATValidityInfo)
def)
      = IfaceDecl -> Maybe IfaceType -> IfaceAT
IfaceAT IfaceDecl
if_decl (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TidyEnv -> Type -> IfaceType
tidyToIfaceType TidyEnv
env2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) Maybe (Type, ATValidityInfo)
def)
      where
        (TidyEnv
env2, IfaceDecl
if_decl) = TidyEnv -> TyCon -> (TidyEnv, IfaceDecl)
tyConToIfaceDecl TidyEnv
env1 TyCon
tc

    toIfaceClassOp :: ClassOpItem -> IfaceClassOp
toIfaceClassOp (TyCoVar
sel_id, Maybe (Name, DefMethSpec Type)
def_meth)
        = ASSERT( sel_tyvars == binderVars tc_binders )
          Name -> IfaceType -> Maybe (DefMethSpec IfaceType) -> IfaceClassOp
IfaceClassOp (forall a. NamedThing a => a -> Name
getName TyCoVar
sel_id)
                       (TidyEnv -> Type -> IfaceType
tidyToIfaceType TidyEnv
env1 Type
op_ty)
                       (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Name, DefMethSpec Type) -> DefMethSpec IfaceType
toDmSpec Maybe (Name, DefMethSpec Type)
def_meth)
        where
                -- Be careful when splitting the type, because of things
                -- like         class Foo a where
                --                op :: (?x :: String) => a -> a
                -- and          class Baz a where
                --                op :: (Ord a) => a -> a
          ([TyCoVar]
sel_tyvars, Type
rho_ty) = Type -> ([TyCoVar], Type)
splitForAllTyCoVars (TyCoVar -> Type
idType TyCoVar
sel_id)
          op_ty :: Type
op_ty                = Type -> Type
funResultTy Type
rho_ty

    toDmSpec :: (Name, DefMethSpec Type) -> DefMethSpec IfaceType
    toDmSpec :: (Name, DefMethSpec Type) -> DefMethSpec IfaceType
toDmSpec (Name
_, DefMethSpec Type
VanillaDM)       = forall ty. DefMethSpec ty
VanillaDM
    toDmSpec (Name
_, GenericDM Type
dm_ty) = forall ty. ty -> DefMethSpec ty
GenericDM (TidyEnv -> Type -> IfaceType
tidyToIfaceType TidyEnv
env1 Type
dm_ty)

    toIfaceFD :: ([TyCoVar], [TyCoVar]) -> FunDep FastString
toIfaceFD ([TyCoVar]
tvs1, [TyCoVar]
tvs2) = (forall a b. (a -> b) -> [a] -> [b]
map (TidyEnv -> TyCoVar -> FastString
tidyTyVar TidyEnv
env1) [TyCoVar]
tvs1
                             ,forall a b. (a -> b) -> [a] -> [b]
map (TidyEnv -> TyCoVar -> FastString
tidyTyVar TidyEnv
env1) [TyCoVar]
tvs2)

--------------------------

tidyTyConBinder :: TidyEnv -> TyConBinder -> (TidyEnv, TyConBinder)
-- If the type variable "binder" is in scope, don't re-bind it
-- In a class decl, for example, the ATD binders mention
-- (amd must mention) the class tyvars
tidyTyConBinder :: TidyEnv -> TyConBinder -> (TidyEnv, TyConBinder)
tidyTyConBinder env :: TidyEnv
env@(TidyOccEnv
_, VarEnv TyCoVar
subst) tvb :: TyConBinder
tvb@(Bndr TyCoVar
tv TyConBndrVis
vis)
 = case forall a. VarEnv a -> TyCoVar -> Maybe a
lookupVarEnv VarEnv TyCoVar
subst TyCoVar
tv of
     Just TyCoVar
tv' -> (TidyEnv
env,  forall var argf. var -> argf -> VarBndr var argf
Bndr TyCoVar
tv' TyConBndrVis
vis)
     Maybe TyCoVar
Nothing  -> forall vis.
TidyEnv -> VarBndr TyCoVar vis -> (TidyEnv, VarBndr TyCoVar vis)
tidyTyCoVarBinder TidyEnv
env TyConBinder
tvb

tidyTyConBinders :: TidyEnv -> [TyConBinder] -> (TidyEnv, [TyConBinder])
tidyTyConBinders :: TidyEnv -> [TyConBinder] -> (TidyEnv, [TyConBinder])
tidyTyConBinders = forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL TidyEnv -> TyConBinder -> (TidyEnv, TyConBinder)
tidyTyConBinder

tidyTyVar :: TidyEnv -> TyVar -> FastString
tidyTyVar :: TidyEnv -> TyCoVar -> FastString
tidyTyVar (TidyOccEnv
_, VarEnv TyCoVar
subst) TyCoVar
tv = TyCoVar -> FastString
toIfaceTyVar (forall a. VarEnv a -> TyCoVar -> Maybe a
lookupVarEnv VarEnv TyCoVar
subst TyCoVar
tv forall a. Maybe a -> a -> a
`orElse` TyCoVar
tv)

--------------------------
instanceToIfaceInst :: ClsInst -> IfaceClsInst
instanceToIfaceInst :: ClsInst -> IfaceClsInst
instanceToIfaceInst (ClsInst { is_dfun :: ClsInst -> TyCoVar
is_dfun = TyCoVar
dfun_id, is_flag :: ClsInst -> OverlapFlag
is_flag = OverlapFlag
oflag
                             , is_cls_nm :: ClsInst -> Name
is_cls_nm = Name
cls_name, is_cls :: ClsInst -> Class
is_cls = Class
cls
                             , is_tcs :: ClsInst -> [RoughMatchTc]
is_tcs = [RoughMatchTc]
rough_tcs
                             , is_orphan :: ClsInst -> IsOrphan
is_orphan = IsOrphan
orph })
  = ASSERT( cls_name == className cls )
    IfaceClsInst { ifDFun :: Name
ifDFun     = TyCoVar -> Name
idName TyCoVar
dfun_id
                 , ifOFlag :: OverlapFlag
ifOFlag    = OverlapFlag
oflag
                 , ifInstCls :: Name
ifInstCls  = Name
cls_name
                 , ifInstTys :: [Maybe IfaceTyCon]
ifInstTys  = [RoughMatchTc] -> [Maybe IfaceTyCon]
ifaceRoughMatchTcs [RoughMatchTc]
rough_tcs
                 , ifInstOrph :: IsOrphan
ifInstOrph = IsOrphan
orph }

--------------------------
famInstToIfaceFamInst :: FamInst -> IfaceFamInst
famInstToIfaceFamInst :: FamInst -> IfaceFamInst
famInstToIfaceFamInst (FamInst { fi_axiom :: FamInst -> CoAxiom Unbranched
fi_axiom    = CoAxiom Unbranched
axiom,
                                 fi_fam :: FamInst -> Name
fi_fam      = Name
fam,
                                 fi_tcs :: FamInst -> [RoughMatchTc]
fi_tcs      = [RoughMatchTc]
rough_tcs })
  = IfaceFamInst { ifFamInstAxiom :: Name
ifFamInstAxiom    = forall (br :: BranchFlag). CoAxiom br -> Name
coAxiomName CoAxiom Unbranched
axiom
                 , ifFamInstFam :: Name
ifFamInstFam      = Name
fam
                 , ifFamInstTys :: [Maybe IfaceTyCon]
ifFamInstTys      = [RoughMatchTc] -> [Maybe IfaceTyCon]
ifaceRoughMatchTcs [RoughMatchTc]
rough_tcs
                 , ifFamInstOrph :: IsOrphan
ifFamInstOrph     = IsOrphan
orph }
  where
    fam_decl :: Name
fam_decl = TyCon -> Name
tyConName forall a b. (a -> b) -> a -> b
$ forall (br :: BranchFlag). CoAxiom br -> TyCon
coAxiomTyCon CoAxiom Unbranched
axiom
    mod :: Module
mod = ASSERT( isExternalName (coAxiomName axiom) )
          HasDebugCallStack => Name -> Module
nameModule (forall (br :: BranchFlag). CoAxiom br -> Name
coAxiomName CoAxiom Unbranched
axiom)
    is_local :: Name -> Bool
is_local Name
name = Module -> Name -> Bool
nameIsLocalOrFrom Module
mod Name
name

    lhs_names :: NameSet
lhs_names = (Name -> Bool) -> NameSet -> NameSet
filterNameSet Name -> Bool
is_local (forall (br :: BranchFlag). CoAxiom br -> NameSet
orphNamesOfCoCon CoAxiom Unbranched
axiom)

    orph :: IsOrphan
orph | Name -> Bool
is_local Name
fam_decl
         = OccName -> IsOrphan
NotOrphan (Name -> OccName
nameOccName Name
fam_decl)
         | Bool
otherwise
         = NameSet -> IsOrphan
chooseOrphanAnchor NameSet
lhs_names

ifaceRoughMatchTcs :: [RoughMatchTc] -> [Maybe IfaceTyCon]
ifaceRoughMatchTcs :: [RoughMatchTc] -> [Maybe IfaceTyCon]
ifaceRoughMatchTcs [RoughMatchTc]
tcs = forall a b. (a -> b) -> [a] -> [b]
map RoughMatchTc -> Maybe IfaceTyCon
do_rough [RoughMatchTc]
tcs
  where
    do_rough :: RoughMatchTc -> Maybe IfaceTyCon
do_rough RoughMatchTc
OtherTc     = forall a. Maybe a
Nothing
    do_rough (KnownTc Name
n) = forall a. a -> Maybe a
Just (Name -> IfaceTyCon
toIfaceTyCon_name Name
n)

--------------------------
coreRuleToIfaceRule :: CoreRule -> IfaceRule
coreRuleToIfaceRule :: CoreRule -> IfaceRule
coreRuleToIfaceRule (BuiltinRule { ru_fn :: CoreRule -> Name
ru_fn = Name
fn})
  = forall a. String -> SDoc -> a -> a
pprTrace String
"toHsRule: builtin" (forall a. Outputable a => a -> SDoc
ppr Name
fn) forall a b. (a -> b) -> a -> b
$
    Name -> IfaceRule
bogusIfaceRule Name
fn

coreRuleToIfaceRule (Rule { ru_name :: CoreRule -> FastString
ru_name = FastString
name, ru_fn :: CoreRule -> Name
ru_fn = Name
fn,
                            ru_act :: CoreRule -> Activation
ru_act = Activation
act, ru_bndrs :: CoreRule -> [TyCoVar]
ru_bndrs = [TyCoVar]
bndrs,
                            ru_args :: CoreRule -> [CoreExpr]
ru_args = [CoreExpr]
args, ru_rhs :: CoreRule -> CoreExpr
ru_rhs = CoreExpr
rhs,
                            ru_orphan :: CoreRule -> IsOrphan
ru_orphan = IsOrphan
orph, ru_auto :: CoreRule -> Bool
ru_auto = Bool
auto })
  = IfaceRule { ifRuleName :: FastString
ifRuleName  = FastString
name, ifActivation :: Activation
ifActivation = Activation
act,
                ifRuleBndrs :: [IfaceBndr]
ifRuleBndrs = forall a b. (a -> b) -> [a] -> [b]
map TyCoVar -> IfaceBndr
toIfaceBndr [TyCoVar]
bndrs,
                ifRuleHead :: Name
ifRuleHead  = Name
fn,
                ifRuleArgs :: [IfaceExpr]
ifRuleArgs  = 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

bogusIfaceRule :: Name -> IfaceRule
bogusIfaceRule :: Name -> IfaceRule
bogusIfaceRule Name
id_name
  = IfaceRule { ifRuleName :: FastString
ifRuleName = String -> FastString
fsLit String
"bogus", ifActivation :: Activation
ifActivation = Activation
NeverActive,
        ifRuleBndrs :: [IfaceBndr]
ifRuleBndrs = [], ifRuleHead :: Name
ifRuleHead = Name
id_name, ifRuleArgs :: [IfaceExpr]
ifRuleArgs = [],
        ifRuleRhs :: IfaceExpr
ifRuleRhs = Name -> IfaceExpr
IfaceExt Name
id_name, ifRuleOrph :: IsOrphan
ifRuleOrph = IsOrphan
IsOrphan,
        ifRuleAuto :: Bool
ifRuleAuto = Bool
True }