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

{-# LANGUAGE CPP, NondecreasingIndentation #-}
{-# LANGUAGE MultiWayIf #-}

-- | 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.Iface.Syntax
import GHC.Iface.Recomp
import GHC.Iface.Load
import GHC.CoreToIface

import GHC.HsToCore.Usage ( mkUsageInfo, mkUsedNames, mkDependencies )
import GHC.Types.Id
import GHC.Types.Annotations
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.StgToCmm.Types (CgInfos (..))
import GHC.Tc.Utils.TcType
import GHC.Core.InstEnv
import GHC.Core.FamInstEnv
import GHC.Tc.Utils.Monad
import GHC.Hs
import GHC.Driver.Types
import GHC.Driver.Session
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.Unit.Module
import GHC.Utils.Error
import GHC.Utils.Outputable
import GHC.Types.Basic hiding ( SuccessFlag(..) )
import GHC.Utils.Misc  hiding ( eqListBy )
import GHC.Data.FastString
import GHC.Data.Maybe
import GHC.HsToCore.Docs

import Data.Function
import Data.List ( findIndex, mapAccumL, sortBy )
import Data.Ord
import Data.IORef
import GHC.Driver.Plugins (LoadedPlugin(..))

{-
************************************************************************
*                                                                      *
\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)
          = PartialModIface -> [IfaceDeclExts 'ModIfaceCore]
forall (phase :: ModIfacePhase).
ModIface_ phase -> [IfaceDeclExts phase]
mi_decls PartialModIface
partial_iface
          | Bool
otherwise
          = [IfaceDecl] -> Maybe CgInfos -> [IfaceDecl]
updateDecl (PartialModIface -> [IfaceDeclExts 'ModIfaceCore]
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 = [IfaceDecl]
[IfaceDeclExts 'ModIfaceCore]
decls }

    -- Debug printing
    DynFlags -> DumpFlag -> String -> DumpFormat -> SDoc -> IO ()
dumpIfSet_dyn (HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env) DumpFlag
Opt_D_dump_hi String
"FINAL INTERFACE" DumpFormat
FormatText (ModIface -> SDoc
pprModIface ModIface
full_iface)

    ModIface -> IO ModIface
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 }) = (IfaceDecl -> IfaceDecl) -> [IfaceDecl] -> [IfaceDecl]
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 = ModuleLFInfos -> Name -> Maybe LambdaFormInfo
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
      , Maybe LambdaFormInfo -> Bool
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 (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)
          (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 ('HscNothing').
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 =
                (LoadedPlugin -> ModIface) -> [LoadedPlugin] -> [ModIface]
forall a b. (a -> b) -> [a] -> [b]
map LoadedPlugin -> ModIface
lpModule (DynFlags -> [LoadedPlugin]
cachedPlugins (HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env))
          Dependencies
deps <- UnitId -> [Module] -> TcGblEnv -> IO Dependencies
mkDependencies
                    (DynFlags -> UnitId
homeUnitId (HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env))
                    ((ModIface -> Module) -> [ModIface] -> [Module]
forall a b. (a -> b) -> [a] -> [b]
map ModIface -> Module
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 <- 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)
          -- 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

          let (Maybe HsDocString
doc_hdr', DeclDocMap
doc_map, ArgDocMap
arg_map) = TcGblEnv -> (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 Maybe CgInfos
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_sigs :: ModDetails -> [CompleteMatch]
md_complete_sigs = [CompleteMatch]
complete_sigs }
-- 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 semantic_mod :: Module
semantic_mod = DynFlags -> ModuleName -> Module
canonicalizeHomeModule (HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env) (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
this_mod)
        entities :: [TyThing]
entities = TypeEnv -> [TyThing]
typeEnvElts TypeEnv
type_env
        decls :: [IfaceDecl]
decls  = [ DynFlags -> TyThing -> IfaceDecl
tyThingToIfaceDecl (HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env) 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]
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 = (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 [ClsInst]
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_sigs :: [IfaceCompleteMatch]
icomplete_sigs = (CompleteMatch -> IfaceCompleteMatch)
-> [CompleteMatch] -> [IfaceCompleteMatch]
forall a b. (a -> b) -> [a] -> [b]
map CompleteMatch -> IfaceCompleteMatch
mkIfaceCompleteSig [CompleteMatch]
complete_sigs

    ModIface :: forall (phase :: ModIfacePhase).
Module
-> Maybe Module
-> HscSource
-> Dependencies
-> [Usage]
-> [AvailInfo]
-> Bool
-> [(OccName, Fixity)]
-> Warnings
-> [IfaceAnnotation]
-> [IfaceDeclExts phase]
-> Maybe GlobalRdrEnv
-> [IfaceClsInst]
-> [IfaceFamInst]
-> [IfaceRule]
-> Bool
-> IfaceTrustInfo
-> Bool
-> [IfaceCompleteMatch]
-> Maybe HsDocString
-> DeclDocMap
-> ArgDocMap
-> IfaceBackendExts phase
-> ExtensibleFields
-> ModIface_ phase
ModIface {
          mi_module :: Module
mi_module      = Module
this_mod,
          -- Need to record this because it depends on the -instantiated-with flag
          -- which could change
          mi_sig_of :: Maybe Module
mi_sig_of      = if Module
semantic_mod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
this_mod
                            then Maybe Module
forall a. Maybe a
Nothing
                            else Module -> Maybe Module
forall a. a -> Maybe a
Just Module
semantic_mod,
          mi_hsc_src :: HscSource
mi_hsc_src     = HscSource
hsc_src,
          mi_deps :: Dependencies
mi_deps        = Dependencies
deps,
          mi_usages :: [Usage]
mi_usages      = [Usage]
usages,
          mi_exports :: [AvailInfo]
mi_exports     = [AvailInfo] -> [AvailInfo]
mkIfaceExports [AvailInfo]
exports,

          -- Sort these lexicographically, so that
          -- the result is stable across compilations
          mi_insts :: [IfaceClsInst]
mi_insts       = (IfaceClsInst -> IfaceClsInst -> Ordering)
-> [IfaceClsInst] -> [IfaceClsInst]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy IfaceClsInst -> IfaceClsInst -> Ordering
cmp_inst     [IfaceClsInst]
iface_insts,
          mi_fam_insts :: [IfaceFamInst]
mi_fam_insts   = (IfaceFamInst -> IfaceFamInst -> Ordering)
-> [IfaceFamInst] -> [IfaceFamInst]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy IfaceFamInst -> IfaceFamInst -> Ordering
cmp_fam_inst [IfaceFamInst]
iface_fam_insts,
          mi_rules :: [IfaceRule]
mi_rules       = (IfaceRule -> IfaceRule -> Ordering) -> [IfaceRule] -> [IfaceRule]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy IfaceRule -> IfaceRule -> Ordering
cmp_rule     [IfaceRule]
iface_rules,

          mi_fixities :: [(OccName, Fixity)]
mi_fixities    = [(OccName, Fixity)]
fixities,
          mi_warns :: Warnings
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]
[IfaceDeclExts 'ModIfaceCore]
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_sigs :: [IfaceCompleteMatch]
mi_complete_sigs = [IfaceCompleteMatch]
icomplete_sigs,
          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     = (IfaceRule -> RuleName) -> IfaceRule -> IfaceRule -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing IfaceRule -> RuleName
ifRuleName
     -- Compare these lexicographically by OccName, *not* by unique,
     -- because the latter is not stable across compilations:
     cmp_inst :: IfaceClsInst -> IfaceClsInst -> Ordering
cmp_inst     = (IfaceClsInst -> OccName)
-> IfaceClsInst -> IfaceClsInst -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Name -> OccName
nameOccName (Name -> OccName)
-> (IfaceClsInst -> Name) -> IfaceClsInst -> OccName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IfaceClsInst -> Name
ifDFun)
     cmp_fam_inst :: IfaceFamInst -> IfaceFamInst -> Ordering
cmp_fam_inst = (IfaceFamInst -> OccName)
-> IfaceFamInst -> IfaceFamInst -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Name -> OccName
nameOccName (Name -> OccName)
-> (IfaceFamInst -> Name) -> IfaceFamInst -> OccName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IfaceFamInst -> Name
ifFamInstTcName)

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

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

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


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

mkIfaceCompleteSig :: CompleteMatch -> IfaceCompleteMatch
mkIfaceCompleteSig :: CompleteMatch -> IfaceCompleteMatch
mkIfaceCompleteSig (CompleteMatch [Name]
cls Name
tc) = [Name] -> Name -> IfaceCompleteMatch
IfaceCompleteMatch [Name]
cls Name
tc


{-
************************************************************************
*                                                                      *
       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 :: IfaceAnnTarget -> AnnPayload -> IfaceAnnotation
IfaceAnnotation {
        ifAnnotatedTarget :: IfaceAnnTarget
ifAnnotatedTarget = (Name -> OccName) -> CoreAnnTarget -> IfaceAnnTarget
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 [] [FieldLabel]
fs) = Name -> [Name] -> [FieldLabel] -> AvailInfo
AvailTC Name
n [] ([FieldLabel] -> [FieldLabel]
sort_flds [FieldLabel]
fs)
    sort_subs (AvailTC Name
n (Name
m:[Name]
ms) [FieldLabel]
fs)
       | Name
nName -> Name -> Bool
forall a. Eq a => a -> a -> Bool
==Name
m      = Name -> [Name] -> [FieldLabel] -> 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) ([FieldLabel] -> [FieldLabel]
sort_flds [FieldLabel]
fs)
       | Bool
otherwise = Name -> [Name] -> [FieldLabel] -> 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)) ([FieldLabel] -> [FieldLabel]
sort_flds [FieldLabel]
fs)
       -- Maintain the AvailTC Invariant

    sort_flds :: [FieldLabel] -> [FieldLabel]
sort_flds = (FieldLabel -> FieldLabel -> Ordering)
-> [FieldLabel] -> [FieldLabel]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Name -> Name -> Ordering
stableNameCmp (Name -> Name -> Ordering)
-> (FieldLabel -> Name) -> FieldLabel -> FieldLabel -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` FieldLabel -> Name
forall a. FieldLbl a -> a
flSelector)

{-
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 :: DynFlags -> TyThing -> IfaceDecl
tyThingToIfaceDecl :: DynFlags -> TyThing -> IfaceDecl
tyThingToIfaceDecl DynFlags
_ (AnId Id
id)      = Id -> IfaceDecl
idToIfaceDecl Id
id
tyThingToIfaceDecl DynFlags
_ (ATyCon TyCon
tycon) = (TidyEnv, IfaceDecl) -> IfaceDecl
forall a b. (a, b) -> b
snd (TidyEnv -> TyCon -> (TidyEnv, IfaceDecl)
tyConToIfaceDecl TidyEnv
emptyTidyEnv TyCon
tycon)
tyThingToIfaceDecl DynFlags
_ (ACoAxiom CoAxiom Branched
ax)  = CoAxiom Branched -> IfaceDecl
forall (br :: BranchFlag). CoAxiom br -> IfaceDecl
coAxiomToIfaceDecl CoAxiom Branched
ax
tyThingToIfaceDecl DynFlags
dflags (AConLike ConLike
cl)  = case ConLike
cl of
    RealDataCon DataCon
dc -> DynFlags -> DataCon -> IfaceDecl
dataConToIfaceDecl DynFlags
dflags 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 :: Id -> IfaceDecl
idToIfaceDecl Id
id
  = IfaceId :: Name -> IfaceType -> IfaceIdDetails -> IfaceIdInfo -> IfaceDecl
IfaceId { ifName :: Name
ifName      = Id -> Name
forall a. NamedThing a => a -> Name
getName Id
id,
              ifType :: IfaceType
ifType      = Type -> IfaceType
toIfaceType (Id -> Type
idType Id
id),
              ifIdDetails :: IfaceIdDetails
ifIdDetails = IdDetails -> IfaceIdDetails
toIfaceIdDetails (Id -> IdDetails
idDetails Id
id),
              ifIdInfo :: IfaceIdInfo
ifIdInfo    = IdInfo -> IfaceIdInfo
toIfaceIdInfo (HasDebugCallStack => Id -> IdInfo
Id -> IdInfo
idInfo Id
id) }

--------------------------
dataConToIfaceDecl :: DynFlags -> DataCon -> IfaceDecl
dataConToIfaceDecl :: DynFlags -> DataCon -> IfaceDecl
dataConToIfaceDecl DynFlags
dflags DataCon
dataCon
  = IfaceId :: Name -> IfaceType -> IfaceIdDetails -> IfaceIdInfo -> IfaceDecl
IfaceId { ifName :: Name
ifName      = DataCon -> Name
forall a. NamedThing a => a -> Name
getName DataCon
dataCon,
              ifType :: IfaceType
ifType      = Type -> IfaceType
toIfaceType (DynFlags -> DataCon -> Type
dataConDisplayType DynFlags
dflags 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 :: Name -> IfaceTyCon -> Role -> [IfaceAxBranch] -> IfaceDecl
IfaceAxiom { ifName :: Name
ifName       = CoAxiom br -> Name
forall a. NamedThing a => a -> Name
getName CoAxiom br
ax
              , ifTyCon :: IfaceTyCon
ifTyCon      = TyCon -> IfaceTyCon
toIfaceTyCon TyCon
tycon
              , ifRole :: Role
ifRole       = Role
role
              , ifAxBranches :: [IfaceAxBranch]
ifAxBranches = (CoAxBranch -> IfaceAxBranch) -> [CoAxBranch] -> [IfaceAxBranch]
forall a b. (a -> b) -> [a] -> [b]
map (TyCon -> [[Type]] -> CoAxBranch -> IfaceAxBranch
coAxBranchToIfaceBranch TyCon
tycon
                                     ((CoAxBranch -> [Type]) -> [CoAxBranch] -> [[Type]]
forall a b. (a -> b) -> [a] -> [b]
map CoAxBranch -> [Type]
coAxBranchLHS [CoAxBranch]
branch_list))
                                   [CoAxBranch]
branch_list }
 where
   branch_list :: [CoAxBranch]
branch_list = Branches br -> [CoAxBranch]
forall (br :: BranchFlag). Branches br -> [CoAxBranch]
fromBranches Branches br
branches

-- 2nd parameter is the list of branch LHSs, in case of a closed type family,
-- for conversion from incompatible branches to incompatible indices.
-- For an open type family the list should be empty.
-- See Note [Storing compatibility] in GHC.Core.Coercion.Axiom
coAxBranchToIfaceBranch :: TyCon -> [[Type]] -> CoAxBranch -> IfaceAxBranch
coAxBranchToIfaceBranch :: TyCon -> [[Type]] -> CoAxBranch -> IfaceAxBranch
coAxBranchToIfaceBranch TyCon
tc [[Type]]
lhs_s
                        (CoAxBranch { cab_tvs :: CoAxBranch -> [Id]
cab_tvs = [Id]
tvs, cab_cvs :: CoAxBranch -> [Id]
cab_cvs = [Id]
cvs
                                    , cab_eta_tvs :: CoAxBranch -> [Id]
cab_eta_tvs = [Id]
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 :: [IfaceTvBndr]
-> [IfaceTvBndr]
-> [IfaceIdBndr]
-> IfaceAppArgs
-> [Role]
-> IfaceType
-> [Int]
-> IfaceAxBranch
IfaceAxBranch { ifaxbTyVars :: [IfaceTvBndr]
ifaxbTyVars  = [Id] -> [IfaceTvBndr]
toIfaceTvBndrs [Id]
tvs
                  , ifaxbCoVars :: [IfaceIdBndr]
ifaxbCoVars  = (Id -> IfaceIdBndr) -> [Id] -> [IfaceIdBndr]
forall a b. (a -> b) -> [a] -> [b]
map Id -> IfaceIdBndr
toIfaceIdBndr [Id]
cvs
                  , ifaxbEtaTyVars :: [IfaceTvBndr]
ifaxbEtaTyVars = [Id] -> [IfaceTvBndr]
toIfaceTvBndrs [Id]
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 = (CoAxBranch -> Int) -> [CoAxBranch] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Maybe Int -> Int
forall a. HasCallStack => String -> Maybe a -> a
expectJust String
"iface_incomps"
                        (Maybe Int -> Int)
-> (CoAxBranch -> Maybe Int) -> CoAxBranch -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Type] -> Bool) -> [[Type]] -> Maybe Int)
-> [[Type]] -> ([Type] -> Bool) -> Maybe Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip ([Type] -> Bool) -> [[Type]] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex [[Type]]
lhs_s
                        (([Type] -> Bool) -> Maybe Int)
-> (CoAxBranch -> [Type] -> Bool) -> CoAxBranch -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Type] -> [Type] -> Bool
eqTypes
                        ([Type] -> [Type] -> Bool)
-> (CoAxBranch -> [Type]) -> CoAxBranch -> [Type] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoAxBranch -> [Type]
coAxBranchLHS) [CoAxBranch]
incomps

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

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

  | Just FamTyConFlav
fam_flav <- TyCon -> Maybe FamTyConFlav
famTyConFlav_maybe TyCon
tycon
  = ( TidyEnv
tc_env1
    , IfaceFamily :: Name
-> Maybe RuleName
-> [IfaceTyConBinder]
-> IfaceType
-> IfaceFamTyConFlav
-> Injectivity
-> IfaceDecl
IfaceFamily { ifName :: Name
ifName    = TyCon -> Name
forall a. NamedThing a => a -> Name
getName TyCon
tycon,
                    ifResVar :: Maybe RuleName
ifResVar  = Maybe RuleName
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 :: Name
-> [IfaceTyConBinder]
-> IfaceType
-> Maybe CType
-> [Role]
-> IfaceContext
-> IfaceConDecls
-> Bool
-> IfaceTyConParent
-> IfaceDecl
IfaceData { ifName :: Name
ifName    = TyCon -> Name
forall a. NamedThing a => a -> Name
getName TyCon
tycon,
                  ifBinders :: [IfaceTyConBinder]
ifBinders = [IfaceTyConBinder]
if_binders,
                  ifResKind :: IfaceType
ifResKind = IfaceType
if_res_kind,
                  ifCType :: Maybe CType
ifCType   = TyCon -> Maybe CType
tyConCType 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 :: Name
-> [IfaceTyConBinder]
-> IfaceType
-> Maybe CType
-> [Role]
-> IfaceContext
-> IfaceConDecls
-> Bool
-> IfaceTyConParent
-> IfaceDecl
IfaceData { ifName :: Name
ifName       = TyCon -> Name
forall a. NamedThing a => a -> Name
getName TyCon
tycon,
                  ifBinders :: [IfaceTyConBinder]
ifBinders    = [IfaceTyConBinder]
if_binders,
                  ifResKind :: IfaceType
ifResKind    = IfaceType
if_res_kind,
                  ifCType :: Maybe CType
ifCType      = Maybe CType
forall a. Maybe a
Nothing,
                  ifRoles :: [Role]
ifRoles      = TyCon -> [Role]
tyConRoles TyCon
tycon,
                  ifCtxt :: IfaceContext
ifCtxt       = [],
                  ifCons :: IfaceConDecls
ifCons       = [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 :: [Id]
tc_tyvars      = [TyConBinder] -> [Id]
forall tv argf. [VarBndr tv argf] -> [tv]
binderVars [TyConBinder]
tc_binders
    if_binders :: [IfaceTyConBinder]
if_binders     = [TyConBinder] -> [IfaceTyConBinder]
forall vis. [VarBndr Id 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 RuleName
if_res_var     = Name -> RuleName
forall a. NamedThing a => a -> RuleName
getOccFS (Name -> RuleName) -> Maybe Name -> Maybe RuleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` TyCon -> Maybe Name
tyConFamilyResVar_maybe TyCon
tycon

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

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

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

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

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

          (TidyEnv
con_env2, [Id]
ex_tvs') = TidyEnv -> [Id] -> (TidyEnv, [Id])
tidyVarBndrs TidyEnv
con_env1 [Id]
ex_tvs
          user_bndrs' :: [VarBndr Id Specificity]
user_bndrs' = (VarBndr Id Specificity -> VarBndr Id Specificity)
-> [VarBndr Id Specificity] -> [VarBndr Id Specificity]
forall a b. (a -> b) -> [a] -> [b]
map (TidyEnv -> VarBndr Id Specificity -> VarBndr Id Specificity
tidyUserTyCoVarBinder TidyEnv
con_env2) [VarBndr Id Specificity]
user_bndrs
          to_eq_spec :: (Id, Type) -> IfaceTvBndr
to_eq_spec (Id
tv,Type
ty) = (TidyEnv -> Id -> RuleName
tidyTyVar TidyEnv
con_env2 Id
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 -> VarBndr Id Specificity -> VarBndr Id Specificity
tidyUserTyCoVarBinder TidyEnv
env (Bndr Id
tv Specificity
vis) =
            Id -> Specificity -> VarBndr Id Specificity
forall var argf. var -> argf -> VarBndr var argf
Bndr (TidyEnv -> Id -> Id
tidyTyCoVarOcc TidyEnv
env Id
tv) Specificity
vis

classToIfaceDecl :: TidyEnv -> Class -> (TidyEnv, IfaceDecl)
classToIfaceDecl :: TidyEnv -> Class -> (TidyEnv, IfaceDecl)
classToIfaceDecl TidyEnv
env Class
clas
  = ( TidyEnv
env1
    , IfaceClass :: Name
-> [Role]
-> [IfaceTyConBinder]
-> [FunDep RuleName]
-> IfaceClassBody
-> IfaceDecl
IfaceClass { ifName :: Name
ifName   = TyCon -> Name
forall a. NamedThing a => a -> Name
getName TyCon
tycon,
                   ifRoles :: [Role]
ifRoles  = TyCon -> [Role]
tyConRoles (Class -> TyCon
classTyCon Class
clas),
                   ifBinders :: [IfaceTyConBinder]
ifBinders = [TyConBinder] -> [IfaceTyConBinder]
forall vis. [VarBndr Id vis] -> [VarBndr IfaceBndr vis]
toIfaceTyCoVarBinders [TyConBinder]
tc_binders,
                   ifBody :: IfaceClassBody
ifBody   = IfaceClassBody
body,
                   ifFDs :: [FunDep RuleName]
ifFDs    = (([Id], [Id]) -> FunDep RuleName)
-> [([Id], [Id])] -> [FunDep RuleName]
forall a b. (a -> b) -> [a] -> [b]
map ([Id], [Id]) -> FunDep RuleName
toIfaceFD [([Id], [Id])]
clas_fds })
  where
    ([Id]
_, [([Id], [Id])]
clas_fds, [Type]
sc_theta, [Id]
_, [ClassATItem]
clas_ats, [ClassOpItem]
op_stuff)
      = Class
-> ([Id], [([Id], [Id])], [Type], [Id], [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 :: IfaceContext
-> [IfaceAT]
-> [IfaceClassOp]
-> BooleanFormula RuleName
-> IfaceClassBody
IfConcreteClass {
                ifClassCtxt :: IfaceContext
ifClassCtxt   = TidyEnv -> [Type] -> IfaceContext
tidyToIfaceContext TidyEnv
env1 [Type]
sc_theta,
                ifATs :: [IfaceAT]
ifATs    = (ClassATItem -> IfaceAT) -> [ClassATItem] -> [IfaceAT]
forall a b. (a -> b) -> [a] -> [b]
map ClassATItem -> IfaceAT
toIfaceAT [ClassATItem]
clas_ats,
                ifSigs :: [IfaceClassOp]
ifSigs   = (ClassOpItem -> IfaceClassOp) -> [ClassOpItem] -> [IfaceClassOp]
forall a b. (a -> b) -> [a] -> [b]
map ClassOpItem -> IfaceClassOp
toIfaceClassOp [ClassOpItem]
op_stuff,
                ifMinDef :: BooleanFormula RuleName
ifMinDef = (Name -> RuleName)
-> BooleanFormula Name -> BooleanFormula RuleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Name -> RuleName
forall a. NamedThing a => a -> RuleName
getOccFS (Class -> BooleanFormula Name
classMinimalDef Class
clas)
            }

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

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

    toIfaceClassOp :: ClassOpItem -> IfaceClassOp
toIfaceClassOp (Id
sel_id, Maybe (Name, DefMethSpec Type)
def_meth)
        = ASSERT( sel_tyvars == binderVars tc_binders )
          Name -> IfaceType -> Maybe (DefMethSpec IfaceType) -> IfaceClassOp
IfaceClassOp (Id -> Name
forall a. NamedThing a => a -> Name
getName Id
sel_id)
                       (TidyEnv -> Type -> IfaceType
tidyToIfaceType TidyEnv
env1 Type
op_ty)
                       (((Name, DefMethSpec Type) -> DefMethSpec IfaceType)
-> Maybe (Name, DefMethSpec Type) -> Maybe (DefMethSpec IfaceType)
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
          ([Id]
sel_tyvars, Type
rho_ty) = Type -> ([Id], Type)
splitForAllTys (Id -> Type
idType Id
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)       = DefMethSpec IfaceType
forall ty. DefMethSpec ty
VanillaDM
    toDmSpec (Name
_, GenericDM Type
dm_ty) = IfaceType -> DefMethSpec IfaceType
forall ty. ty -> DefMethSpec ty
GenericDM (TidyEnv -> Type -> IfaceType
tidyToIfaceType TidyEnv
env1 Type
dm_ty)

    toIfaceFD :: ([Id], [Id]) -> FunDep RuleName
toIfaceFD ([Id]
tvs1, [Id]
tvs2) = ((Id -> RuleName) -> [Id] -> [RuleName]
forall a b. (a -> b) -> [a] -> [b]
map (TidyEnv -> Id -> RuleName
tidyTyVar TidyEnv
env1) [Id]
tvs1
                             ,(Id -> RuleName) -> [Id] -> [RuleName]
forall a b. (a -> b) -> [a] -> [b]
map (TidyEnv -> Id -> RuleName
tidyTyVar TidyEnv
env1) [Id]
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 Id
subst) tvb :: TyConBinder
tvb@(Bndr Id
tv TyConBndrVis
vis)
 = case VarEnv Id -> Id -> Maybe Id
forall a. VarEnv a -> Id -> Maybe a
lookupVarEnv VarEnv Id
subst Id
tv of
     Just Id
tv' -> (TidyEnv
env,  Id -> TyConBndrVis -> TyConBinder
forall var argf. var -> argf -> VarBndr var argf
Bndr Id
tv' TyConBndrVis
vis)
     Maybe Id
Nothing  -> TidyEnv -> TyConBinder -> (TidyEnv, TyConBinder)
forall vis. TidyEnv -> VarBndr Id vis -> (TidyEnv, VarBndr Id vis)
tidyTyCoVarBinder TidyEnv
env TyConBinder
tvb

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

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

--------------------------
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 -> [Maybe Name]
is_tcs = [Maybe Name]
mb_tcs
                             , is_orphan :: ClsInst -> IsOrphan
is_orphan = IsOrphan
orph })
  = ASSERT( cls_name == className cls )
    IfaceClsInst :: Name
-> [Maybe IfaceTyCon]
-> Name
-> OverlapFlag
-> IsOrphan
-> IfaceClsInst
IfaceClsInst { ifDFun :: Name
ifDFun    = Name
dfun_name,
                ifOFlag :: OverlapFlag
ifOFlag   = OverlapFlag
oflag,
                ifInstCls :: Name
ifInstCls = Name
cls_name,
                ifInstTys :: [Maybe IfaceTyCon]
ifInstTys = (Maybe Name -> Maybe IfaceTyCon)
-> [Maybe Name] -> [Maybe IfaceTyCon]
forall a b. (a -> b) -> [a] -> [b]
map Maybe Name -> Maybe IfaceTyCon
do_rough [Maybe Name]
mb_tcs,
                ifInstOrph :: IsOrphan
ifInstOrph = IsOrphan
orph }
  where
    do_rough :: Maybe Name -> Maybe IfaceTyCon
do_rough Maybe Name
Nothing  = Maybe IfaceTyCon
forall a. Maybe a
Nothing
    do_rough (Just Name
n) = IfaceTyCon -> Maybe IfaceTyCon
forall a. a -> Maybe a
Just (Name -> IfaceTyCon
toIfaceTyCon_name Name
n)

    dfun_name :: Name
dfun_name = Id -> Name
idName Id
dfun_id


--------------------------
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 -> [Maybe Name]
fi_tcs      = [Maybe Name]
roughs })
  = IfaceFamInst :: Name -> [Maybe IfaceTyCon] -> Name -> IsOrphan -> IfaceFamInst
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      = (Maybe Name -> Maybe IfaceTyCon)
-> [Maybe Name] -> [Maybe IfaceTyCon]
forall a b. (a -> b) -> [a] -> [b]
map Maybe Name -> Maybe IfaceTyCon
do_rough [Maybe Name]
roughs
                 , ifFamInstOrph :: IsOrphan
ifFamInstOrph     = IsOrphan
orph }
  where
    do_rough :: Maybe Name -> Maybe IfaceTyCon
do_rough Maybe Name
Nothing  = Maybe IfaceTyCon
forall a. Maybe a
Nothing
    do_rough (Just Name
n) = IfaceTyCon -> Maybe IfaceTyCon
forall a. a -> Maybe a
Just (Name -> IfaceTyCon
toIfaceTyCon_name Name
n)

    fam_decl :: Name
fam_decl = TyCon -> Name
tyConName (TyCon -> Name) -> TyCon -> Name
forall a b. (a -> b) -> a -> b
$ CoAxiom Unbranched -> TyCon
forall (br :: BranchFlag). CoAxiom br -> TyCon
coAxiomTyCon CoAxiom Unbranched
axiom
    mod :: Module
mod = ASSERT( isExternalName (coAxiomName axiom) )
          HasDebugCallStack => Name -> Module
Name -> Module
nameModule (CoAxiom Unbranched -> Name
forall (br :: BranchFlag). CoAxiom br -> Name
coAxiomName CoAxiom Unbranched
axiom)
    is_local :: Name -> Bool
is_local Name
name = Module -> Name -> Bool
nameIsLocalOrFrom Module
mod Name
name

    lhs_names :: NameSet
lhs_names = (Name -> Bool) -> NameSet -> NameSet
filterNameSet Name -> Bool
is_local (CoAxiom Unbranched -> NameSet
forall (br :: BranchFlag). CoAxiom br -> NameSet
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

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

coreRuleToIfaceRule (Rule { ru_name :: CoreRule -> RuleName
ru_name = RuleName
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 :: RuleName
-> Activation
-> [IfaceBndr]
-> Name
-> [IfaceExpr]
-> IfaceExpr
-> Bool
-> IsOrphan
-> IfaceRule
IfaceRule { ifRuleName :: RuleName
ifRuleName  = RuleName
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

bogusIfaceRule :: Name -> IfaceRule
bogusIfaceRule :: Name -> IfaceRule
bogusIfaceRule Name
id_name
  = IfaceRule :: RuleName
-> Activation
-> [IfaceBndr]
-> Name
-> [IfaceExpr]
-> IfaceExpr
-> Bool
-> IsOrphan
-> IfaceRule
IfaceRule { ifRuleName :: RuleName
ifRuleName = String -> RuleName
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 }