compiler/GHC/Driver/Config/Tidy.hs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62

{-# 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.Session
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 hsc_env = do
  let dflags = hsc_dflags hsc_env
  static_ptr_opts <- if not (xopt LangExt.StaticPointers dflags)
    then pure Nothing
    else Just <$> initStaticPtrOpts 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
    }

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

  mk_string <- getMkStringIds (fmap tyThingId . lookupGlobal 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
    }