never executed always true always false
    1 
    2 {-# LANGUAGE NondecreasingIndentation #-}
    3 
    4 {-
    5 (c) The University of Glasgow 2006-2008
    6 (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
    7 -}
    8 
    9 -- | Module for constructing @ModIface@ values (interface files),
   10 -- writing them to disk and comparing two versions to see if
   11 -- recompilation is required.
   12 module GHC.Iface.Make
   13    ( mkPartialIface
   14    , mkFullIface
   15    , mkIfaceTc
   16    , mkIfaceExports
   17    , coAxiomToIfaceDecl
   18    , tyThingToIfaceDecl -- Converting things to their Iface equivalents
   19    )
   20 where
   21 
   22 import GHC.Prelude
   23 
   24 import GHC.Hs
   25 
   26 import GHC.StgToCmm.Types (CgInfos (..))
   27 
   28 import GHC.Tc.Utils.TcType
   29 import GHC.Tc.Utils.Monad
   30 
   31 import GHC.Iface.Syntax
   32 import GHC.Iface.Recomp
   33 import GHC.Iface.Load
   34 import GHC.Iface.Ext.Fields
   35 
   36 import GHC.CoreToIface
   37 
   38 import qualified GHC.LanguageExtensions as LangExt
   39 import GHC.Core
   40 import GHC.Core.Class
   41 import GHC.Core.TyCon
   42 import GHC.Core.Coercion.Axiom
   43 import GHC.Core.ConLike
   44 import GHC.Core.DataCon
   45 import GHC.Core.Type
   46 import GHC.Core.Multiplicity
   47 import GHC.Core.InstEnv
   48 import GHC.Core.FamInstEnv
   49 import GHC.Core.Unify( RoughMatchTc(..) )
   50 
   51 import GHC.Driver.Env
   52 import GHC.Driver.Backend
   53 import GHC.Driver.Session
   54 import GHC.Driver.Plugins (LoadedPlugin(..))
   55 
   56 import GHC.Types.Id
   57 import GHC.Types.Fixity.Env
   58 import GHC.Types.SafeHaskell
   59 import GHC.Types.Annotations
   60 import GHC.Types.Var.Env
   61 import GHC.Types.Var
   62 import GHC.Types.Name
   63 import GHC.Types.Avail
   64 import GHC.Types.Name.Reader
   65 import GHC.Types.Name.Env
   66 import GHC.Types.Name.Set
   67 import GHC.Types.Unique.DSet
   68 import GHC.Types.Basic hiding ( SuccessFlag(..) )
   69 import GHC.Types.TypeEnv
   70 import GHC.Types.SourceFile
   71 import GHC.Types.TyThing
   72 import GHC.Types.HpcInfo
   73 import GHC.Types.CompleteMatch
   74 
   75 import GHC.Utils.Outputable
   76 import GHC.Utils.Panic.Plain
   77 import GHC.Utils.Misc  hiding ( eqListBy )
   78 import GHC.Utils.Logger
   79 import GHC.Utils.Trace
   80 
   81 import GHC.Data.FastString
   82 import GHC.Data.Maybe
   83 
   84 import GHC.HsToCore.Docs
   85 import GHC.HsToCore.Usage ( mkUsageInfo, mkUsedNames )
   86 
   87 import GHC.Unit
   88 import GHC.Unit.Module.Warnings
   89 import GHC.Unit.Module.ModIface
   90 import GHC.Unit.Module.ModDetails
   91 import GHC.Unit.Module.ModGuts
   92 import GHC.Unit.Module.ModSummary
   93 import GHC.Unit.Module.Deps
   94 
   95 import Data.Function
   96 import Data.List ( findIndex, mapAccumL, sortBy )
   97 import Data.Ord
   98 import Data.IORef
   99 
  100 
  101 {-
  102 ************************************************************************
  103 *                                                                      *
  104 \subsection{Completing an interface}
  105 *                                                                      *
  106 ************************************************************************
  107 -}
  108 
  109 mkPartialIface :: HscEnv
  110                -> ModDetails
  111                -> ModSummary
  112                -> ModGuts
  113                -> PartialModIface
  114 mkPartialIface hsc_env mod_details mod_summary
  115   ModGuts{ mg_module       = this_mod
  116          , mg_hsc_src      = hsc_src
  117          , mg_usages       = usages
  118          , mg_used_th      = used_th
  119          , mg_deps         = deps
  120          , mg_rdr_env      = rdr_env
  121          , mg_fix_env      = fix_env
  122          , mg_warns        = warns
  123          , mg_hpc_info     = hpc_info
  124          , mg_safe_haskell = safe_mode
  125          , mg_trust_pkg    = self_trust
  126          , mg_doc_hdr      = doc_hdr
  127          , mg_decl_docs    = decl_docs
  128          , mg_arg_docs     = arg_docs
  129          }
  130   = mkIface_ hsc_env this_mod hsc_src used_th deps rdr_env fix_env warns hpc_info self_trust
  131              safe_mode usages doc_hdr decl_docs arg_docs mod_summary mod_details
  132 
  133 -- | Fully instantiate an interface. Adds fingerprints and potentially code
  134 -- generator produced information.
  135 --
  136 -- CgInfos is not available when not generating code (-fno-code), or when not
  137 -- generating interface pragmas (-fomit-interface-pragmas). See also
  138 -- Note [Conveying CAF-info and LFInfo between modules] in GHC.StgToCmm.Types.
  139 mkFullIface :: HscEnv -> PartialModIface -> Maybe CgInfos -> IO ModIface
  140 mkFullIface hsc_env partial_iface mb_cg_infos = do
  141     let decls
  142           | gopt Opt_OmitInterfacePragmas (hsc_dflags hsc_env)
  143           = mi_decls partial_iface
  144           | otherwise
  145           = updateDecl (mi_decls partial_iface) mb_cg_infos
  146 
  147     full_iface <-
  148       {-# SCC "addFingerprints" #-}
  149       addFingerprints hsc_env partial_iface{ mi_decls = decls }
  150 
  151     -- Debug printing
  152     let unit_state = hsc_units hsc_env
  153     putDumpFileMaybe (hsc_logger hsc_env) Opt_D_dump_hi "FINAL INTERFACE" FormatText
  154       (pprModIface unit_state full_iface)
  155 
  156     return full_iface
  157 
  158 updateDecl :: [IfaceDecl] -> Maybe CgInfos -> [IfaceDecl]
  159 updateDecl decls Nothing = decls
  160 updateDecl decls (Just CgInfos{ cgNonCafs = NonCaffySet non_cafs, cgLFInfos = lf_infos }) = map update_decl decls
  161   where
  162     update_decl (IfaceId nm ty details infos)
  163       | let not_caffy = elemNameSet nm non_cafs
  164       , let mb_lf_info = lookupNameEnv lf_infos nm
  165       , warnPprTrace (isNothing mb_lf_info) (text "Name without LFInfo:" <+> ppr nm) True
  166         -- Only allocate a new IfaceId if we're going to update the infos
  167       , isJust mb_lf_info || not_caffy
  168       = IfaceId nm ty details $
  169           (if not_caffy then (HsNoCafRefs :) else id)
  170           (case mb_lf_info of
  171              Nothing -> infos -- LFInfos not available when building .cmm files
  172              Just lf_info -> HsLFInfo (toIfaceLFInfo nm lf_info) : infos)
  173 
  174     update_decl decl
  175       = decl
  176 
  177 -- | Make an interface from the results of typechecking only.  Useful
  178 -- for non-optimising compilation, or where we aren't generating any
  179 -- object code at all ('NoBackend').
  180 mkIfaceTc :: HscEnv
  181           -> SafeHaskellMode    -- The safe haskell mode
  182           -> ModDetails         -- gotten from mkBootModDetails, probably
  183           -> ModSummary
  184           -> TcGblEnv           -- Usages, deprecations, etc
  185           -> IO ModIface
  186 mkIfaceTc hsc_env safe_mode mod_details mod_summary
  187   tc_result@TcGblEnv{ tcg_mod = this_mod,
  188                       tcg_src = hsc_src,
  189                       tcg_imports = imports,
  190                       tcg_rdr_env = rdr_env,
  191                       tcg_fix_env = fix_env,
  192                       tcg_merged = merged,
  193                       tcg_warns = warns,
  194                       tcg_hpc = other_hpc_info,
  195                       tcg_th_splice_used = tc_splice_used,
  196                       tcg_dependent_files = dependent_files
  197                     }
  198   = do
  199           let used_names = mkUsedNames tc_result
  200           let pluginModules = map lpModule (hsc_plugins hsc_env)
  201           let home_unit = hsc_home_unit hsc_env
  202           let deps = mkDependencies home_unit
  203                                     (tcg_mod tc_result)
  204                                     (tcg_imports tc_result)
  205                                     (map mi_module pluginModules)
  206           let hpc_info = emptyHpcInfo other_hpc_info
  207           used_th <- readIORef tc_splice_used
  208           dep_files <- (readIORef dependent_files)
  209           -- Do NOT use semantic module here; this_mod in mkUsageInfo
  210           -- is used solely to decide if we should record a dependency
  211           -- or not.  When we instantiate a signature, the semantic
  212           -- module is something we want to record dependencies for,
  213           -- but if you pass that in here, we'll decide it's the local
  214           -- module and does not need to be recorded as a dependency.
  215           -- See Note [Identity versus semantic module]
  216           usages <- mkUsageInfo hsc_env this_mod hsc_src (imp_mods imports) used_names
  217                       dep_files merged
  218 
  219           (doc_hdr', doc_map, arg_map) <- extractDocs tc_result
  220 
  221           let partial_iface = mkIface_ hsc_env
  222                    this_mod hsc_src
  223                    used_th deps rdr_env
  224                    fix_env warns hpc_info
  225                    (imp_trust_own_pkg imports) safe_mode usages
  226                    doc_hdr' doc_map arg_map mod_summary
  227                    mod_details
  228 
  229           mkFullIface hsc_env partial_iface Nothing
  230 
  231 mkIface_ :: HscEnv -> Module -> HscSource
  232          -> Bool -> Dependencies -> GlobalRdrEnv
  233          -> NameEnv FixItem -> Warnings -> HpcInfo
  234          -> Bool
  235          -> SafeHaskellMode
  236          -> [Usage]
  237          -> Maybe HsDocString
  238          -> DeclDocMap
  239          -> ArgDocMap
  240          -> ModSummary
  241          -> ModDetails
  242          -> PartialModIface
  243 mkIface_ hsc_env
  244          this_mod hsc_src used_th deps rdr_env fix_env src_warns
  245          hpc_info pkg_trust_req safe_mode usages
  246          doc_hdr decl_docs arg_docs mod_summary
  247          ModDetails{  md_insts     = insts,
  248                       md_fam_insts = fam_insts,
  249                       md_rules     = rules,
  250                       md_anns      = anns,
  251                       md_types     = type_env,
  252                       md_exports   = exports,
  253                       md_complete_matches = complete_matches }
  254 -- NB:  notice that mkIface does not look at the bindings
  255 --      only at the TypeEnv.  The previous Tidy phase has
  256 --      put exactly the info into the TypeEnv that we want
  257 --      to expose in the interface
  258 
  259   = do
  260     let home_unit    = hsc_home_unit hsc_env
  261         semantic_mod = homeModuleNameInstantiation home_unit (moduleName this_mod)
  262         entities = typeEnvElts type_env
  263         show_linear_types = xopt LangExt.LinearTypes (hsc_dflags hsc_env)
  264         decls  = [ tyThingToIfaceDecl show_linear_types entity
  265                  | entity <- entities,
  266                    let name = getName entity,
  267                    not (isImplicitTyThing entity),
  268                       -- No implicit Ids and class tycons in the interface file
  269                    not (isWiredInName name),
  270                       -- Nor wired-in things; the compiler knows about them anyhow
  271                    nameIsLocalOrFrom semantic_mod name  ]
  272                       -- Sigh: see Note [Root-main Id] in GHC.Tc.Module
  273                       -- NB: ABSOLUTELY need to check against semantic_mod,
  274                       -- because all of the names in an hsig p[H=<H>]:H
  275                       -- are going to be for <H>, not the former id!
  276                       -- See Note [Identity versus semantic module]
  277 
  278         fixities    = sortBy (comparing fst)
  279           [(occ,fix) | FixItem occ fix <- nonDetNameEnvElts fix_env]
  280           -- The order of fixities returned from nonDetNameEnvElts is not
  281           -- deterministic, so we sort by OccName to canonicalize it.
  282           -- See Note [Deterministic UniqFM] in GHC.Types.Unique.DFM for more details.
  283         warns       = src_warns
  284         iface_rules = map coreRuleToIfaceRule rules
  285         iface_insts = map instanceToIfaceInst $ fixSafeInstances safe_mode insts
  286         iface_fam_insts = map famInstToIfaceFamInst fam_insts
  287         trust_info  = setSafeMode safe_mode
  288         annotations = map mkIfaceAnnotation anns
  289         icomplete_matches = map mkIfaceCompleteMatch complete_matches
  290 
  291     ModIface {
  292           mi_module      = this_mod,
  293           -- Need to record this because it depends on the -instantiated-with flag
  294           -- which could change
  295           mi_sig_of      = if semantic_mod == this_mod
  296                             then Nothing
  297                             else Just semantic_mod,
  298           mi_hsc_src     = hsc_src,
  299           mi_deps        = deps,
  300           mi_usages      = usages,
  301           mi_exports     = mkIfaceExports exports,
  302 
  303           -- Sort these lexicographically, so that
  304           -- the result is stable across compilations
  305           mi_insts       = sortBy cmp_inst     iface_insts,
  306           mi_fam_insts   = sortBy cmp_fam_inst iface_fam_insts,
  307           mi_rules       = sortBy cmp_rule     iface_rules,
  308 
  309           mi_fixities    = fixities,
  310           mi_warns       = warns,
  311           mi_anns        = annotations,
  312           mi_globals     = maybeGlobalRdrEnv rdr_env,
  313           mi_used_th     = used_th,
  314           mi_decls       = decls,
  315           mi_hpc         = isHpcUsed hpc_info,
  316           mi_trust       = trust_info,
  317           mi_trust_pkg   = pkg_trust_req,
  318           mi_complete_matches = icomplete_matches,
  319           mi_doc_hdr     = doc_hdr,
  320           mi_decl_docs   = decl_docs,
  321           mi_arg_docs    = arg_docs,
  322           mi_final_exts  = (),
  323           mi_ext_fields  = emptyExtensibleFields,
  324           mi_src_hash = ms_hs_hash mod_summary
  325           }
  326   where
  327      cmp_rule     = lexicalCompareFS `on` ifRuleName
  328      -- Compare these lexicographically by OccName, *not* by unique,
  329      -- because the latter is not stable across compilations:
  330      cmp_inst     = comparing (nameOccName . ifDFun)
  331      cmp_fam_inst = comparing (nameOccName . ifFamInstTcName)
  332 
  333      dflags = hsc_dflags hsc_env
  334 
  335      -- We only fill in mi_globals if the module was compiled to byte
  336      -- code.  Otherwise, the compiler may not have retained all the
  337      -- top-level bindings and they won't be in the TypeEnv (see
  338      -- Desugar.addExportFlagsAndRules).  The mi_globals field is used
  339      -- by GHCi to decide whether the module has its full top-level
  340      -- scope available. (#5534)
  341      maybeGlobalRdrEnv :: GlobalRdrEnv -> Maybe GlobalRdrEnv
  342      maybeGlobalRdrEnv rdr_env
  343          | backendRetainsAllBindings (backend dflags) = Just rdr_env
  344          | otherwise                                  = Nothing
  345 
  346      ifFamInstTcName = ifFamInstFam
  347 
  348 
  349 {-
  350 ************************************************************************
  351 *                                                                      *
  352        COMPLETE Pragmas
  353 *                                                                      *
  354 ************************************************************************
  355 -}
  356 
  357 mkIfaceCompleteMatch :: CompleteMatch -> IfaceCompleteMatch
  358 mkIfaceCompleteMatch (CompleteMatch cls mtc) =
  359   IfaceCompleteMatch (map conLikeName (uniqDSetToList cls)) (toIfaceTyCon <$> mtc)
  360 
  361 
  362 {-
  363 ************************************************************************
  364 *                                                                      *
  365        Keeping track of what we've slurped, and fingerprints
  366 *                                                                      *
  367 ************************************************************************
  368 -}
  369 
  370 
  371 mkIfaceAnnotation :: Annotation -> IfaceAnnotation
  372 mkIfaceAnnotation (Annotation { ann_target = target, ann_value = payload })
  373   = IfaceAnnotation {
  374         ifAnnotatedTarget = fmap nameOccName target,
  375         ifAnnotatedValue = payload
  376     }
  377 
  378 mkIfaceExports :: [AvailInfo] -> [IfaceExport]  -- Sort to make canonical
  379 mkIfaceExports exports
  380   = sortBy stableAvailCmp (map sort_subs exports)
  381   where
  382     sort_subs :: AvailInfo -> AvailInfo
  383     sort_subs (Avail n) = Avail n
  384     sort_subs (AvailTC n []) = AvailTC n []
  385     sort_subs (AvailTC n (m:ms))
  386        | NormalGreName n==m  = AvailTC n (m:sortBy stableGreNameCmp ms)
  387        | otherwise = AvailTC n (sortBy stableGreNameCmp (m:ms))
  388        -- Maintain the AvailTC Invariant
  389 
  390 {-
  391 Note [Original module]
  392 ~~~~~~~~~~~~~~~~~~~~~
  393 Consider this:
  394         module X where { data family T }
  395         module Y( T(..) ) where { import X; data instance T Int = MkT Int }
  396 The exported Avail from Y will look like
  397         X.T{X.T, Y.MkT}
  398 That is, in Y,
  399   - only MkT is brought into scope by the data instance;
  400   - but the parent (used for grouping and naming in T(..) exports) is X.T
  401   - and in this case we export X.T too
  402 
  403 In the result of mkIfaceExports, the names are grouped by defining module,
  404 so we may need to split up a single Avail into multiple ones.
  405 -}
  406 
  407 
  408 {-
  409 ************************************************************************
  410 *                                                                      *
  411                 Converting things to their Iface equivalents
  412 *                                                                      *
  413 ************************************************************************
  414 -}
  415 
  416 tyThingToIfaceDecl :: Bool -> TyThing -> IfaceDecl
  417 tyThingToIfaceDecl _ (AnId id)      = idToIfaceDecl id
  418 tyThingToIfaceDecl _ (ATyCon tycon) = snd (tyConToIfaceDecl emptyTidyEnv tycon)
  419 tyThingToIfaceDecl _ (ACoAxiom ax)  = coAxiomToIfaceDecl ax
  420 tyThingToIfaceDecl show_linear_types (AConLike cl)  = case cl of
  421     RealDataCon dc -> dataConToIfaceDecl show_linear_types dc -- for ppr purposes only
  422     PatSynCon ps   -> patSynToIfaceDecl ps
  423 
  424 --------------------------
  425 idToIfaceDecl :: Id -> IfaceDecl
  426 -- The Id is already tidied, so that locally-bound names
  427 -- (lambdas, for-alls) already have non-clashing OccNames
  428 -- We can't tidy it here, locally, because it may have
  429 -- free variables in its type or IdInfo
  430 idToIfaceDecl id
  431   = IfaceId { ifName      = getName id,
  432               ifType      = toIfaceType (idType id),
  433               ifIdDetails = toIfaceIdDetails (idDetails id),
  434               ifIdInfo    = toIfaceIdInfo (idInfo id) }
  435 
  436 --------------------------
  437 dataConToIfaceDecl :: Bool -> DataCon -> IfaceDecl
  438 dataConToIfaceDecl show_linear_types dataCon
  439   = IfaceId { ifName      = getName dataCon,
  440               ifType      = toIfaceType (dataConDisplayType show_linear_types dataCon),
  441               ifIdDetails = IfVanillaId,
  442               ifIdInfo    = [] }
  443 
  444 --------------------------
  445 coAxiomToIfaceDecl :: CoAxiom br -> IfaceDecl
  446 -- We *do* tidy Axioms, because they are not (and cannot
  447 -- conveniently be) built in tidy form
  448 coAxiomToIfaceDecl ax@(CoAxiom { co_ax_tc = tycon, co_ax_branches = branches
  449                                , co_ax_role = role })
  450  = IfaceAxiom { ifName       = getName ax
  451               , ifTyCon      = toIfaceTyCon tycon
  452               , ifRole       = role
  453               , ifAxBranches = map (coAxBranchToIfaceBranch tycon
  454                                      (map coAxBranchLHS branch_list))
  455                                    branch_list }
  456  where
  457    branch_list = fromBranches branches
  458 
  459 -- 2nd parameter is the list of branch LHSs, in case of a closed type family,
  460 -- for conversion from incompatible branches to incompatible indices.
  461 -- For an open type family the list should be empty.
  462 -- See Note [Storing compatibility] in GHC.Core.Coercion.Axiom
  463 coAxBranchToIfaceBranch :: TyCon -> [[Type]] -> CoAxBranch -> IfaceAxBranch
  464 coAxBranchToIfaceBranch tc lhs_s
  465                         (CoAxBranch { cab_tvs = tvs, cab_cvs = cvs
  466                                     , cab_eta_tvs = eta_tvs
  467                                     , cab_lhs = lhs, cab_roles = roles
  468                                     , cab_rhs = rhs, cab_incomps = incomps })
  469 
  470   = IfaceAxBranch { ifaxbTyVars  = toIfaceTvBndrs tvs
  471                   , ifaxbCoVars  = map toIfaceIdBndr cvs
  472                   , ifaxbEtaTyVars = toIfaceTvBndrs eta_tvs
  473                   , ifaxbLHS     = toIfaceTcArgs tc lhs
  474                   , ifaxbRoles   = roles
  475                   , ifaxbRHS     = toIfaceType rhs
  476                   , ifaxbIncomps = iface_incomps }
  477   where
  478     iface_incomps = map (expectJust "iface_incomps"
  479                         . flip findIndex lhs_s
  480                         . eqTypes
  481                         . coAxBranchLHS) incomps
  482 
  483 -----------------
  484 tyConToIfaceDecl :: TidyEnv -> TyCon -> (TidyEnv, IfaceDecl)
  485 -- We *do* tidy TyCons, because they are not (and cannot
  486 -- conveniently be) built in tidy form
  487 -- The returned TidyEnv is the one after tidying the tyConTyVars
  488 tyConToIfaceDecl env tycon
  489   | Just clas <- tyConClass_maybe tycon
  490   = classToIfaceDecl env clas
  491 
  492   | Just syn_rhs <- synTyConRhs_maybe tycon
  493   = ( tc_env1
  494     , IfaceSynonym { ifName    = getName tycon,
  495                      ifRoles   = tyConRoles tycon,
  496                      ifSynRhs  = if_syn_type syn_rhs,
  497                      ifBinders = if_binders,
  498                      ifResKind = if_res_kind
  499                    })
  500 
  501   | Just fam_flav <- famTyConFlav_maybe tycon
  502   = ( tc_env1
  503     , IfaceFamily { ifName    = getName tycon,
  504                     ifResVar  = if_res_var,
  505                     ifFamFlav = to_if_fam_flav fam_flav,
  506                     ifBinders = if_binders,
  507                     ifResKind = if_res_kind,
  508                     ifFamInj  = tyConInjectivityInfo tycon
  509                   })
  510 
  511   | isAlgTyCon tycon
  512   = ( tc_env1
  513     , IfaceData { ifName    = getName tycon,
  514                   ifBinders = if_binders,
  515                   ifResKind = if_res_kind,
  516                   ifCType   = tyConCType tycon,
  517                   ifRoles   = tyConRoles tycon,
  518                   ifCtxt    = tidyToIfaceContext tc_env1 (tyConStupidTheta tycon),
  519                   ifCons    = ifaceConDecls (algTyConRhs tycon),
  520                   ifGadtSyntax = isGadtSyntaxTyCon tycon,
  521                   ifParent  = parent })
  522 
  523   | otherwise  -- FunTyCon, PrimTyCon, promoted TyCon/DataCon
  524   -- We only convert these TyCons to IfaceTyCons when we are
  525   -- just about to pretty-print them, not because we are going
  526   -- to put them into interface files
  527   = ( env
  528     , IfaceData { ifName       = getName tycon,
  529                   ifBinders    = if_binders,
  530                   ifResKind    = if_res_kind,
  531                   ifCType      = Nothing,
  532                   ifRoles      = tyConRoles tycon,
  533                   ifCtxt       = [],
  534                   ifCons       = IfDataTyCon [],
  535                   ifGadtSyntax = False,
  536                   ifParent     = IfNoParent })
  537   where
  538     -- NOTE: Not all TyCons have `tyConTyVars` field. Forcing this when `tycon`
  539     -- is one of these TyCons (FunTyCon, PrimTyCon, PromotedDataCon) will cause
  540     -- an error.
  541     (tc_env1, tc_binders) = tidyTyConBinders env (tyConBinders tycon)
  542     tc_tyvars      = binderVars tc_binders
  543     if_binders     = toIfaceTyCoVarBinders tc_binders
  544                      -- No tidying of the binders; they are already tidy
  545     if_res_kind    = tidyToIfaceType tc_env1 (tyConResKind tycon)
  546     if_syn_type ty = tidyToIfaceType tc_env1 ty
  547     if_res_var     = getOccFS `fmap` tyConFamilyResVar_maybe tycon
  548 
  549     parent = case tyConFamInstSig_maybe tycon of
  550                Just (tc, ty, ax) -> IfDataInstance (coAxiomName ax)
  551                                                    (toIfaceTyCon tc)
  552                                                    (tidyToIfaceTcArgs tc_env1 tc ty)
  553                Nothing           -> IfNoParent
  554 
  555     to_if_fam_flav OpenSynFamilyTyCon             = IfaceOpenSynFamilyTyCon
  556     to_if_fam_flav AbstractClosedSynFamilyTyCon   = IfaceAbstractClosedSynFamilyTyCon
  557     to_if_fam_flav (DataFamilyTyCon {})           = IfaceDataFamilyTyCon
  558     to_if_fam_flav (BuiltInSynFamTyCon {})        = IfaceBuiltInSynFamTyCon
  559     to_if_fam_flav (ClosedSynFamilyTyCon Nothing) = IfaceClosedSynFamilyTyCon Nothing
  560     to_if_fam_flav (ClosedSynFamilyTyCon (Just ax))
  561       = IfaceClosedSynFamilyTyCon (Just (axn, ibr))
  562       where defs = fromBranches $ coAxiomBranches ax
  563             lhss = map coAxBranchLHS defs
  564             ibr  = map (coAxBranchToIfaceBranch tycon lhss) defs
  565             axn  = coAxiomName ax
  566 
  567     ifaceConDecls (NewTyCon { data_con = con })    = IfNewTyCon  (ifaceConDecl con)
  568     ifaceConDecls (DataTyCon { data_cons = cons }) = IfDataTyCon (map ifaceConDecl cons)
  569     ifaceConDecls (TupleTyCon { data_con = con })  = IfDataTyCon [ifaceConDecl con]
  570     ifaceConDecls (SumTyCon { data_cons = cons })  = IfDataTyCon (map ifaceConDecl cons)
  571     ifaceConDecls AbstractTyCon                    = IfAbstractTyCon
  572         -- The AbstractTyCon case happens when a TyCon has been trimmed
  573         -- during tidying.
  574         -- Furthermore, tyThingToIfaceDecl is also used in GHC.Tc.Module
  575         -- for GHCi, when browsing a module, in which case the
  576         -- AbstractTyCon and TupleTyCon cases are perfectly sensible.
  577         -- (Tuple declarations are not serialised into interface files.)
  578 
  579     ifaceConDecl data_con
  580         = IfCon   { ifConName    = dataConName data_con,
  581                     ifConInfix   = dataConIsInfix data_con,
  582                     ifConWrapper = isJust (dataConWrapId_maybe data_con),
  583                     ifConExTCvs  = map toIfaceBndr ex_tvs',
  584                     ifConUserTvBinders = map toIfaceForAllBndr user_bndrs',
  585                     ifConEqSpec  = map (to_eq_spec . eqSpecPair) eq_spec,
  586                     ifConCtxt    = tidyToIfaceContext con_env2 theta,
  587                     ifConArgTys  =
  588                       map (\(Scaled w t) -> (tidyToIfaceType con_env2 w
  589                                           , (tidyToIfaceType con_env2 t))) arg_tys,
  590                     ifConFields  = dataConFieldLabels data_con,
  591                     ifConStricts = map (toIfaceBang con_env2)
  592                                        (dataConImplBangs data_con),
  593                     ifConSrcStricts = map toIfaceSrcBang
  594                                           (dataConSrcBangs data_con)}
  595         where
  596           (univ_tvs, ex_tvs, eq_spec, theta, arg_tys, _)
  597             = dataConFullSig data_con
  598           user_bndrs = dataConUserTyVarBinders data_con
  599 
  600           -- Tidy the univ_tvs of the data constructor to be identical
  601           -- to the tyConTyVars of the type constructor.  This means
  602           -- (a) we don't need to redundantly put them into the interface file
  603           -- (b) when pretty-printing an Iface data declaration in H98-style syntax,
  604           --     we know that the type variables will line up
  605           -- The latter (b) is important because we pretty-print type constructors
  606           -- by converting to Iface syntax and pretty-printing that
  607           con_env1 = (fst tc_env1, mkVarEnv (zipEqual "ifaceConDecl" univ_tvs tc_tyvars))
  608                      -- A bit grimy, perhaps, but it's simple!
  609 
  610           (con_env2, ex_tvs') = tidyVarBndrs con_env1 ex_tvs
  611           user_bndrs' = map (tidyUserTyCoVarBinder con_env2) user_bndrs
  612           to_eq_spec (tv,ty) = (tidyTyVar con_env2 tv, tidyToIfaceType con_env2 ty)
  613 
  614           -- By this point, we have tidied every universal and existential
  615           -- tyvar. Because of the dcUserTyCoVarBinders invariant
  616           -- (see Note [DataCon user type variable binders]), *every*
  617           -- user-written tyvar must be contained in the substitution that
  618           -- tidying produced. Therefore, tidying the user-written tyvars is a
  619           -- simple matter of looking up each variable in the substitution,
  620           -- which tidyTyCoVarOcc accomplishes.
  621           tidyUserTyCoVarBinder :: TidyEnv -> InvisTVBinder -> InvisTVBinder
  622           tidyUserTyCoVarBinder env (Bndr tv vis) =
  623             Bndr (tidyTyCoVarOcc env tv) vis
  624 
  625 classToIfaceDecl :: TidyEnv -> Class -> (TidyEnv, IfaceDecl)
  626 classToIfaceDecl env clas
  627   = ( env1
  628     , IfaceClass { ifName   = getName tycon,
  629                    ifRoles  = tyConRoles (classTyCon clas),
  630                    ifBinders = toIfaceTyCoVarBinders tc_binders,
  631                    ifBody   = body,
  632                    ifFDs    = map toIfaceFD clas_fds })
  633   where
  634     (_, clas_fds, sc_theta, _, clas_ats, op_stuff)
  635       = classExtraBigSig clas
  636     tycon = classTyCon clas
  637 
  638     body | isAbstractTyCon tycon = IfAbstractClass
  639          | otherwise
  640          = IfConcreteClass {
  641                 ifClassCtxt   = tidyToIfaceContext env1 sc_theta,
  642                 ifATs    = map toIfaceAT clas_ats,
  643                 ifSigs   = map toIfaceClassOp op_stuff,
  644                 ifMinDef = fmap getOccFS (classMinimalDef clas)
  645             }
  646 
  647     (env1, tc_binders) = tidyTyConBinders env (tyConBinders tycon)
  648 
  649     toIfaceAT :: ClassATItem -> IfaceAT
  650     toIfaceAT (ATI tc def)
  651       = IfaceAT if_decl (fmap (tidyToIfaceType env2 . fst) def)
  652       where
  653         (env2, if_decl) = tyConToIfaceDecl env1 tc
  654 
  655     toIfaceClassOp (sel_id, def_meth)
  656         = assert (sel_tyvars == binderVars tc_binders) $
  657           IfaceClassOp (getName sel_id)
  658                        (tidyToIfaceType env1 op_ty)
  659                        (fmap toDmSpec def_meth)
  660         where
  661                 -- Be careful when splitting the type, because of things
  662                 -- like         class Foo a where
  663                 --                op :: (?x :: String) => a -> a
  664                 -- and          class Baz a where
  665                 --                op :: (Ord a) => a -> a
  666           (sel_tyvars, rho_ty) = splitForAllTyCoVars (idType sel_id)
  667           op_ty                = funResultTy rho_ty
  668 
  669     toDmSpec :: (Name, DefMethSpec Type) -> DefMethSpec IfaceType
  670     toDmSpec (_, VanillaDM)       = VanillaDM
  671     toDmSpec (_, GenericDM dm_ty) = GenericDM (tidyToIfaceType env1 dm_ty)
  672 
  673     toIfaceFD (tvs1, tvs2) = (map (tidyTyVar env1) tvs1
  674                              ,map (tidyTyVar env1) tvs2)
  675 
  676 --------------------------
  677 
  678 tidyTyConBinder :: TidyEnv -> TyConBinder -> (TidyEnv, TyConBinder)
  679 -- If the type variable "binder" is in scope, don't re-bind it
  680 -- In a class decl, for example, the ATD binders mention
  681 -- (amd must mention) the class tyvars
  682 tidyTyConBinder env@(_, subst) tvb@(Bndr tv vis)
  683  = case lookupVarEnv subst tv of
  684      Just tv' -> (env,  Bndr tv' vis)
  685      Nothing  -> tidyTyCoVarBinder env tvb
  686 
  687 tidyTyConBinders :: TidyEnv -> [TyConBinder] -> (TidyEnv, [TyConBinder])
  688 tidyTyConBinders = mapAccumL tidyTyConBinder
  689 
  690 tidyTyVar :: TidyEnv -> TyVar -> FastString
  691 tidyTyVar (_, subst) tv = toIfaceTyVar (lookupVarEnv subst tv `orElse` tv)
  692 
  693 --------------------------
  694 instanceToIfaceInst :: ClsInst -> IfaceClsInst
  695 instanceToIfaceInst (ClsInst { is_dfun = dfun_id, is_flag = oflag
  696                              , is_cls_nm = cls_name, is_cls = cls
  697                              , is_tcs = rough_tcs
  698                              , is_orphan = orph })
  699   = assert (cls_name == className cls) $
  700     IfaceClsInst { ifDFun     = idName dfun_id
  701                  , ifOFlag    = oflag
  702                  , ifInstCls  = cls_name
  703                  , ifInstTys  = ifaceRoughMatchTcs rough_tcs
  704                  , ifInstOrph = orph }
  705 
  706 --------------------------
  707 famInstToIfaceFamInst :: FamInst -> IfaceFamInst
  708 famInstToIfaceFamInst (FamInst { fi_axiom    = axiom,
  709                                  fi_fam      = fam,
  710                                  fi_tcs      = rough_tcs })
  711   = IfaceFamInst { ifFamInstAxiom    = coAxiomName axiom
  712                  , ifFamInstFam      = fam
  713                  , ifFamInstTys      = ifaceRoughMatchTcs rough_tcs
  714                  , ifFamInstOrph     = orph }
  715   where
  716     fam_decl = tyConName $ coAxiomTyCon axiom
  717     mod = assert (isExternalName (coAxiomName axiom)) $
  718           nameModule (coAxiomName axiom)
  719     is_local name = nameIsLocalOrFrom mod name
  720 
  721     lhs_names = filterNameSet is_local (orphNamesOfCoCon axiom)
  722 
  723     orph | is_local fam_decl
  724          = NotOrphan (nameOccName fam_decl)
  725          | otherwise
  726          = chooseOrphanAnchor lhs_names
  727 
  728 ifaceRoughMatchTcs :: [RoughMatchTc] -> [Maybe IfaceTyCon]
  729 ifaceRoughMatchTcs tcs = map do_rough tcs
  730   where
  731     do_rough OtherTc     = Nothing
  732     do_rough (KnownTc n) = Just (toIfaceTyCon_name n)
  733 
  734 --------------------------
  735 coreRuleToIfaceRule :: CoreRule -> IfaceRule
  736 coreRuleToIfaceRule (BuiltinRule { ru_fn = fn})
  737   = pprTrace "toHsRule: builtin" (ppr fn) $
  738     bogusIfaceRule fn
  739 
  740 coreRuleToIfaceRule (Rule { ru_name = name, ru_fn = fn,
  741                             ru_act = act, ru_bndrs = bndrs,
  742                             ru_args = args, ru_rhs = rhs,
  743                             ru_orphan = orph, ru_auto = auto })
  744   = IfaceRule { ifRuleName  = name, ifActivation = act,
  745                 ifRuleBndrs = map toIfaceBndr bndrs,
  746                 ifRuleHead  = fn,
  747                 ifRuleArgs  = map do_arg args,
  748                 ifRuleRhs   = toIfaceExpr rhs,
  749                 ifRuleAuto  = auto,
  750                 ifRuleOrph  = orph }
  751   where
  752         -- For type args we must remove synonyms from the outermost
  753         -- level.  Reason: so that when we read it back in we'll
  754         -- construct the same ru_rough field as we have right now;
  755         -- see tcIfaceRule
  756     do_arg (Type ty)     = IfaceType (toIfaceType (deNoteType ty))
  757     do_arg (Coercion co) = IfaceCo   (toIfaceCoercion co)
  758     do_arg arg           = toIfaceExpr arg
  759 
  760 bogusIfaceRule :: Name -> IfaceRule
  761 bogusIfaceRule id_name
  762   = IfaceRule { ifRuleName = fsLit "bogus", ifActivation = NeverActive,
  763         ifRuleBndrs = [], ifRuleHead = id_name, ifRuleArgs = [],
  764         ifRuleRhs = IfaceExt id_name, ifRuleOrph = IsOrphan,
  765         ifRuleAuto = True }