{-# LANGUAGE CPP #-}
module GHC.Platform.Ways
( Way(..)
, Ways
, hasWay
, addWay
, allowed_combination
, wayGeneralFlags
, wayUnsetGeneralFlags
, wayOptc
, wayOptl
, wayOptP
, wayDesc
, wayRTSOnly
, wayTag
, waysTag
, waysBuildTag
, fullWays
, rtsWays
, hostWays
, hostFullWays
, hostIsProfiled
, hostIsDynamic
, hostIsThreaded
, hostIsDebugged
, hostIsTracing
)
where
#include "HsVersions.h"
import GHC.Prelude
import GHC.Platform
import GHC.Driver.Flags
import qualified Data.Set as Set
import Data.Set (Set)
import Data.List (intersperse)
data Way
= WayCustom String
| WayThreaded
| WayDebug
| WayProf
| WayTracing
| WayDyn
deriving (Way -> Way -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Way -> Way -> Bool
$c/= :: Way -> Way -> Bool
== :: Way -> Way -> Bool
$c== :: Way -> Way -> Bool
Eq, Eq 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
min :: Way -> Way -> Way
$cmin :: Way -> Way -> Way
max :: Way -> Way -> Way
$cmax :: Way -> Way -> Way
>= :: Way -> Way -> Bool
$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
compare :: Way -> Way -> Ordering
$ccompare :: Way -> Way -> Ordering
Ord, Int -> Way -> ShowS
[Way] -> ShowS
Way -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Way] -> ShowS
$cshowList :: [Way] -> ShowS
show :: Way -> String
$cshow :: Way -> String
showsPrec :: Int -> Way -> ShowS
$cshowsPrec :: Int -> Way -> ShowS
Show)
type Ways = Set Way
hasWay :: Ways -> Way -> Bool
hasWay :: Ways -> Way -> Bool
hasWay Ways
ws Way
w = forall a. Ord a => a -> Set a -> Bool
Set.member Way
w Ways
ws
addWay :: Way -> Ways -> Ways
addWay :: Way -> Ways -> Ways
addWay = forall a. Ord a => a -> Set a -> Set a
Set.insert
allowed_combination :: Ways -> Bool
allowed_combination :: Ways -> Bool
allowed_combination Ways
ways = Bool -> Bool
not Bool
disallowed
where
disallowed :: Bool
disallowed = 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) <- forall {a}. [a]
couples
]
couples :: [a]
couples = []
waysTag :: Ways -> String
waysTag :: Ways -> String
waysTag = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse String
"_" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Way -> String
wayTag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
Set.toAscList
waysBuildTag :: Ways -> String
waysBuildTag :: Ways -> String
waysBuildTag Ways
ws = Ways -> String
waysTag (forall a. (a -> Bool) -> Set a -> Set a
Set.filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Way -> Bool
wayRTSOnly) Ways
ws)
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"
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
fullWays :: Ways -> Ways
fullWays :: Ways -> Ways
fullWays Ways
ws = forall a. (a -> Bool) -> Set a -> Set a
Set.filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Way -> Bool
wayRTSOnly) Ways
ws
rtsWays :: Ways -> Ways
rtsWays :: Ways -> Ways
rtsWays Ways
ws = 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"
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]
wayGeneralFlags Platform
_ Way
WayProf = []
wayGeneralFlags Platform
_ Way
WayTracing = []
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]
wayUnsetGeneralFlags Platform
_ Way
WayProf = []
wayUnsetGeneralFlags Platform
_ Way
WayTracing = []
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"]
wayOptl :: Platform -> Way -> [String]
wayOptl :: Platform -> Way -> [String]
wayOptl Platform
_ (WayCustom {}) = []
wayOptl Platform
platform Way
WayThreaded =
case Platform -> OS
platformOS Platform
platform of
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 = []
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"]
hostIsProfiled :: Bool
hostIsProfiled :: Bool
hostIsProfiled = Int
rtsIsProfiled_ forall a. Eq a => a -> a -> Bool
/= Int
0
foreign import ccall unsafe "rts_isProfiled" rtsIsProfiled_ :: Int
hostIsDynamic :: Bool
hostIsDynamic :: Bool
hostIsDynamic = Int
rtsIsDynamic_ forall a. Eq a => a -> a -> Bool
/= Int
0
foreign import ccall unsafe "rts_isDynamic" rtsIsDynamic_ :: Int
#if MIN_VERSION_GLASGOW_HASKELL(9,1,0,0)
hostIsThreaded :: Bool
hostIsThreaded :: Bool
hostIsThreaded = Int
rtsIsThreaded_ forall a. Eq a => a -> a -> Bool
/= Int
0
foreign import ccall unsafe "rts_isThreaded" rtsIsThreaded_ :: Int
hostIsDebugged :: Bool
hostIsDebugged :: Bool
hostIsDebugged = Int
rtsIsDebugged_ forall a. Eq a => a -> a -> Bool
/= Int
0
foreign import ccall unsafe "rts_isDebugged" rtsIsDebugged_ :: Int
hostIsTracing :: Bool
hostIsTracing :: Bool
hostIsTracing = Int
rtsIsTracing_ 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
hostWays :: Ways
hostWays :: Ways
hostWays = forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions
[ if Bool
hostIsDynamic then forall a. a -> Set a
Set.singleton Way
WayDyn else forall a. Set a
Set.empty
, if Bool
hostIsProfiled then forall a. a -> Set a
Set.singleton Way
WayProf else forall a. Set a
Set.empty
, if Bool
hostIsThreaded then forall a. a -> Set a
Set.singleton Way
WayThreaded else forall a. Set a
Set.empty
, if Bool
hostIsDebugged then forall a. a -> Set a
Set.singleton Way
WayDebug else forall a. Set a
Set.empty
, if Bool
hostIsTracing then forall a. a -> Set a
Set.singleton Way
WayTracing else forall a. Set a
Set.empty
]
hostFullWays :: Ways
hostFullWays :: Ways
hostFullWays = Ways -> Ways
fullWays Ways
hostWays