    {-# LANGUAGE CPP #-}

    -- | Ways
    --
    -- The central concept of a "way" is that all objects in a given
    -- program must be compiled in the same "way". Certain options change
    -- parameters of the virtual machine, eg. profiling adds an extra word
    -- to the object header, so profiling objects cannot be linked with
    -- non-profiling objects.
    --
    -- After parsing the command-line options, we determine which "way" we
    -- are building - this might be a combination way, eg. profiling+threaded.
    --
    -- There are two kinds of ways:
    --    - RTS only: only affect the runtime system (RTS) and don't affect code
    --    generation (e.g. threaded, debug)
    --    - Full ways: affect code generation and the RTS (e.g. profiling, dynamic
    --    linking)
    --
    -- We then find the "build-tag" associated with this way, and this
    -- becomes the suffix used to find .hi files and libraries used in
    -- this compilation.
    module GHC.Platform.Ways
       ( Way(..)
       , Ways
       , hasWay
       , hasNotWay
       , addWay
       , removeWay
       , allowed_combination
       , wayGeneralFlags
       , wayUnsetGeneralFlags
       , wayOptc
       , wayOptl
       , wayOptP
       , wayDesc
       , wayRTSOnly
       , wayTag
       , waysTag
       , waysBuildTag
       , fullWays
       , rtsWays
       -- * Host GHC ways
       , hostWays
       , hostFullWays
       , hostIsProfiled
       , hostIsDynamic
       , hostIsThreaded
       , hostIsDebugged
       , hostIsTracing
       )
    where

    import GHC.Prelude
    import GHC.Platform
    import GHC.Driver.Flags

    import qualified Data.Set as Set
    import Data.Set (Set)
    import Data.List (intersperse)

    -- | A way
    --
    -- Don't change the constructor order as it us used by `waysTag` to create a
    -- unique tag (e.g. thr_debug_p) which is expected by other tools (e.g. Cabal).
    data Way
      = WayCustom String -- ^ for GHC API clients building custom variants
      | WayThreaded      -- ^ (RTS only) Multithreaded runtime system
      | WayDebug         -- ^ Debugging, enable trace messages and extra checks
      | WayProf          -- ^ Profiling, enable cost-centre stacks and profiling reports
      | WayTracing       -- ^ (RTS only) enable event logging (tracing)
      | WayDyn           -- ^ Dynamic linking
      deriving (Way -> Way -> Bool
    (Way -> Way -> Bool) -> (Way -> Way -> Bool) -> Eq Way
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Way -> Way -> Bool
    == :: Way -> Way -> Bool
    $c/= :: Way -> Way -> Bool
    /= :: Way -> Way -> Bool
    Eq, Eq Way
    Eq Way
    -> (Way -> Way -> Ordering)
    -> (Way -> Way -> Bool)
    -> (Way -> Way -> Bool)
    -> (Way -> Way -> Bool)
    -> (Way -> Way -> Bool)
    -> (Way -> Way -> Way)
    -> (Way -> Way -> Way)
    -> Ord Way
    Way -> Way -> Bool
    Way -> Way -> Ordering
    Way -> Way -> Way
    forall a.
    Eq a
    -> (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: Way -> Way -> Ordering
    compare :: Way -> Way -> Ordering
    $c< :: Way -> Way -> Bool
    < :: Way -> Way -> Bool
    $c<= :: Way -> Way -> Bool
    <= :: Way -> Way -> Bool
    $c> :: Way -> Way -> Bool
    > :: Way -> Way -> Bool
    $c>= :: Way -> Way -> Bool
    >= :: Way -> Way -> Bool
    $cmax :: Way -> Way -> Way
    max :: Way -> Way -> Way
    $cmin :: Way -> Way -> Way
    min :: Way -> Way -> Way
    Ord, Int -> Way -> ShowS
    [Way] -> ShowS
    Way -> String
    (Int -> Way -> ShowS)
    -> (Way -> String) -> ([Way] -> ShowS) -> Show Way
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Way -> ShowS
    showsPrec :: Int -> Way -> ShowS
    $cshow :: Way -> String
    show :: Way -> String
    $cshowList :: [Way] -> ShowS
    showList :: [Way] -> ShowS
    Show, ReadPrec [Way]
    ReadPrec Way
    Int -> ReadS Way
    ReadS [Way]
    (Int -> ReadS Way)
    -> ReadS [Way] -> ReadPrec Way -> ReadPrec [Way] -> Read Way
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS Way
    readsPrec :: Int -> ReadS Way
    $creadList :: ReadS [Way]
    readList :: ReadS [Way]
    $creadPrec :: ReadPrec Way
    readPrec :: ReadPrec Way
    $creadListPrec :: ReadPrec [Way]
    readListPrec :: ReadPrec [Way]
    Read)

    type Ways = Set Way

    -- | Test if a way is enabled
    hasWay :: Ways -> Way -> Bool
    hasWay :: Ways -> Way -> Bool
    hasWay Ways
    ws Way
    w = Way -> Ways -> Bool
    forall a. Ord a => a -> Set a -> Bool
    Set.member Way
    w Ways
    ws

    -- | Test if a way is not enabled
    hasNotWay :: Ways -> Way -> Bool
    hasNotWay :: Ways -> Way -> Bool
    hasNotWay Ways
    ws Way
    w = Way -> Ways -> Bool
    forall a. Ord a => a -> Set a -> Bool
    Set.notMember Way
    w Ways
    ws

    -- | Add a way
    addWay :: Way -> Ways -> Ways
    addWay :: Way -> Ways -> Ways
    addWay = Way -> Ways -> Ways
    forall a. Ord a => a -> Set a -> Set a
    Set.insert

    -- | Remove a way
    removeWay :: Way -> Ways -> Ways
    removeWay :: Way -> Ways -> Ways
    removeWay = Way -> Ways -> Ways
    forall a. Ord a => a -> Set a -> Set a
    Set.delete

    -- | Check if a combination of ways is allowed
    allowed_combination :: Ways -> Bool
    allowed_combination :: Ways -> Bool
    allowed_combination Ways
    ways = Bool -> Bool
    not Bool
    disallowed
      where
       disallowed :: Bool
    disallowed = [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    or [ Ways -> Way -> Bool
    hasWay Ways
    ways Way
    x Bool -> Bool -> Bool
    && Ways -> Way -> Bool
    hasWay Ways
    ways Way
    y
                       | (Way
    x,Way
    y) <- [(Way, Way)]
    forall {a}. [a]
    couples
                       ]
       -- List of disallowed couples of ways
       couples :: [a]
    couples = [] -- we don't have any disallowed combination of ways nowadays

    -- | Unique tag associated to a list of ways
    waysTag :: Ways -> String
    waysTag :: Ways -> String
    waysTag = [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([String] -> String) -> (Ways -> [String]) -> Ways -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    intersperse String
    "_" ([String] -> [String]) -> (Ways -> [String]) -> Ways -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Way -> String) -> [Way] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Way -> String
    wayTag ([Way] -> [String]) -> (Ways -> [Way]) -> Ways -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Ways -> [Way]
    forall a. Set a -> [a]
    Set.toAscList

    -- | Unique build-tag associated to a list of ways
    --
    -- RTS only ways are filtered out because they have no impact on the build.
    waysBuildTag :: Ways -> String
    waysBuildTag :: Ways -> String
    waysBuildTag Ways
    ws = Ways -> String
    waysTag ((Way -> Bool) -> Ways -> Ways
    forall a. (a -> Bool) -> Set a -> Set a
    Set.filter (Bool -> Bool
    not (Bool -> Bool) -> (Way -> Bool) -> Way -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Way -> Bool
    wayRTSOnly) Ways
    ws)

    -- | Unique build-tag associated to a way
    wayTag :: Way -> String
    wayTag :: Way -> String
    wayTag (WayCustom String
    xs) = String
    xs
    wayTag Way
    WayThreaded    = String
    "thr"
    wayTag Way
    WayDebug       = String
    "debug"
    wayTag Way
    WayDyn         = String
    "dyn"
    wayTag Way
    WayProf        = String
    "p"
    wayTag Way
    WayTracing     = String
    "l" -- "l" for "logging"

    -- | Return true for ways that only impact the RTS, not the generated code
    wayRTSOnly :: Way -> Bool
    wayRTSOnly :: Way -> Bool
    wayRTSOnly (WayCustom {}) = Bool
    False
    wayRTSOnly Way
    WayDyn         = Bool
    False
    wayRTSOnly Way
    WayProf        = Bool
    False
    wayRTSOnly Way
    WayThreaded    = Bool
    True
    wayRTSOnly Way
    WayDebug       = Bool
    True
    wayRTSOnly Way
    WayTracing     = Bool
    True

    -- | Filter ways that have an impact on compilation
    fullWays :: Ways -> Ways
    fullWays :: Ways -> Ways
    fullWays Ways
    ws = (Way -> Bool) -> Ways -> Ways
    forall a. (a -> Bool) -> Set a -> Set a
    Set.filter (Bool -> Bool
    not (Bool -> Bool) -> (Way -> Bool) -> Way -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Way -> Bool
    wayRTSOnly) Ways
    ws

    -- | Filter RTS-only ways (ways that don't have an impact on compilation)
    rtsWays :: Ways -> Ways
    rtsWays :: Ways -> Ways
    rtsWays Ways
    ws = (Way -> Bool) -> Ways -> Ways
    forall a. (a -> Bool) -> Set a -> Set a
    Set.filter Way -> Bool
    wayRTSOnly Ways
    ws

    wayDesc :: Way -> String
    wayDesc :: Way -> String
    wayDesc (WayCustom String
    xs) = String
    xs
    wayDesc Way
    WayThreaded    = String
    "Threaded"
    wayDesc Way
    WayDebug       = String
    "Debug"
    wayDesc Way
    WayDyn         = String
    "Dynamic"
    wayDesc Way
    WayProf        = String
    "Profiling"
    wayDesc Way
    WayTracing     = String
    "Tracing"

    -- | Turn these flags on when enabling this way
    wayGeneralFlags :: Platform -> Way -> [GeneralFlag]
    wayGeneralFlags :: Platform -> Way -> [GeneralFlag]
    wayGeneralFlags Platform
    _ (WayCustom {}) = []
    wayGeneralFlags Platform
    _ Way
    WayThreaded = []
    wayGeneralFlags Platform
    _ Way
    WayDebug    = []
    wayGeneralFlags Platform
    _ Way
    WayDyn      = [GeneralFlag
    Opt_PIC, GeneralFlag
    Opt_ExternalDynamicRefs]
        -- We could get away without adding -fPIC when compiling the
        -- modules of a program that is to be linked with -dynamic; the
        -- program itself does not need to be position-independent, only
        -- the libraries need to be.  HOWEVER, GHCi links objects into a
        -- .so before loading the .so using the system linker.  Since only
        -- PIC objects can be linked into a .so, we have to compile even
        -- modules of the main program with -fPIC when using -dynamic.
    wayGeneralFlags Platform
    _ Way
    WayProf     = []
    wayGeneralFlags Platform
    _ Way
    WayTracing  = []

    -- | Turn these flags off when enabling this way
    wayUnsetGeneralFlags :: Platform -> Way -> [GeneralFlag]
    wayUnsetGeneralFlags :: Platform -> Way -> [GeneralFlag]
    wayUnsetGeneralFlags Platform
    _ (WayCustom {}) = []
    wayUnsetGeneralFlags Platform
    _ Way
    WayThreaded = []
    wayUnsetGeneralFlags Platform
    _ Way
    WayDebug    = []
    wayUnsetGeneralFlags Platform
    _ Way
    WayDyn      = [GeneralFlag
    Opt_SplitSections]
       -- There's no point splitting when we're going to be dynamically linking.
       -- Plus it breaks compilation on OSX x86.
    wayUnsetGeneralFlags Platform
    _ Way
    WayProf     = []
    wayUnsetGeneralFlags Platform
    _ Way
    WayTracing  = []

    -- | Pass these options to the C compiler when enabling this way
    wayOptc :: Platform -> Way -> [String]
    wayOptc :: Platform -> Way -> [String]
    wayOptc Platform
    _ (WayCustom {}) = []
    wayOptc Platform
    platform Way
    WayThreaded = case Platform -> OS
    platformOS Platform
    platform of
                                   OS
    OSOpenBSD -> [String
    "-pthread"]
                                   OS
    OSNetBSD  -> [String
    "-pthread"]
                                   OS
    _         -> []
    wayOptc Platform
    _ Way
    WayDebug      = []
    wayOptc Platform
    _ Way
    WayDyn        = []
    wayOptc Platform
    _ Way
    WayProf       = [String
    "-DPROFILING"]
    wayOptc Platform
    _ Way
    WayTracing    = [String
    "-DTRACING"]

    -- | Pass these options to linker when enabling this way
    wayOptl :: Platform -> Way -> [String]
    wayOptl :: Platform -> Way -> [String]
    wayOptl Platform
    _ (WayCustom {}) = []
    wayOptl Platform
    platform Way
    WayThreaded =
       case Platform -> OS
    platformOS Platform
    platform of
       -- N.B. FreeBSD cc throws a warning if we pass -pthread without
       -- actually using any pthread symbols.
       OS
    OSFreeBSD  -> [String
    "-pthread", String
    "-Wno-unused-command-line-argument"]
       OS
    OSOpenBSD  -> [String
    "-pthread"]
       OS
    OSNetBSD   -> [String
    "-pthread"]
       OS
    _          -> []
    wayOptl Platform
    _ Way
    WayDebug      = []
    wayOptl Platform
    _ Way
    WayDyn        = []
    wayOptl Platform
    _ Way
    WayProf       = []
    wayOptl Platform
    _ Way
    WayTracing    = []

    -- | Pass these options to the preprocessor when enabling this way
    wayOptP :: Platform -> Way -> [String]
    wayOptP :: Platform -> Way -> [String]
    wayOptP Platform
    _ (WayCustom {}) = []
    wayOptP Platform
    _ Way
    WayThreaded = []
    wayOptP Platform
    _ Way
    WayDebug    = []
    wayOptP Platform
    _ Way
    WayDyn      = []
    wayOptP Platform
    _ Way
    WayProf     = [String
    "-DPROFILING"]
    wayOptP Platform
    _ Way
    WayTracing  = [String
    "-DTRACING"]

    -- | Consult the RTS to find whether it has been built with profiling enabled.
    hostIsProfiled :: Bool
    hostIsProfiled :: Bool
    hostIsProfiled = Int
    rtsIsProfiled_ Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    0

    foreign import ccall unsafe "rts_isProfiled" rtsIsProfiled_ :: Int

    -- | Consult the RTS to find whether GHC itself has been built with
    -- dynamic linking.  This can't be statically known at compile-time,
    -- because we build both the static and dynamic versions together with
    -- -dynamic-too.
    hostIsDynamic :: Bool
    hostIsDynamic :: Bool
    hostIsDynamic = Int
    rtsIsDynamic_ Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    0

    foreign import ccall unsafe "rts_isDynamic" rtsIsDynamic_ :: Int

    -- we need this until the bootstrap GHC is always recent enough
    #if MIN_VERSION_GLASGOW_HASKELL(9,1,0,0)

    -- | Consult the RTS to find whether it is threaded.
    hostIsThreaded :: Bool
    hostIsThreaded :: Bool
    hostIsThreaded = Int
    rtsIsThreaded_ Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    0

    foreign import ccall unsafe "rts_isThreaded" rtsIsThreaded_ :: Int

    -- | Consult the RTS to find whether it is debugged.
    hostIsDebugged :: Bool
    hostIsDebugged :: Bool
    hostIsDebugged = Int
    rtsIsDebugged_ Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    0

    foreign import ccall unsafe "rts_isDebugged" rtsIsDebugged_ :: Int

    -- | Consult the RTS to find whether it is tracing.
    hostIsTracing :: Bool
    hostIsTracing :: Bool
    hostIsTracing = Int
    rtsIsTracing_ Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    0

    foreign import ccall unsafe "rts_isTracing" rtsIsTracing_ :: Int

    #else

    hostIsThreaded :: Bool
    hostIsThreaded = False

    hostIsDebugged :: Bool
    hostIsDebugged = False

    hostIsTracing :: Bool
    hostIsTracing = False

    #endif

    -- | Host ways.
    hostWays :: Ways
    hostWays :: Ways
    hostWays = [Ways] -> Ways
    forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
    Set.unions
       [ if Bool
    hostIsDynamic  then Way -> Ways
    forall a. a -> Set a
    Set.singleton Way
    WayDyn      else Ways
    forall a. Set a
    Set.empty
       , if Bool
    hostIsProfiled then Way -> Ways
    forall a. a -> Set a
    Set.singleton Way
    WayProf     else Ways
    forall a. Set a
    Set.empty
       , if Bool
    hostIsThreaded then Way -> Ways
    forall a. a -> Set a
    Set.singleton Way
    WayThreaded else Ways
    forall a. Set a
    Set.empty
       , if Bool
    hostIsDebugged then Way -> Ways
    forall a. a -> Set a
    Set.singleton Way
    WayDebug    else Ways
    forall a. Set a
    Set.empty
       , if Bool
    hostIsTracing  then Way -> Ways
    forall a. a -> Set a
    Set.singleton Way
    WayTracing  else Ways
    forall a. Set a
    Set.empty
       ]

    -- | Host "full" ways (i.e. ways that have an impact on the compilation,
    -- not RTS only ways).
    --
    -- These ways must be used when compiling codes targeting the internal
    -- interpreter.
    hostFullWays :: Ways
    hostFullWays :: Ways
    hostFullWays = Ways -> Ways
    fullWays Ways
    hostWays