    {-# LANGUAGE CPP          #-}
    {-# LANGUAGE TypeFamilies #-}

    {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

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

    The Desugarer: turning HsSyn into Core.
    -}

    module GHC.HsToCore (
        -- * Desugaring operations
        deSugar, deSugarExpr
        ) where

    #include "HsVersions.h"

    import GHC.Prelude

    import GHC.Driver.Session
    import GHC.Driver.Config
    import GHC.Driver.Env
    import GHC.Driver.Backend

    import GHC.Hs

    import GHC.HsToCore.Usage
    import GHC.HsToCore.Monad
    import GHC.HsToCore.Expr
    import GHC.HsToCore.Binds
    import GHC.HsToCore.Foreign.Decl
    import GHC.HsToCore.Coverage
    import GHC.HsToCore.Docs

    import GHC.Tc.Types
    import GHC.Tc.Utils.Monad  ( finalSafeMode, fixSafeInstances )
    import GHC.Tc.Module ( runTcInteractive )

    import GHC.Core.Type
    import GHC.Core.TyCon     ( tyConDataCons )
    import GHC.Core
    import GHC.Core.FVs       ( exprsSomeFreeVarsList )
    import GHC.Core.SimpleOpt ( simpleOptPgm, simpleOptExpr )
    import GHC.Core.Utils
    import GHC.Core.Unfold.Make
    import GHC.Core.Ppr
    import GHC.Core.Coercion
    import GHC.Core.DataCon ( dataConWrapId )
    import GHC.Core.Make
    import GHC.Core.Rules
    import GHC.Core.Opt.Monad ( CoreToDo(..) )
    import GHC.Core.Lint     ( endPassIO )

    import GHC.Builtin.Names
    import GHC.Builtin.Types.Prim
    import GHC.Builtin.Types

    import GHC.Data.FastString
    import GHC.Data.OrdList

    import GHC.Utils.Error
    import GHC.Utils.Outputable
    import GHC.Utils.Panic
    import GHC.Utils.Misc
    import GHC.Utils.Monad
    import GHC.Utils.Logger

    import GHC.Types.Id
    import GHC.Types.Id.Info
    import GHC.Types.ForeignStubs
    import GHC.Types.Avail
    import GHC.Types.Basic
    import GHC.Types.Var.Set
    import GHC.Types.SrcLoc
    import GHC.Types.SourceFile
    import GHC.Types.TypeEnv
    import GHC.Types.Name
    import GHC.Types.Name.Set
    import GHC.Types.Name.Env
    import GHC.Types.Name.Ppr
    import GHC.Types.HpcInfo

    import GHC.Unit
    import GHC.Unit.Module.ModGuts
    import GHC.Unit.Module.ModIface

    import Data.List (partition)
    import Data.IORef
    import Control.Monad( when )
    import GHC.Driver.Plugins ( LoadedPlugin(..) )

    {-
    ************************************************************************
    *                                                                      *
    *              The main function: deSugar
    *                                                                      *
    ************************************************************************
    -}

    -- | Main entry point to the desugarer.
    deSugar :: HscEnv -> ModLocation -> TcGblEnv -> IO (Messages DecoratedSDoc, Maybe ModGuts)
    -- Can modify PCS by faulting in more declarations

    deSugar :: HscEnv
    -> ModLocation
    -> TcGblEnv
    -> IO (Messages DecoratedSDoc, Maybe ModGuts)
    deSugar HscEnv
    hsc_env
            ModLocation
    mod_loc
            tcg_env :: TcGblEnv
    tcg_env@(TcGblEnv { tcg_mod :: TcGblEnv -> Module
    tcg_mod          = Module
    id_mod,
                                tcg_semantic_mod :: TcGblEnv -> Module
    tcg_semantic_mod = Module
    mod,
                                tcg_src :: TcGblEnv -> HscSource
    tcg_src          = HscSource
    hsc_src,
                                tcg_type_env :: TcGblEnv -> TypeEnv
    tcg_type_env     = TypeEnv
    type_env,
                                tcg_imports :: TcGblEnv -> ImportAvails
    tcg_imports      = ImportAvails
    imports,
                                tcg_exports :: TcGblEnv -> [AvailInfo]
    tcg_exports      = [AvailInfo]
    exports,
                                tcg_keep :: TcGblEnv -> TcRef NameSet
    tcg_keep         = TcRef NameSet
    keep_var,
                                tcg_th_splice_used :: TcGblEnv -> TcRef Bool
    tcg_th_splice_used = TcRef Bool
    tc_splice_used,
                                tcg_rdr_env :: TcGblEnv -> GlobalRdrEnv
    tcg_rdr_env      = GlobalRdrEnv
    rdr_env,
                                tcg_fix_env :: TcGblEnv -> FixityEnv
    tcg_fix_env      = FixityEnv
    fix_env,
                                tcg_inst_env :: TcGblEnv -> InstEnv
    tcg_inst_env     = InstEnv
    inst_env,
                                tcg_fam_inst_env :: TcGblEnv -> FamInstEnv
    tcg_fam_inst_env = FamInstEnv
    fam_inst_env,
                                tcg_merged :: TcGblEnv -> [(Module, Fingerprint)]
    tcg_merged       = [(Module, Fingerprint)]
    merged,
                                tcg_warns :: TcGblEnv -> Warnings
    tcg_warns        = Warnings
    warns,
                                tcg_anns :: TcGblEnv -> [Annotation]
    tcg_anns         = [Annotation]
    anns,
                                tcg_binds :: TcGblEnv -> LHsBinds GhcTc
    tcg_binds        = LHsBinds GhcTc
    binds,
                                tcg_imp_specs :: TcGblEnv -> [LTcSpecPrag]
    tcg_imp_specs    = [LTcSpecPrag]
    imp_specs,
                                tcg_dependent_files :: TcGblEnv -> TcRef [FilePath]
    tcg_dependent_files = TcRef [FilePath]
    dependent_files,
                                tcg_ev_binds :: TcGblEnv -> Bag EvBind
    tcg_ev_binds     = Bag EvBind
    ev_binds,
                                tcg_th_foreign_files :: TcGblEnv -> TcRef [(ForeignSrcLang, FilePath)]
    tcg_th_foreign_files = TcRef [(ForeignSrcLang, FilePath)]
    th_foreign_files_var,
                                tcg_fords :: TcGblEnv -> [LForeignDecl GhcTc]
    tcg_fords        = [LForeignDecl GhcTc]
    fords,
                                tcg_rules :: TcGblEnv -> [LRuleDecl GhcTc]
    tcg_rules        = [LRuleDecl GhcTc]
    rules,
                                tcg_patsyns :: TcGblEnv -> [PatSyn]
    tcg_patsyns      = [PatSyn]
    patsyns,
                                tcg_tcs :: TcGblEnv -> [TyCon]
    tcg_tcs          = [TyCon]
    tcs,
                                tcg_insts :: TcGblEnv -> [ClsInst]
    tcg_insts        = [ClsInst]
    insts,
                                tcg_fam_insts :: TcGblEnv -> [FamInst]
    tcg_fam_insts    = [FamInst]
    fam_insts,
                                tcg_hpc :: TcGblEnv -> Bool
    tcg_hpc          = Bool
    other_hpc_info,
                                tcg_complete_matches :: TcGblEnv -> CompleteMatches
    tcg_complete_matches = CompleteMatches
    complete_matches
                                })

      = do { let dflags :: DynFlags
    dflags = HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env
                 logger :: Logger
    logger = HscEnv -> Logger
    hsc_logger HscEnv
    hsc_env
                 print_unqual :: PrintUnqualified
    print_unqual = UnitEnv -> GlobalRdrEnv -> PrintUnqualified
    mkPrintUnqualified (HscEnv -> UnitEnv
    hsc_unit_env HscEnv
    hsc_env) GlobalRdrEnv
    rdr_env
            ; Logger
    -> DynFlags
    -> SDoc
    -> ((Messages DecoratedSDoc, Maybe ModGuts) -> ())
    -> IO (Messages DecoratedSDoc, Maybe ModGuts)
    -> IO (Messages DecoratedSDoc, Maybe ModGuts)
    forall (m :: * -> *) a.
    MonadIO m =>
    Logger -> DynFlags -> SDoc -> (a -> ()) -> m a -> m a
    withTiming Logger
    logger DynFlags
    dflags
                         (FilePath -> SDoc
    text FilePath
    "Desugar"SDoc -> SDoc -> SDoc
    <+>SDoc -> SDoc
    brackets (Module -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Module
    mod))
                         (() -> (Messages DecoratedSDoc, Maybe ModGuts) -> ()
    forall a b. a -> b -> a
    const ()) (IO (Messages DecoratedSDoc, Maybe ModGuts)
     -> IO (Messages DecoratedSDoc, Maybe ModGuts))
    -> IO (Messages DecoratedSDoc, Maybe ModGuts)
    -> IO (Messages DecoratedSDoc, Maybe ModGuts)
    forall a b. (a -> b) -> a -> b
    $
         do { -- Desugar the program
            ; let export_set :: NameSet
    export_set = [AvailInfo] -> NameSet
    availsToNameSet [AvailInfo]
    exports
                  bcknd :: Backend
    bcknd      = DynFlags -> Backend
    backend DynFlags
    dflags
                  hpcInfo :: HpcInfo
    hpcInfo    = Bool -> HpcInfo
    emptyHpcInfo Bool
    other_hpc_info

            ; (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
    binds_cvr, HpcInfo
    ds_hpc_info, Maybe ModBreaks
    modBreaks)
                             <- if Bool -> Bool
    not (HscSource -> Bool
    isHsBootOrSig HscSource
    hsc_src)
                                  then HscEnv
    -> Module
    -> ModLocation
    -> NameSet
    -> [TyCon]
    -> LHsBinds GhcTc
    -> IO (LHsBinds GhcTc, HpcInfo, Maybe ModBreaks)
    addTicksToBinds HscEnv
    hsc_env Module
    mod ModLocation
    mod_loc
                                           NameSet
    export_set (TypeEnv -> [TyCon]
    typeEnvTyCons TypeEnv
    type_env) LHsBinds GhcTc
    binds
                                  else (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)), HpcInfo,
     Maybe ModBreaks)
    -> IO
         (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)), HpcInfo,
          Maybe ModBreaks)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
    LHsBinds GhcTc
    binds, HpcInfo
    hpcInfo, Maybe ModBreaks
    forall a. Maybe a
    Nothing)
            ; (Messages DecoratedSDoc
    msgs, Maybe ([CoreBind], OrdList Binding, [CoreRule], ForeignStubs)
    mb_res) <- HscEnv
    -> TcGblEnv
    -> DsM ([CoreBind], OrdList Binding, [CoreRule], ForeignStubs)
    -> IO
         (Messages DecoratedSDoc,
          Maybe ([CoreBind], OrdList Binding, [CoreRule], ForeignStubs))
    forall a.
    HscEnv -> TcGblEnv -> DsM a -> IO (Messages DecoratedSDoc, Maybe a)
    initDs HscEnv
    hsc_env TcGblEnv
    tcg_env (DsM ([CoreBind], OrdList Binding, [CoreRule], ForeignStubs)
     -> IO
          (Messages DecoratedSDoc,
           Maybe ([CoreBind], OrdList Binding, [CoreRule], ForeignStubs)))
    -> DsM ([CoreBind], OrdList Binding, [CoreRule], ForeignStubs)
    -> IO
         (Messages DecoratedSDoc,
          Maybe ([CoreBind], OrdList Binding, [CoreRule], ForeignStubs))
    forall a b. (a -> b) -> a -> b
    $
                           do { [CoreBind]
    ds_ev_binds <- Bag EvBind -> DsM [CoreBind]
    dsEvBinds Bag EvBind
    ev_binds
                              ; OrdList Binding
    core_prs <- LHsBinds GhcTc -> DsM (OrdList Binding)
    dsTopLHsBinds Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
    LHsBinds GhcTc
    binds_cvr
                              ; OrdList Binding
    core_prs <- OrdList Binding -> DsM (OrdList Binding)
    patchMagicDefns OrdList Binding
    core_prs
                              ; (OrdList Binding
    spec_prs, [CoreRule]
    spec_rules) <- [LTcSpecPrag] -> DsM (OrdList Binding, [CoreRule])
    dsImpSpecs [LTcSpecPrag]
    imp_specs
                              ; (ForeignStubs
    ds_fords, OrdList Binding
    foreign_prs) <- [LForeignDecl GhcTc] -> DsM (ForeignStubs, OrdList Binding)
    dsForeigns [LForeignDecl GhcTc]
    fords
                              ; [CoreRule]
    ds_rules <- (GenLocated SrcSpanAnnA (RuleDecl GhcTc)
     -> IOEnv (Env DsGblEnv DsLclEnv) (Maybe CoreRule))
    -> [GenLocated SrcSpanAnnA (RuleDecl GhcTc)]
    -> IOEnv (Env DsGblEnv DsLclEnv) [CoreRule]
    forall (m :: * -> *) a b.
    Applicative m =>
    (a -> m (Maybe b)) -> [a] -> m [b]
    mapMaybeM GenLocated SrcSpanAnnA (RuleDecl GhcTc)
    -> IOEnv (Env DsGblEnv DsLclEnv) (Maybe CoreRule)
    LRuleDecl GhcTc -> IOEnv (Env DsGblEnv DsLclEnv) (Maybe CoreRule)
    dsRule [GenLocated SrcSpanAnnA (RuleDecl GhcTc)]
    [LRuleDecl GhcTc]
    rules
                              ; let hpc_init :: CStub
    hpc_init
                                      | GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_Hpc DynFlags
    dflags = DynFlags -> Module -> HpcInfo -> CStub
    hpcInitCode (HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env) Module
    mod HpcInfo
    ds_hpc_info
                                      | Bool
    otherwise = CStub
    forall a. Monoid a => a
    mempty
                              ; ([CoreBind], OrdList Binding, [CoreRule], ForeignStubs)
    -> DsM ([CoreBind], OrdList Binding, [CoreRule], ForeignStubs)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ( [CoreBind]
    ds_ev_binds
                                       , OrdList Binding
    foreign_prs OrdList Binding -> OrdList Binding -> OrdList Binding
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Binding
    core_prs OrdList Binding -> OrdList Binding -> OrdList Binding
    forall a. OrdList a -> OrdList a -> OrdList a
    `appOL` OrdList Binding
    spec_prs
                                       , [CoreRule]
    spec_rules [CoreRule] -> [CoreRule] -> [CoreRule]
    forall a. [a] -> [a] -> [a]
    ++ [CoreRule]
    ds_rules
                                       , ForeignStubs
    ds_fords ForeignStubs -> CStub -> ForeignStubs
    `appendStubC` CStub
    hpc_init) }

            ; case Maybe ([CoreBind], OrdList Binding, [CoreRule], ForeignStubs)
    mb_res of {
               Maybe ([CoreBind], OrdList Binding, [CoreRule], ForeignStubs)
    Nothing -> (Messages DecoratedSDoc, Maybe ModGuts)
    -> IO (Messages DecoratedSDoc, Maybe ModGuts)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Messages DecoratedSDoc
    msgs, Maybe ModGuts
    forall a. Maybe a
    Nothing) ;
               Just ([CoreBind]
    ds_ev_binds, OrdList Binding
    all_prs, [CoreRule]
    all_rules, ForeignStubs
    ds_fords) ->

         do {       -- Add export flags to bindings
              NameSet
    keep_alive <- TcRef NameSet -> IO NameSet
    forall a. IORef a -> IO a
    readIORef TcRef NameSet
    keep_var
            ; let ([CoreRule]
    rules_for_locals, [CoreRule]
    rules_for_imps) = (CoreRule -> Bool) -> [CoreRule] -> ([CoreRule], [CoreRule])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition CoreRule -> Bool
    isLocalRule [CoreRule]
    all_rules
                  final_prs :: [Binding]
    final_prs = Backend
    -> NameSet -> NameSet -> [CoreRule] -> [Binding] -> [Binding]
    forall t.
    Backend
    -> NameSet -> NameSet -> [CoreRule] -> [(Id, t)] -> [(Id, t)]
    addExportFlagsAndRules Backend
    bcknd NameSet
    export_set NameSet
    keep_alive
                                                     [CoreRule]
    rules_for_locals (OrdList Binding -> [Binding]
    forall a. OrdList a -> [a]
    fromOL OrdList Binding
    all_prs)

                  final_pgm :: [CoreBind]
    final_pgm = [CoreBind] -> [Binding] -> [CoreBind]
    combineEvBinds [CoreBind]
    ds_ev_binds [Binding]
    final_prs
            -- Notice that we put the whole lot in a big Rec, even the foreign binds
            -- When compiling PrelFloat, which defines data Float = F# Float#
            -- we want F# to be in scope in the foreign marshalling code!
            -- You might think it doesn't matter, but the simplifier brings all top-level
            -- things into the in-scope set before simplifying; so we get no unfolding for F#!

            ; HscEnv
    -> PrintUnqualified
    -> CoreToDo
    -> [CoreBind]
    -> [CoreRule]
    -> IO ()
    endPassIO HscEnv
    hsc_env PrintUnqualified
    print_unqual CoreToDo
    CoreDesugar [CoreBind]
    final_pgm [CoreRule]
    rules_for_imps
            ; let simpl_opts :: SimpleOpts
    simpl_opts = DynFlags -> SimpleOpts
    initSimpleOpts DynFlags
    dflags
            ; let ([CoreBind]
    ds_binds, [CoreRule]
    ds_rules_for_imps, [CoreBind]
    occ_anald_binds)
                    = SimpleOpts
    -> Module
    -> [CoreBind]
    -> [CoreRule]
    -> ([CoreBind], [CoreRule], [CoreBind])
    simpleOptPgm SimpleOpts
    simpl_opts Module
    mod [CoreBind]
    final_pgm [CoreRule]
    rules_for_imps
                             -- The simpleOptPgm gets rid of type
                             -- bindings plus any stupid dead code
            ; Logger
    -> DynFlags -> DumpFlag -> FilePath -> DumpFormat -> SDoc -> IO ()
    dumpIfSet_dyn Logger
    logger DynFlags
    dflags DumpFlag
    Opt_D_dump_occur_anal FilePath
    "Occurrence analysis"
                DumpFormat
    FormatCore ([CoreBind] -> SDoc
    forall b. OutputableBndr b => [Bind b] -> SDoc
    pprCoreBindings [CoreBind]
    occ_anald_binds SDoc -> SDoc -> SDoc
    $$ [CoreRule] -> SDoc
    pprRules [CoreRule]
    ds_rules_for_imps )

            ; HscEnv
    -> PrintUnqualified
    -> CoreToDo
    -> [CoreBind]
    -> [CoreRule]
    -> IO ()
    endPassIO HscEnv
    hsc_env PrintUnqualified
    print_unqual CoreToDo
    CoreDesugarOpt [CoreBind]
    ds_binds [CoreRule]
    ds_rules_for_imps

            ; let used_names :: NameSet
    used_names = TcGblEnv -> NameSet
    mkUsedNames TcGblEnv
    tcg_env
                  pluginModules :: [ModIface]
    pluginModules = (LoadedPlugin -> ModIface) -> [LoadedPlugin] -> [ModIface]
    forall a b. (a -> b) -> [a] -> [b]
    map LoadedPlugin -> ModIface
    lpModule (HscEnv -> [LoadedPlugin]
    hsc_plugins HscEnv
    hsc_env)
                  home_unit :: HomeUnit
    home_unit = HscEnv -> HomeUnit
    hsc_home_unit HscEnv
    hsc_env
            ; Dependencies
    deps <- UnitId -> [Module] -> TcGblEnv -> IO Dependencies
    mkDependencies (HomeUnit -> UnitId
    forall u. GenHomeUnit u -> UnitId
    homeUnitId HomeUnit
    home_unit)
                                     ((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
    tcg_env

            ; Bool
    used_th <- TcRef Bool -> IO Bool
    forall a. IORef a -> IO a
    readIORef TcRef Bool
    tc_splice_used
            ; [FilePath]
    dep_files <- TcRef [FilePath] -> IO [FilePath]
    forall a. IORef a -> IO a
    readIORef TcRef [FilePath]
    dependent_files
            ; SafeHaskellMode
    safe_mode <- DynFlags -> TcGblEnv -> IO SafeHaskellMode
    finalSafeMode DynFlags
    dflags TcGblEnv
    tcg_env
            ; [Usage]
    usages <- HscEnv
    -> Module
    -> ImportedMods
    -> NameSet
    -> [FilePath]
    -> [(Module, Fingerprint)]
    -> [ModIface]
    -> IO [Usage]
    mkUsageInfo HscEnv
    hsc_env Module
    mod (ImportAvails -> ImportedMods
    imp_mods ImportAvails
    imports) NameSet
    used_names
                          [FilePath]
    dep_files [(Module, Fingerprint)]
    merged [ModIface]
    pluginModules
            -- id_mod /= mod when we are processing an hsig, but hsigs
            -- never desugared and compiled (there's no code!)
            -- Consequently, this should hold for any ModGuts that make
            -- past desugaring. See Note [Identity versus semantic module].
            ; MASSERT( id_mod == mod )

            ; [(ForeignSrcLang, FilePath)]
    foreign_files <- TcRef [(ForeignSrcLang, FilePath)]
    -> IO [(ForeignSrcLang, FilePath)]
    forall a. IORef a -> IO a
    readIORef TcRef [(ForeignSrcLang, FilePath)]
    th_foreign_files_var

            ; (Maybe HsDocString
    doc_hdr, DeclDocMap
    decl_docs, ArgDocMap
    arg_docs) <- TcGblEnv -> IO (Maybe HsDocString, DeclDocMap, ArgDocMap)
    forall (m :: * -> *).
    MonadIO m =>
    TcGblEnv -> m (Maybe HsDocString, DeclDocMap, ArgDocMap)
    extractDocs TcGblEnv
    tcg_env

            ; let mod_guts :: ModGuts
    mod_guts = ModGuts {
                    mg_module :: Module
    mg_module       = Module
    mod,
                    mg_hsc_src :: HscSource
    mg_hsc_src      = HscSource
    hsc_src,
                    mg_loc :: SrcSpan
    mg_loc          = ModLocation -> SrcSpan
    mkFileSrcSpan ModLocation
    mod_loc,
                    mg_exports :: [AvailInfo]
    mg_exports      = [AvailInfo]
    exports,
                    mg_usages :: [Usage]
    mg_usages       = [Usage]
    usages,
                    mg_deps :: Dependencies
    mg_deps         = Dependencies
    deps,
                    mg_used_th :: Bool
    mg_used_th      = Bool
    used_th,
                    mg_rdr_env :: GlobalRdrEnv
    mg_rdr_env      = GlobalRdrEnv
    rdr_env,
                    mg_fix_env :: FixityEnv
    mg_fix_env      = FixityEnv
    fix_env,
                    mg_warns :: Warnings
    mg_warns        = Warnings
    warns,
                    mg_anns :: [Annotation]
    mg_anns         = [Annotation]
    anns,
                    mg_tcs :: [TyCon]
    mg_tcs          = [TyCon]
    tcs,
                    mg_insts :: [ClsInst]
    mg_insts        = SafeHaskellMode -> [ClsInst] -> [ClsInst]
    fixSafeInstances SafeHaskellMode
    safe_mode [ClsInst]
    insts,
                    mg_fam_insts :: [FamInst]
    mg_fam_insts    = [FamInst]
    fam_insts,
                    mg_inst_env :: InstEnv
    mg_inst_env     = InstEnv
    inst_env,
                    mg_fam_inst_env :: FamInstEnv
    mg_fam_inst_env = FamInstEnv
    fam_inst_env,
                    mg_patsyns :: [PatSyn]
    mg_patsyns      = [PatSyn]
    patsyns,
                    mg_rules :: [CoreRule]
    mg_rules        = [CoreRule]
    ds_rules_for_imps,
                    mg_binds :: [CoreBind]
    mg_binds        = [CoreBind]
    ds_binds,
                    mg_foreign :: ForeignStubs
    mg_foreign      = ForeignStubs
    ds_fords,
                    mg_foreign_files :: [(ForeignSrcLang, FilePath)]
    mg_foreign_files = [(ForeignSrcLang, FilePath)]
    foreign_files,
                    mg_hpc_info :: HpcInfo
    mg_hpc_info     = HpcInfo
    ds_hpc_info,
                    mg_modBreaks :: Maybe ModBreaks
    mg_modBreaks    = Maybe ModBreaks
    modBreaks,
                    mg_safe_haskell :: SafeHaskellMode
    mg_safe_haskell = SafeHaskellMode
    safe_mode,
                    mg_trust_pkg :: Bool
    mg_trust_pkg    = ImportAvails -> Bool
    imp_trust_own_pkg ImportAvails
    imports,
                    mg_complete_matches :: CompleteMatches
    mg_complete_matches = CompleteMatches
    complete_matches,
                    mg_doc_hdr :: Maybe HsDocString
    mg_doc_hdr      = Maybe HsDocString
    doc_hdr,
                    mg_decl_docs :: DeclDocMap
    mg_decl_docs    = DeclDocMap
    decl_docs,
                    mg_arg_docs :: ArgDocMap
    mg_arg_docs     = ArgDocMap
    arg_docs
                  }
            ; (Messages DecoratedSDoc, Maybe ModGuts)
    -> IO (Messages DecoratedSDoc, Maybe ModGuts)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Messages DecoratedSDoc
    msgs, ModGuts -> Maybe ModGuts
    forall a. a -> Maybe a
    Just ModGuts
    mod_guts)
            }}}}

    mkFileSrcSpan :: ModLocation -> SrcSpan
    mkFileSrcSpan :: ModLocation -> SrcSpan
    mkFileSrcSpan ModLocation
    mod_loc
      = case ModLocation -> Maybe FilePath
    ml_hs_file ModLocation
    mod_loc of
          Just FilePath
    file_path -> FastString -> SrcSpan
    mkGeneralSrcSpan (FilePath -> FastString
    mkFastString FilePath
    file_path)
          Maybe FilePath
    Nothing        -> SrcSpan
    interactiveSrcSpan   -- Presumably

    dsImpSpecs :: [LTcSpecPrag] -> DsM (OrdList (Id,CoreExpr), [CoreRule])
    dsImpSpecs :: [LTcSpecPrag] -> DsM (OrdList Binding, [CoreRule])
    dsImpSpecs [LTcSpecPrag]
    imp_specs
     = do { [(OrdList Binding, CoreRule)]
    spec_prs <- (LTcSpecPrag
     -> IOEnv
          (Env DsGblEnv DsLclEnv) (Maybe (OrdList Binding, CoreRule)))
    -> [LTcSpecPrag]
    -> IOEnv (Env DsGblEnv DsLclEnv) [(OrdList Binding, CoreRule)]
    forall (m :: * -> *) a b.
    Applicative m =>
    (a -> m (Maybe b)) -> [a] -> m [b]
    mapMaybeM (Maybe CoreExpr
    -> LTcSpecPrag
    -> IOEnv
         (Env DsGblEnv DsLclEnv) (Maybe (OrdList Binding, CoreRule))
    dsSpec Maybe CoreExpr
    forall a. Maybe a
    Nothing) [LTcSpecPrag]
    imp_specs
          ; let ([OrdList Binding]
    spec_binds, [CoreRule]
    spec_rules) = [(OrdList Binding, CoreRule)] -> ([OrdList Binding], [CoreRule])
    forall a b. [(a, b)] -> ([a], [b])
    unzip [(OrdList Binding, CoreRule)]
    spec_prs
          ; (OrdList Binding, [CoreRule]) -> DsM (OrdList Binding, [CoreRule])
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([OrdList Binding] -> OrdList Binding
    forall a. [OrdList a] -> OrdList a
    concatOL [OrdList Binding]
    spec_binds, [CoreRule]
    spec_rules) }

    combineEvBinds :: [CoreBind] -> [(Id,CoreExpr)] -> [CoreBind]
    -- Top-level bindings can include coercion bindings, but not via superclasses
    -- See Note [Top-level evidence]
    combineEvBinds :: [CoreBind] -> [Binding] -> [CoreBind]
    combineEvBinds [] [Binding]
    val_prs
      = [[Binding] -> CoreBind
    forall b. [(b, Expr b)] -> Bind b
    Rec [Binding]
    val_prs]
    combineEvBinds (NonRec Id
    b CoreExpr
    r : [CoreBind]
    bs) [Binding]
    val_prs
      | Id -> Bool
    isId Id
    b    = [CoreBind] -> [Binding] -> [CoreBind]
    combineEvBinds [CoreBind]
    bs ((Id
    b,CoreExpr
    r)Binding -> [Binding] -> [Binding]
    forall a. a -> [a] -> [a]
    :[Binding]
    val_prs)
      | Bool
    otherwise = Id -> CoreExpr -> CoreBind
    forall b. b -> Expr b -> Bind b
    NonRec Id
    b CoreExpr
    r CoreBind -> [CoreBind] -> [CoreBind]
    forall a. a -> [a] -> [a]
    : [CoreBind] -> [Binding] -> [CoreBind]
    combineEvBinds [CoreBind]
    bs [Binding]
    val_prs
    combineEvBinds (Rec [Binding]
    prs : [CoreBind]
    bs) [Binding]
    val_prs
      = [CoreBind] -> [Binding] -> [CoreBind]
    combineEvBinds [CoreBind]
    bs ([Binding]
    prs [Binding] -> [Binding] -> [Binding]
    forall a. [a] -> [a] -> [a]
    ++ [Binding]
    val_prs)

    {-
    Note [Top-level evidence]
    ~~~~~~~~~~~~~~~~~~~~~~~~~
    Top-level evidence bindings may be mutually recursive with the top-level value
    bindings, so we must put those in a Rec.  But we can't put them *all* in a Rec
    because the occurrence analyser doesn't take account of type/coercion variables
    when computing dependencies.

    So we pull out the type/coercion variables (which are in dependency order),
    and Rec the rest.
    -}

    deSugarExpr :: HscEnv -> LHsExpr GhcTc -> IO (Messages DecoratedSDoc, Maybe CoreExpr)
    deSugarExpr :: HscEnv
    -> LHsExpr GhcTc -> IO (Messages DecoratedSDoc, Maybe CoreExpr)
    deSugarExpr HscEnv
    hsc_env LHsExpr GhcTc
    tc_expr = do
        let dflags :: DynFlags
    dflags = HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env
        let logger :: Logger
    logger = HscEnv -> Logger
    hsc_logger HscEnv
    hsc_env

        Logger -> DynFlags -> FilePath -> IO ()
    showPass Logger
    logger DynFlags
    dflags FilePath
    "Desugar"

        -- Do desugaring
        (Messages DecoratedSDoc
    msgs, Maybe CoreExpr
    mb_core_expr) <- HscEnv
    -> TcRn CoreExpr -> IO (Messages DecoratedSDoc, Maybe CoreExpr)
    forall a. HscEnv -> TcRn a -> IO (Messages DecoratedSDoc, Maybe a)
    runTcInteractive HscEnv
    hsc_env (TcRn CoreExpr -> IO (Messages DecoratedSDoc, Maybe CoreExpr))
    -> TcRn CoreExpr -> IO (Messages DecoratedSDoc, Maybe CoreExpr)
    forall a b. (a -> b) -> a -> b
    $ DsM CoreExpr -> TcRn CoreExpr
    forall a. DsM a -> TcM a
    initDsTc (DsM CoreExpr -> TcRn CoreExpr) -> DsM CoreExpr -> TcRn CoreExpr
    forall a b. (a -> b) -> a -> b
    $
                                     LHsExpr GhcTc -> DsM CoreExpr
    dsLExpr LHsExpr GhcTc
    tc_expr

        case Maybe CoreExpr
    mb_core_expr of
           Maybe CoreExpr
    Nothing   -> () -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
           Just CoreExpr
    expr -> Logger
    -> DynFlags -> DumpFlag -> FilePath -> DumpFormat -> SDoc -> IO ()
    dumpIfSet_dyn Logger
    logger DynFlags
    dflags DumpFlag
    Opt_D_dump_ds FilePath
    "Desugared"
                        DumpFormat
    FormatCore (CoreExpr -> SDoc
    forall b. OutputableBndr b => Expr b -> SDoc
    pprCoreExpr CoreExpr
    expr)

        (Messages DecoratedSDoc, Maybe CoreExpr)
    -> IO (Messages DecoratedSDoc, Maybe CoreExpr)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Messages DecoratedSDoc
    msgs, Maybe CoreExpr
    mb_core_expr)

    {-
    ************************************************************************
    *                                                                      *
    *              Add rules and export flags to binders
    *                                                                      *
    ************************************************************************
    -}

    addExportFlagsAndRules
        :: Backend -> NameSet -> NameSet -> [CoreRule]
        -> [(Id, t)] -> [(Id, t)]
    addExportFlagsAndRules :: forall t.
    Backend
    -> NameSet -> NameSet -> [CoreRule] -> [(Id, t)] -> [(Id, t)]
    addExportFlagsAndRules Backend
    bcknd NameSet
    exports NameSet
    keep_alive [CoreRule]
    rules [(Id, t)]
    prs
      = (Id -> Id) -> [(Id, t)] -> [(Id, t)]
    forall a c b. (a -> c) -> [(a, b)] -> [(c, b)]
    mapFst Id -> Id
    add_one [(Id, t)]
    prs
      where
        add_one :: Id -> Id
    add_one Id
    bndr = Name -> Id -> Id
    add_rules Name
    name (Name -> Id -> Id
    add_export Name
    name Id
    bndr)
           where
             name :: Name
    name = Id -> Name
    idName Id
    bndr

        ---------- Rules --------
            -- See Note [Attach rules to local ids]
            -- NB: the binder might have some existing rules,
            -- arising from specialisation pragmas
        add_rules :: Name -> Id -> Id
    add_rules Name
    name Id
    bndr
            | Just [CoreRule]
    rules <- NameEnv [CoreRule] -> Name -> Maybe [CoreRule]
    forall a. NameEnv a -> Name -> Maybe a
    lookupNameEnv NameEnv [CoreRule]
    rule_base Name
    name
            = Id
    bndr Id -> [CoreRule] -> Id
    `addIdSpecialisations` [CoreRule]
    rules
            | Bool
    otherwise
            = Id
    bndr
        rule_base :: NameEnv [CoreRule]
    rule_base = NameEnv [CoreRule] -> [CoreRule] -> NameEnv [CoreRule]
    extendRuleBaseList NameEnv [CoreRule]
    emptyRuleBase [CoreRule]
    rules

        ---------- Export flag --------
        -- See Note [Adding export flags]
        add_export :: Name -> Id -> Id
    add_export Name
    name Id
    bndr
            | Name -> Bool
    dont_discard Name
    name = Id -> Id
    setIdExported Id
    bndr
            | Bool
    otherwise         = Id
    bndr

        dont_discard :: Name -> Bool
        dont_discard :: Name -> Bool
    dont_discard Name
    name = Name -> Bool
    is_exported Name
    name
                         Bool -> Bool -> Bool
    || Name
    name Name -> NameSet -> Bool
    `elemNameSet` NameSet
    keep_alive

            -- In interactive mode, we don't want to discard any top-level
            -- entities at all (eg. do not inline them away during
            -- simplification), and retain them all in the TypeEnv so they are
            -- available from the command line.
            --
            -- isExternalName separates the user-defined top-level names from those
            -- introduced by the type checker.
        is_exported :: Name -> Bool
        is_exported :: Name -> Bool
    is_exported | Backend -> Bool
    backendRetainsAllBindings Backend
    bcknd = Name -> Bool
    isExternalName
                    | Bool
    otherwise                       = (Name -> NameSet -> Bool
    `elemNameSet` NameSet
    exports)

    {-
    Note [Adding export flags]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~
    Set the no-discard flag if either
            a) the Id is exported
            b) it's mentioned in the RHS of an orphan rule
            c) it's in the keep-alive set

    It means that the binding won't be discarded EVEN if the binding
    ends up being trivial (v = w) -- the simplifier would usually just
    substitute w for v throughout, but we don't apply the substitution to
    the rules (maybe we should?), so this substitution would make the rule
    bogus.

    You might wonder why exported Ids aren't already marked as such;
    it's just because the type checker is rather busy already and
    I didn't want to pass in yet another mapping.

    Note [Attach rules to local ids]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Find the rules for locally-defined Ids; then we can attach them
    to the binders in the top-level bindings

    Reason
      - It makes the rules easier to look up
      - It means that rewrite rules and specialisations for
        locally defined Ids are handled uniformly
      - It keeps alive things that are referred to only from a rule
        (the occurrence analyser knows about rules attached to Ids)
      - It makes sure that, when we apply a rule, the free vars
        of the RHS are more likely to be in scope
      - The imported rules are carried in the in-scope set
        which is extended on each iteration by the new wave of
        local binders; any rules which aren't on the binding will
        thereby get dropped

    ************************************************************************
    *                                                                      *
    *              Desugaring rewrite rules
    *                                                                      *
    ************************************************************************
    -}

    dsRule :: LRuleDecl GhcTc -> DsM (Maybe CoreRule)
    dsRule :: LRuleDecl GhcTc -> IOEnv (Env DsGblEnv DsLclEnv) (Maybe CoreRule)
    dsRule (L SrcSpanAnnA
    loc (HsRule { rd_name :: forall pass. RuleDecl pass -> XRec pass (SourceText, FastString)
    rd_name = XRec GhcTc (SourceText, FastString)
    name
                          , rd_act :: forall pass. RuleDecl pass -> Activation
    rd_act  = Activation
    rule_act
                          , rd_tmvs :: forall pass. RuleDecl pass -> [LRuleBndr pass]
    rd_tmvs = [LRuleBndr GhcTc]
    vars
                          , rd_lhs :: forall pass. RuleDecl pass -> XRec pass (HsExpr pass)
    rd_lhs  = LHsExpr GhcTc
    lhs
                          , rd_rhs :: forall pass. RuleDecl pass -> XRec pass (HsExpr pass)
    rd_rhs  = LHsExpr GhcTc
    rhs }))
      = SrcSpan
    -> IOEnv (Env DsGblEnv DsLclEnv) (Maybe CoreRule)
    -> IOEnv (Env DsGblEnv DsLclEnv) (Maybe CoreRule)
    forall a. SrcSpan -> DsM a -> DsM a
    putSrcSpanDs (SrcSpanAnnA -> SrcSpan
    forall a. SrcSpanAnn' a -> SrcSpan
    locA SrcSpanAnnA
    loc) (IOEnv (Env DsGblEnv DsLclEnv) (Maybe CoreRule)
     -> IOEnv (Env DsGblEnv DsLclEnv) (Maybe CoreRule))
    -> IOEnv (Env DsGblEnv DsLclEnv) (Maybe CoreRule)
    -> IOEnv (Env DsGblEnv DsLclEnv) (Maybe CoreRule)
    forall a b. (a -> b) -> a -> b
    $
        do  { let bndrs' :: [Id]
    bndrs' = [Id
    var | L SrcSpan
    _ (RuleBndr XCRuleBndr GhcTc
    _ (L SrcSpanAnnN
    _ Id
    var)) <- [GenLocated SrcSpan (RuleBndr GhcTc)]
    [LRuleBndr GhcTc]
    vars]

            ; CoreExpr
    lhs' <- GeneralFlag -> DsM CoreExpr -> DsM CoreExpr
    forall gbl lcl a.
    GeneralFlag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    unsetGOptM GeneralFlag
    Opt_EnableRewriteRules (DsM CoreExpr -> DsM CoreExpr) -> DsM CoreExpr -> DsM CoreExpr
    forall a b. (a -> b) -> a -> b
    $
                      WarningFlag -> DsM CoreExpr -> DsM CoreExpr
    forall gbl lcl a.
    WarningFlag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    unsetWOptM WarningFlag
    Opt_WarnIdentities (DsM CoreExpr -> DsM CoreExpr) -> DsM CoreExpr -> DsM CoreExpr
    forall a b. (a -> b) -> a -> b
    $
                      LHsExpr GhcTc -> DsM CoreExpr
    dsLExpr LHsExpr GhcTc
    lhs   -- Note [Desugaring RULE left hand sides]

            ; CoreExpr
    rhs' <- LHsExpr GhcTc -> DsM CoreExpr
    dsLExpr LHsExpr GhcTc
    rhs
            ; Module
    this_mod <- IOEnv (Env DsGblEnv DsLclEnv) Module
    forall (m :: * -> *). HasModule m => m Module
    getModule

            ; ([Id]
    bndrs'', CoreExpr
    lhs'', CoreExpr
    rhs'') <- [Id] -> CoreExpr -> CoreExpr -> DsM ([Id], CoreExpr, CoreExpr)
    unfold_coerce [Id]
    bndrs' CoreExpr
    lhs' CoreExpr
    rhs'

            -- Substitute the dict bindings eagerly,
            -- and take the body apart into a (f args) form
            ; DynFlags
    dflags <- IOEnv (Env DsGblEnv DsLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
            ; case DynFlags -> [Id] -> CoreExpr -> Either SDoc ([Id], Id, [CoreExpr])
    decomposeRuleLhs DynFlags
    dflags [Id]
    bndrs'' CoreExpr
    lhs'' of {
                    Left SDoc
    msg -> do { WarnReason -> SDoc -> DsM ()
    warnDs WarnReason
    NoReason SDoc
    msg; Maybe CoreRule -> IOEnv (Env DsGblEnv DsLclEnv) (Maybe CoreRule)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe CoreRule
    forall a. Maybe a
    Nothing } ;
                    Right ([Id]
    final_bndrs, Id
    fn_id, [CoreExpr]
    args) -> do

            { let is_local :: Bool
    is_local = Id -> Bool
    isLocalId Id
    fn_id
                    -- NB: isLocalId is False of implicit Ids.  This is good because
                    -- we don't want to attach rules to the bindings of implicit Ids,
                    -- because they don't show up in the bindings until just before code gen
                  fn_name :: Name
    fn_name   = Id -> Name
    idName Id
    fn_id
                  simpl_opts :: SimpleOpts
    simpl_opts = DynFlags -> SimpleOpts
    initSimpleOpts DynFlags
    dflags
                  final_rhs :: CoreExpr
    final_rhs = HasDebugCallStack => SimpleOpts -> CoreExpr -> CoreExpr
    SimpleOpts -> CoreExpr -> CoreExpr
    simpleOptExpr SimpleOpts
    simpl_opts CoreExpr
    rhs''    -- De-crap it
                  rule_name :: FastString
    rule_name = (SourceText, FastString) -> FastString
    forall a b. (a, b) -> b
    snd (GenLocated SrcSpan (SourceText, FastString)
    -> (SourceText, FastString)
    forall l e. GenLocated l e -> e
    unLoc GenLocated SrcSpan (SourceText, FastString)
    XRec GhcTc (SourceText, FastString)
    name)
                  final_bndrs_set :: VarSet
    final_bndrs_set = [Id] -> VarSet
    mkVarSet [Id]
    final_bndrs
                  arg_ids :: [Id]
    arg_ids = (Id -> Bool) -> [Id] -> [Id]
    forall a. (a -> Bool) -> [a] -> [a]
    filterOut (Id -> VarSet -> Bool
    `elemVarSet` VarSet
    final_bndrs_set) ([Id] -> [Id]) -> [Id] -> [Id]
    forall a b. (a -> b) -> a -> b
    $
                            (Id -> Bool) -> [CoreExpr] -> [Id]
    exprsSomeFreeVarsList Id -> Bool
    isId [CoreExpr]
    args

            ; CoreRule
    rule <- Module
    -> Bool
    -> FastString
    -> Activation
    -> Name
    -> [Id]
    -> [CoreExpr]
    -> CoreExpr
    -> DsM CoreRule
    dsMkUserRule Module
    this_mod Bool
    is_local
                             FastString
    rule_name Activation
    rule_act Name
    fn_name [Id]
    final_bndrs [CoreExpr]
    args
                             CoreExpr
    final_rhs
            ; Bool -> DsM () -> DsM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (WarningFlag -> DynFlags -> Bool
    wopt WarningFlag
    Opt_WarnInlineRuleShadowing DynFlags
    dflags) (DsM () -> DsM ()) -> DsM () -> DsM ()
    forall a b. (a -> b) -> a -> b
    $
              FastString -> Activation -> Id -> [Id] -> DsM ()
    warnRuleShadowing FastString
    rule_name Activation
    rule_act Id
    fn_id [Id]
    arg_ids

            ; Maybe CoreRule -> IOEnv (Env DsGblEnv DsLclEnv) (Maybe CoreRule)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CoreRule -> Maybe CoreRule
    forall a. a -> Maybe a
    Just CoreRule
    rule)
            } } }

    warnRuleShadowing :: RuleName -> Activation -> Id -> [Id] -> DsM ()
    -- See Note [Rules and inlining/other rules]
    warnRuleShadowing :: FastString -> Activation -> Id -> [Id] -> DsM ()
    warnRuleShadowing FastString
    rule_name Activation
    rule_act Id
    fn_id [Id]
    arg_ids
      = do { Bool -> Id -> DsM ()
    check Bool
    False Id
    fn_id    -- We often have multiple rules for the same Id in a
                                  -- module. Maybe we should check that they don't overlap
                                  -- but currently we don't
           ; (Id -> DsM ()) -> [Id] -> DsM ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Bool -> Id -> DsM ()
    check Bool
    True) [Id]
    arg_ids }
      where
        check :: Bool -> Id -> DsM ()
    check Bool
    check_rules_too Id
    lhs_id
          | Id -> Bool
    isLocalId Id
    lhs_id Bool -> Bool -> Bool
    || Unfolding -> Bool
    canUnfold (Id -> Unfolding
    idUnfolding Id
    lhs_id)
                           -- If imported with no unfolding, no worries
          , Id -> Activation
    idInlineActivation Id
    lhs_id Activation -> Activation -> Bool
    `competesWith` Activation
    rule_act
          = WarnReason -> SDoc -> DsM ()
    warnDs (WarningFlag -> WarnReason
    Reason WarningFlag
    Opt_WarnInlineRuleShadowing)
                   ([SDoc] -> SDoc
    vcat [ SDoc -> Int -> SDoc -> SDoc
    hang (FilePath -> SDoc
    text FilePath
    "Rule" SDoc -> SDoc -> SDoc
    <+> FastString -> SDoc
    pprRuleName FastString
    rule_name
                                   SDoc -> SDoc -> SDoc
    <+> FilePath -> SDoc
    text FilePath
    "may never fire")
                                Int
    2 (FilePath -> SDoc
    text FilePath
    "because" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Id -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Id
    lhs_id)
                                   SDoc -> SDoc -> SDoc
    <+> FilePath -> SDoc
    text FilePath
    "might inline first")
                         , FilePath -> SDoc
    text FilePath
    "Probable fix: add an INLINE[n] or NOINLINE[n] pragma for"
                           SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Id -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Id
    lhs_id)
                         , SDoc -> SDoc
    whenPprDebug (Activation -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (Id -> Activation
    idInlineActivation Id
    lhs_id) SDoc -> SDoc -> SDoc
    $$ Activation -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Activation
    rule_act) ])

          | Bool
    check_rules_too
          , CoreRule
    bad_rule : [CoreRule]
    _ <- Id -> [CoreRule]
    get_bad_rules Id
    lhs_id
          = WarnReason -> SDoc -> DsM ()
    warnDs (WarningFlag -> WarnReason
    Reason WarningFlag
    Opt_WarnInlineRuleShadowing)
                   ([SDoc] -> SDoc
    vcat [ SDoc -> Int -> SDoc -> SDoc
    hang (FilePath -> SDoc
    text FilePath
    "Rule" SDoc -> SDoc -> SDoc
    <+> FastString -> SDoc
    pprRuleName FastString
    rule_name
                                   SDoc -> SDoc -> SDoc
    <+> FilePath -> SDoc
    text FilePath
    "may never fire")
                                Int
    2 (FilePath -> SDoc
    text FilePath
    "because rule" SDoc -> SDoc -> SDoc
    <+> FastString -> SDoc
    pprRuleName (CoreRule -> FastString
    ruleName CoreRule
    bad_rule)
                                   SDoc -> SDoc -> SDoc
    <+> FilePath -> SDoc
    text FilePath
    "for"SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Id -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Id
    lhs_id)
                                   SDoc -> SDoc -> SDoc
    <+> FilePath -> SDoc
    text FilePath
    "might fire first")
                          , FilePath -> SDoc
    text FilePath
    "Probable fix: add phase [n] or [~n] to the competing rule"
                          , SDoc -> SDoc
    whenPprDebug (CoreRule -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CoreRule
    bad_rule) ])

          | Bool
    otherwise
          = () -> DsM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

        get_bad_rules :: Id -> [CoreRule]
    get_bad_rules Id
    lhs_id
          = [ CoreRule
    rule | CoreRule
    rule <- Id -> [CoreRule]
    idCoreRules Id
    lhs_id
                   , CoreRule -> Activation
    ruleActivation CoreRule
    rule Activation -> Activation -> Bool
    `competesWith` Activation
    rule_act ]

    -- See Note [Desugaring coerce as cast]
    unfold_coerce :: [Id] -> CoreExpr -> CoreExpr -> DsM ([Var], CoreExpr, CoreExpr)
    unfold_coerce :: [Id] -> CoreExpr -> CoreExpr -> DsM ([Id], CoreExpr, CoreExpr)
    unfold_coerce [Id]
    bndrs CoreExpr
    lhs CoreExpr
    rhs = do
        ([Id]
    bndrs', CoreExpr -> CoreExpr
    wrap) <- [Id] -> DsM ([Id], CoreExpr -> CoreExpr)
    go [Id]
    bndrs
        ([Id], CoreExpr, CoreExpr) -> DsM ([Id], CoreExpr, CoreExpr)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Id]
    bndrs', CoreExpr -> CoreExpr
    wrap CoreExpr
    lhs, CoreExpr -> CoreExpr
    wrap CoreExpr
    rhs)
      where
        go :: [Id] -> DsM ([Id], CoreExpr -> CoreExpr)
        go :: [Id] -> DsM ([Id], CoreExpr -> CoreExpr)
    go []     = ([Id], CoreExpr -> CoreExpr) -> DsM ([Id], CoreExpr -> CoreExpr)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([], CoreExpr -> CoreExpr
    forall a. a -> a
    id)
        go (Id
    v:[Id]
    vs)
            | Just (TyCon
    tc, [Type
    k, Type
    t1, Type
    t2]) <- HasDebugCallStack => Type -> Maybe (TyCon, [Type])
    Type -> Maybe (TyCon, [Type])
    splitTyConApp_maybe (Id -> Type
    idType Id
    v)
            , TyCon
    tc TyCon -> Unique -> Bool
    forall a. Uniquable a => a -> Unique -> Bool
    `hasKey` Unique
    coercibleTyConKey = do
                Unique
    u <- TcRnIf DsGblEnv DsLclEnv Unique
    forall gbl lcl. TcRnIf gbl lcl Unique
    newUnique

                let ty' :: Type
    ty' = TyCon -> [Type] -> Type
    mkTyConApp TyCon
    eqReprPrimTyCon [Type
    k, Type
    k, Type
    t1, Type
    t2]
                    v' :: Id
    v'  = Name -> Type -> Id
    mkLocalCoVar
                            ((OccName -> OccName) -> Unique -> Name -> Name
    mkDerivedInternalName OccName -> OccName
    mkRepEqOcc Unique
    u (Id -> Name
    forall a. NamedThing a => a -> Name
    getName Id
    v)) Type
    ty'
                    box :: CoreExpr
    box = Id -> CoreExpr
    forall b. Id -> Expr b
    Var (DataCon -> Id
    dataConWrapId DataCon
    coercibleDataCon) CoreExpr -> [Type] -> CoreExpr
    forall b. Expr b -> [Type] -> Expr b
    `mkTyApps`
                          [Type
    k, Type
    t1, Type
    t2] CoreExpr -> CoreExpr -> CoreExpr
    forall b. Expr b -> Expr b -> Expr b
    `App`
                          Coercion -> CoreExpr
    forall b. Coercion -> Expr b
    Coercion (Id -> Coercion
    mkCoVarCo Id
    v')

                ([Id]
    bndrs, CoreExpr -> CoreExpr
    wrap) <- [Id] -> DsM ([Id], CoreExpr -> CoreExpr)
    go [Id]
    vs
                ([Id], CoreExpr -> CoreExpr) -> DsM ([Id], CoreExpr -> CoreExpr)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Id
    v'Id -> [Id] -> [Id]
    forall a. a -> [a] -> [a]
    :[Id]
    bndrs, CoreBind -> CoreExpr -> CoreExpr
    mkCoreLet (Id -> CoreExpr -> CoreBind
    forall b. b -> Expr b -> Bind b
    NonRec Id
    v CoreExpr
    box) (CoreExpr -> CoreExpr)
    -> (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CoreExpr -> CoreExpr
    wrap)
            | Bool
    otherwise = do
                ([Id]
    bndrs,CoreExpr -> CoreExpr
    wrap) <- [Id] -> DsM ([Id], CoreExpr -> CoreExpr)
    go [Id]
    vs
                ([Id], CoreExpr -> CoreExpr) -> DsM ([Id], CoreExpr -> CoreExpr)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Id
    vId -> [Id] -> [Id]
    forall a. a -> [a] -> [a]
    :[Id]
    bndrs, CoreExpr -> CoreExpr
    wrap)

    {- Note [Desugaring RULE left hand sides]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    For the LHS of a RULE we do *not* want to desugar
        [x]   to    build (\cn. x `c` n)
    We want to leave explicit lists simply as chains
    of cons's. We can achieve that slightly indirectly by
    switching off EnableRewriteRules.  See GHC.HsToCore.Expr.dsExplicitList.

    That keeps the desugaring of list comprehensions simple too.

    Nor do we want to warn of conversion identities on the LHS;
    the rule is precisely to optimise them:
      {-# RULES "fromRational/id" fromRational = id :: Rational -> Rational #-}

    Note [Desugaring coerce as cast]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    We want the user to express a rule saying roughly “mapping a coercion over a
    list can be replaced by a coercion”. But the cast operator of Core (▷) cannot
    be written in Haskell. So we use `coerce` for that (#2110). The user writes
        map coerce = coerce
    as a RULE, and this optimizes any kind of mapped' casts away, including `map
    MkNewtype`.

    For that we replace any forall'ed `c :: Coercible a b` value in a RULE by
    corresponding `co :: a ~#R b` and wrap the LHS and the RHS in
    `let c = MkCoercible co in ...`. This is later simplified to the desired form
    by simpleOptExpr (for the LHS) resp. the simplifiers (for the RHS).
    See also Note [Getting the map/coerce RULE to work] in GHC.Core.SimpleOpt.

    Note [Rules and inlining/other rules]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    If you have
      f x = ...
      g x = ...
      {-# RULES "rule-for-f" forall x. f (g x) = ... #-}
    then there's a good chance that in a potential rule redex
        ...f (g e)...
    then 'f' or 'g' will inline before the rule can fire.  Solution: add an
    INLINE [n] or NOINLINE [n] pragma to 'f' and 'g'.

    Note that this applies to all the free variables on the LHS, both the
    main function and things in its arguments.

    We also check if there are Ids on the LHS that have competing RULES.
    In the above example, suppose we had
      {-# RULES "rule-for-g" forally. g [y] = ... #-}
    Then "rule-for-f" and "rule-for-g" would compete.  Better to add phase
    control, so "rule-for-f" has a chance to fire before "rule-for-g" becomes
    active; or perhaps after "rule-for-g" has become inactive. This is checked
    by 'competesWith'

    Class methods have a built-in RULE to select the method from the dictionary,
    so you can't change the phase on this.  That makes id very dubious to
    match on class methods in RULE lhs's.   See #10595.   I'm not happy
    about this. For example in Control.Arrow we have

    {-# RULES "compose/arr"   forall f g .
                              (arr f) . (arr g) = arr (f . g) #-}

    and similar, which will elicit exactly these warnings, and risk never
    firing.  But it's not clear what to do instead.  We could make the
    class method rules inactive in phase 2, but that would delay when
    subsequent transformations could fire.
    -}

    {-
    ************************************************************************
    *                                                                      *
    *              Magic definitions
    *                                                                      *
    ************************************************************************

    Note [Patching magic definitions]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    We sometimes need to have access to defined Ids in pure contexts. Usually, we
    simply "wire in" these entities, as we do for types in GHC.Builtin.Types and for Ids
    in GHC.Types.Id.Make. See Note [Wired-in Ids] in GHC.Types.Id.Make.

    However, it is sometimes *much* easier to define entities in Haskell,
    even if we need pure access; note that wiring-in an Id requires all
    entities used in its definition *also* to be wired in, transitively
    and recursively.  This can be a huge pain.  The little trick
    documented here allows us to have the best of both worlds.

    Motivating example: unsafeCoerce#. See [Wiring in unsafeCoerce#] for the
    details.

    The trick is to

    * Define the known-key Id in a library module, with a stub definition,
         unsafeCoerce# :: ..a suitable type signature..
         unsafeCoerce# = error "urk"

    * Magically over-write its RHS here in the desugarer, in
      patchMagicDefns.  This update can be done with full access to the
      DsM monad, and hence, dsLookupGlobal. We thus do not have to wire in
      all the entities used internally, a potentially big win.

      This step should not change the Name or type of the Id.

    Because an Id stores its unfolding directly (as opposed to in the second
    component of a (Id, CoreExpr) pair), the patchMagicDefns function returns
    a new Id to use.

    Here are the moving parts:

    - patchMagicDefns checks whether we're in a module with magic definitions;
      if so, patch the magic definitions. If not, skip.

    - patchMagicDefn just looks up in an environment to find a magic defn and
      patches it in.

    - magicDefns holds the magic definitions.

    - magicDefnsEnv allows for quick access to magicDefns.

    - magicDefnModules, built also from magicDefns, contains the modules that
      need careful attention.

    Note [Wiring in unsafeCoerce#]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    We want (Haskell)

      unsafeCoerce# :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep)
                              (a :: TYPE r1) (b :: TYPE r2).
                       a -> b
      unsafeCoerce# x = case unsafeEqualityProof @r1 @r2 of
        UnsafeRefl -> case unsafeEqualityProof @a @b of
          UnsafeRefl -> x

    or (Core)

      unsafeCoerce# :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep)
                              (a :: TYPE r1) (b :: TYPE r2).
                       a -> b
      unsafeCoerce# = \ @r1 @r2 @a @b (x :: a).
        case unsafeEqualityProof @RuntimeRep @r1 @r2 of
          UnsafeRefl (co1 :: r1 ~# r2) ->
            case unsafeEqualityProof @(TYPE r2) @(a |> TYPE co1) @b of
              UnsafeRefl (co2 :: (a |> TYPE co1) ~# b) ->
                (x |> (GRefl :: a ~# (a |> TYPE co1)) ; co2)

    It looks like we can write this in Haskell directly, but we can't:
    the levity polymorphism checks defeat us. Note that `x` is a levity-
    polymorphic variable. So we must wire it in with a compulsory
    unfolding, like other levity-polymorphic primops.

    The challenge is that UnsafeEquality is a GADT, and wiring in a GADT
    is *hard*: it has a worker separate from its wrapper, with all manner
    of complications. (Simon and Richard tried to do this. We nearly wept.)

    The solution is documented in Note [Patching magic definitions]. We now
    simply look up the UnsafeEquality GADT in the environment, leaving us
    only to wire in unsafeCoerce# directly.

    Wrinkle: see Note [Always expose compulsory unfoldings] in GHC.Iface.Tidy
    -}

    -- Postcondition: the returned Ids are in one-to-one correspondence as the
    -- input Ids; each returned Id has the same type as the passed-in Id.
    -- See Note [Patching magic definitions]
    patchMagicDefns :: OrdList (Id,CoreExpr)
                    -> DsM (OrdList (Id,CoreExpr))
    patchMagicDefns :: OrdList Binding -> DsM (OrdList Binding)
    patchMagicDefns OrdList Binding
    pairs
      -- optimization: check whether we're in a magic module before looking
      -- at all the ids
      = do { Module
    this_mod <- IOEnv (Env DsGblEnv DsLclEnv) Module
    forall (m :: * -> *). HasModule m => m Module
    getModule
           ; if Module
    this_mod Module -> ModuleSet -> Bool
    `elemModuleSet` ModuleSet
    magicDefnModules
             then (Binding -> IOEnv (Env DsGblEnv DsLclEnv) Binding)
    -> OrdList Binding -> DsM (OrdList Binding)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse Binding -> IOEnv (Env DsGblEnv DsLclEnv) Binding
    patchMagicDefn OrdList Binding
    pairs
             else OrdList Binding -> DsM (OrdList Binding)
    forall (m :: * -> *) a. Monad m => a -> m a
    return OrdList Binding
    pairs }

    patchMagicDefn :: (Id, CoreExpr) -> DsM (Id, CoreExpr)
    patchMagicDefn :: Binding -> IOEnv (Env DsGblEnv DsLclEnv) Binding
    patchMagicDefn orig_pair :: Binding
    orig_pair@(Id
    orig_id, CoreExpr
    orig_rhs)
      | Just Id -> CoreExpr -> IOEnv (Env DsGblEnv DsLclEnv) Binding
    mk_magic_pair <- NameEnv (Id -> CoreExpr -> IOEnv (Env DsGblEnv DsLclEnv) Binding)
    -> Name
    -> Maybe (Id -> CoreExpr -> IOEnv (Env DsGblEnv DsLclEnv) Binding)
    forall a. NameEnv a -> Name -> Maybe a
    lookupNameEnv NameEnv (Id -> CoreExpr -> IOEnv (Env DsGblEnv DsLclEnv) Binding)
    magicDefnsEnv (Id -> Name
    forall a. NamedThing a => a -> Name
    getName Id
    orig_id)
      = do { magic_pair :: Binding
    magic_pair@(Id
    magic_id, CoreExpr
    _) <- Id -> CoreExpr -> IOEnv (Env DsGblEnv DsLclEnv) Binding
    mk_magic_pair Id
    orig_id CoreExpr
    orig_rhs

           -- Patching should not change the Name or the type of the Id
           ; MASSERT( getUnique magic_id == getUnique orig_id )
           ; MASSERT( varType magic_id `eqType` varType orig_id )

           ; Binding -> IOEnv (Env DsGblEnv DsLclEnv) Binding
    forall (m :: * -> *) a. Monad m => a -> m a
    return Binding
    magic_pair }
      | Bool
    otherwise
      = Binding -> IOEnv (Env DsGblEnv DsLclEnv) Binding
    forall (m :: * -> *) a. Monad m => a -> m a
    return Binding
    orig_pair

    magicDefns :: [(Name,    Id -> CoreExpr     -- old Id and RHS
                          -> DsM (Id, CoreExpr) -- new Id and RHS
                   )]
    magicDefns :: [(Name, Id -> CoreExpr -> IOEnv (Env DsGblEnv DsLclEnv) Binding)]
    magicDefns = [ (Name
    unsafeCoercePrimName, Id -> CoreExpr -> IOEnv (Env DsGblEnv DsLclEnv) Binding
    mkUnsafeCoercePrimPair) ]

    magicDefnsEnv :: NameEnv (Id -> CoreExpr -> DsM (Id, CoreExpr))
    magicDefnsEnv :: NameEnv (Id -> CoreExpr -> IOEnv (Env DsGblEnv DsLclEnv) Binding)
    magicDefnsEnv = [(Name, Id -> CoreExpr -> IOEnv (Env DsGblEnv DsLclEnv) Binding)]
    -> NameEnv
         (Id -> CoreExpr -> IOEnv (Env DsGblEnv DsLclEnv) Binding)
    forall a. [(Name, a)] -> NameEnv a
    mkNameEnv [(Name, Id -> CoreExpr -> IOEnv (Env DsGblEnv DsLclEnv) Binding)]
    magicDefns

    magicDefnModules :: ModuleSet
    magicDefnModules :: ModuleSet
    magicDefnModules = [Module] -> ModuleSet
    mkModuleSet ([Module] -> ModuleSet) -> [Module] -> ModuleSet
    forall a b. (a -> b) -> a -> b
    $ ((Name, Id -> CoreExpr -> IOEnv (Env DsGblEnv DsLclEnv) Binding)
     -> Module)
    -> [(Name,
         Id -> CoreExpr -> IOEnv (Env DsGblEnv DsLclEnv) Binding)]
    -> [Module]
    forall a b. (a -> b) -> [a] -> [b]
    map (HasDebugCallStack => Name -> Module
    Name -> Module
    nameModule (Name -> Module)
    -> ((Name, Id -> CoreExpr -> IOEnv (Env DsGblEnv DsLclEnv) Binding)
        -> Name)
    -> (Name, Id -> CoreExpr -> IOEnv (Env DsGblEnv DsLclEnv) Binding)
    -> Module
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> Name
    forall a. NamedThing a => a -> Name
    getName (Name -> Name)
    -> ((Name, Id -> CoreExpr -> IOEnv (Env DsGblEnv DsLclEnv) Binding)
        -> Name)
    -> (Name, Id -> CoreExpr -> IOEnv (Env DsGblEnv DsLclEnv) Binding)
    -> Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Name, Id -> CoreExpr -> IOEnv (Env DsGblEnv DsLclEnv) Binding)
    -> Name
    forall a b. (a, b) -> a
    fst) [(Name, Id -> CoreExpr -> IOEnv (Env DsGblEnv DsLclEnv) Binding)]
    magicDefns

    mkUnsafeCoercePrimPair :: Id -> CoreExpr -> DsM (Id, CoreExpr)
    -- See Note [Wiring in unsafeCoerce#] for the defn we are creating here
    mkUnsafeCoercePrimPair :: Id -> CoreExpr -> IOEnv (Env DsGblEnv DsLclEnv) Binding
    mkUnsafeCoercePrimPair Id
    _old_id CoreExpr
    old_expr
      = do { Id
    unsafe_equality_proof_id <- Name -> DsM Id
    dsLookupGlobalId Name
    unsafeEqualityProofName
           ; TyCon
    unsafe_equality_tc       <- Name -> DsM TyCon
    dsLookupTyCon Name
    unsafeEqualityTyConName

           ; let [DataCon
    unsafe_refl_data_con] = TyCon -> [DataCon]
    tyConDataCons TyCon
    unsafe_equality_tc

                 rhs :: CoreExpr
    rhs = [Id] -> CoreExpr -> CoreExpr
    forall b. [b] -> Expr b -> Expr b
    mkLams [ Id
    runtimeRep1TyVar, Id
    runtimeRep2TyVar
                              , Id
    openAlphaTyVar, Id
    openBetaTyVar
                              , Id
    x ] (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $
                       CoreExpr -> Id -> AltCon -> [Id] -> CoreExpr -> CoreExpr
    mkSingleAltCase CoreExpr
    scrut1
                                       (Type -> Type -> Id
    mkWildValBinder Type
    Many Type
    scrut1_ty)
                                       (DataCon -> AltCon
    DataAlt DataCon
    unsafe_refl_data_con)
                                       [Id
    rr_cv] (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $
                       CoreExpr -> Id -> AltCon -> [Id] -> CoreExpr -> CoreExpr
    mkSingleAltCase CoreExpr
    scrut2
                                       (Type -> Type -> Id
    mkWildValBinder Type
    Many Type
    scrut2_ty)
                                       (DataCon -> AltCon
    DataAlt DataCon
    unsafe_refl_data_con)
                                       [Id
    ab_cv] (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $
                       Id -> CoreExpr
    forall b. Id -> Expr b
    Var Id
    x CoreExpr -> Coercion -> CoreExpr
    `mkCast` Coercion
    x_co

                 [Id
    x, Id
    rr_cv, Id
    ab_cv] = [Type] -> [Id]
    mkTemplateLocals
                   [ Type
    openAlphaTy -- x :: a
                   , Type
    rr_cv_ty    -- rr_cv :: r1 ~# r2
                   , Type
    ab_cv_ty    -- ab_cv :: (alpha |> alpha_co ~# beta)
                   ]

                 -- Returns (scrutinee, scrutinee type, type of covar in AltCon)
                 unsafe_equality :: Type -> Type -> Type -> (CoreExpr, Type, Type)
    unsafe_equality Type
    k Type
    a Type
    b
                   = ( CoreExpr -> [Type] -> CoreExpr
    forall b. Expr b -> [Type] -> Expr b
    mkTyApps (Id -> CoreExpr
    forall b. Id -> Expr b
    Var Id
    unsafe_equality_proof_id) [Type
    k,Type
    b,Type
    a]
                     , TyCon -> [Type] -> Type
    mkTyConApp TyCon
    unsafe_equality_tc [Type
    k,Type
    b,Type
    a]
                     , Type -> Type -> Type -> Type -> Type
    mkHeteroPrimEqPred Type
    k Type
    k Type
    a Type
    b
                     )
                 -- NB: UnsafeRefl :: (b ~# a) -> UnsafeEquality a b, so we have to
                 -- carefully swap the arguments above

                 (CoreExpr
    scrut1, Type
    scrut1_ty, Type
    rr_cv_ty) = Type -> Type -> Type -> (CoreExpr, Type, Type)
    unsafe_equality Type
    runtimeRepTy
                                                                 Type
    runtimeRep1Ty
                                                                 Type
    runtimeRep2Ty
                 (CoreExpr
    scrut2, Type
    scrut2_ty, Type
    ab_cv_ty) = Type -> Type -> Type -> (CoreExpr, Type, Type)
    unsafe_equality (Type -> Type
    tYPE Type
    runtimeRep2Ty)
                                                                 (Type
    openAlphaTy Type -> Coercion -> Type
    `mkCastTy` Coercion
    alpha_co)
                                                                 Type
    openBetaTy

                 -- alpha_co :: TYPE r1 ~# TYPE r2
                 -- alpha_co = TYPE rr_cv
                 alpha_co :: Coercion
    alpha_co = HasDebugCallStack => Role -> TyCon -> [Coercion] -> Coercion
    Role -> TyCon -> [Coercion] -> Coercion
    mkTyConAppCo Role
    Nominal TyCon
    tYPETyCon [Id -> Coercion
    mkCoVarCo Id
    rr_cv]

                 -- x_co :: alpha ~R# beta
                 x_co :: Coercion
    x_co = Role -> Type -> MCoercionN -> Coercion
    mkGReflCo Role
    Representational Type
    openAlphaTy (Coercion -> MCoercionN
    MCo Coercion
    alpha_co) Coercion -> Coercion -> Coercion
    `mkTransCo`
                        HasDebugCallStack => Coercion -> Coercion
    Coercion -> Coercion
    mkSubCo (Id -> Coercion
    mkCoVarCo Id
    ab_cv)

                 info :: IdInfo
    info = IdInfo
    noCafIdInfo IdInfo -> InlinePragma -> IdInfo
    `setInlinePragInfo` InlinePragma
    alwaysInlinePragma
                                    IdInfo -> Unfolding -> IdInfo
    `setUnfoldingInfo` CoreExpr -> Unfolding
    mkCompulsoryUnfolding' CoreExpr
    rhs

                 ty :: Type
    ty = [Id] -> Type -> Type
    mkSpecForAllTys [ Id
    runtimeRep1TyVar, Id
    runtimeRep2TyVar
                                      , Id
    openAlphaTyVar, Id
    openBetaTyVar ] (Type -> Type) -> Type -> Type
    forall a b. (a -> b) -> a -> b
    $
                      Type -> Type -> Type
    mkVisFunTyMany Type
    openAlphaTy Type
    openBetaTy

                 id :: Id
    id   = Name -> Type -> Id
    mkExportedVanillaId Name
    unsafeCoercePrimName Type
    ty Id -> IdInfo -> Id
    `setIdInfo` IdInfo
    info
           ; Binding -> IOEnv (Env DsGblEnv DsLclEnv) Binding
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Id
    id, CoreExpr
    old_expr) }