    {-# LANGUAGE MultiWayIf #-}
    {-# LANGUAGE LambdaCase #-}

    module GHC.Driver.Config.Tidy
      ( initTidyOpts
      , initStaticPtrOpts
      )
    where

    import GHC.Prelude

    import GHC.Iface.Tidy
    import GHC.Iface.Tidy.StaticPtrTable

    import GHC.Driver.DynFlags
    import GHC.Driver.Env
    import GHC.Driver.Backend

    import GHC.Core.Make (getMkStringIds)
    import GHC.Builtin.Names
    import GHC.Tc.Utils.Env (lookupGlobal)
    import GHC.Types.TyThing
    import GHC.Platform.Ways

    import qualified GHC.LanguageExtensions as LangExt

    initTidyOpts :: HscEnv -> IO TidyOpts
    initTidyOpts :: HscEnv -> IO TidyOpts
    initTidyOpts HscEnv
    hsc_env = do
      let dflags :: DynFlags
    dflags = HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env
      static_ptr_opts <- if Bool -> Bool
    not (Extension -> DynFlags -> Bool
    xopt Extension
    LangExt.StaticPointers DynFlags
    dflags)
        then Maybe StaticPtrOpts -> IO (Maybe StaticPtrOpts)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe StaticPtrOpts
    forall a. Maybe a
    Nothing
        else StaticPtrOpts -> Maybe StaticPtrOpts
    forall a. a -> Maybe a
    Just (StaticPtrOpts -> Maybe StaticPtrOpts)
    -> IO StaticPtrOpts -> IO (Maybe StaticPtrOpts)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> HscEnv -> IO StaticPtrOpts
    initStaticPtrOpts HscEnv
    hsc_env
      pure $ TidyOpts
        { opt_name_cache        = hsc_NC hsc_env
        , opt_collect_ccs       = ways dflags `hasWay` WayProf
        , opt_unfolding_opts    = unfoldingOpts dflags
        , opt_expose_unfoldings = if | gopt Opt_OmitInterfacePragmas dflags -> ExposeNone
                                     | gopt Opt_ExposeAllUnfoldings dflags  -> ExposeAll
                                     | otherwise                            -> ExposeSome
        , opt_expose_rules      = not (gopt Opt_OmitInterfacePragmas dflags)
        , opt_trim_ids          = gopt Opt_OmitInterfacePragmas dflags
        , opt_static_ptr_opts   = static_ptr_opts
        , opt_keep_auto_rules   = gopt Opt_KeepAutoRules dflags
        }

    initStaticPtrOpts :: HscEnv -> IO StaticPtrOpts
    initStaticPtrOpts :: HscEnv -> IO StaticPtrOpts
    initStaticPtrOpts HscEnv
    hsc_env = do
      let dflags :: DynFlags
    dflags = HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env

      mk_string <- (Name -> IO Id) -> IO MkStringIds
    forall (m :: * -> *).
    Applicative m =>
    (Name -> m Id) -> m MkStringIds
    getMkStringIds ((TyThing -> Id) -> IO TyThing -> IO Id
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap HasDebugCallStack => TyThing -> Id
    TyThing -> Id
    tyThingId (IO TyThing -> IO Id) -> (Name -> IO TyThing) -> Name -> IO Id
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HscEnv -> Name -> IO TyThing
    lookupGlobal HscEnv
    hsc_env )
      static_ptr_info_datacon <- tyThingDataCon <$> lookupGlobal hsc_env staticPtrInfoDataConName
      static_ptr_datacon      <- tyThingDataCon <$> lookupGlobal hsc_env staticPtrDataConName

      pure $ StaticPtrOpts
        { opt_platform = targetPlatform dflags

          -- If we are compiling for the interpreter we will insert any necessary
          -- SPT entries dynamically, otherwise we add a C stub to do so
        , opt_gen_cstub = backendWritesFiles (backend dflags)
        , opt_mk_string = mk_string
        , opt_static_ptr_info_datacon = static_ptr_info_datacon
        , opt_static_ptr_datacon      = static_ptr_datacon
        }