cf550082dbed11ab684badb741cda65864fadf95
[ghc.git] / testsuite / mk / ghc-config.hs
1 import System.Environment
2 import System.Process
3 import Data.Maybe
4
5 main = do
6 [ghc] <- getArgs
7
8 info <- readProcess ghc ["+RTS", "--info"] ""
9 let fields = read info :: [(String,String)]
10 getGhcFieldOrFail fields "HostOS" "Host OS"
11 getGhcFieldOrFail fields "WORDSIZE" "Word size"
12 getGhcFieldOrFail fields "TARGETPLATFORM" "Target platform"
13 getGhcFieldOrFail fields "TargetOS_CPP" "Target OS"
14 getGhcFieldOrFail fields "TargetARCH_CPP" "Target architecture"
15
16 info <- readProcess ghc ["--info"] ""
17 let fields = read info :: [(String,String)]
18
19 getGhcFieldOrFail fields "GhcStage" "Stage"
20 getGhcFieldOrFail fields "GhcDebugged" "Debug on"
21 getGhcFieldOrFail fields "GhcWithNativeCodeGen" "Have native code generator"
22 getGhcFieldOrFail fields "GhcWithInterpreter" "Have interpreter"
23 getGhcFieldOrFail fields "GhcUnregisterised" "Unregisterised"
24 getGhcFieldOrFail fields "GhcWithSMP" "Support SMP"
25 getGhcFieldOrFail fields "GhcRTSWays" "RTS ways"
26 getGhcFieldOrDefault fields "GhcDynamicByDefault" "Dynamic by default" "NO"
27 getGhcFieldOrDefault fields "GhcDynamic" "GHC Dynamic" "NO"
28 getGhcFieldOrDefault fields "GhcProfiled" "GHC Profiled" "NO"
29 getGhcFieldProgWithDefault fields "AR" "ar command" "ar"
30 getGhcFieldProgWithDefault fields "LLC" "LLVM llc command" "llc"
31 getGhcFieldProgWithDefault fields "TEST_CC" "C compiler command" "gcc"
32
33 let pkgdb_flag = case lookup "Project version" fields of
34 Just v
35 | parseVersion v >= [7,5] -> "package-db"
36 _ -> "package-conf"
37 putStrLn $ "GhcPackageDbFlag" ++ '=':pkgdb_flag
38
39 let minGhcVersion711 = case lookup "Project version" fields of
40 Just v
41 | parseVersion v >= [7,11] -> "YES"
42 _ -> "NO"
43 putStrLn $ "MinGhcVersion711" ++ '=':minGhcVersion711
44
45 let minGhcVersion801 = case lookup "Project version" fields of
46 Just v
47 | parseVersion v >= [8,1] -> "YES"
48 _ -> "NO"
49 putStrLn $ "MinGhcVersion801" ++ '=':minGhcVersion801
50
51
52 getGhcFieldOrFail :: [(String,String)] -> String -> String -> IO ()
53 getGhcFieldOrFail fields mkvar key
54 = getGhcField fields mkvar key id (fail ("No field: " ++ key))
55
56 getGhcFieldOrDefault :: [(String,String)] -> String -> String -> String -> IO ()
57 getGhcFieldOrDefault fields mkvar key deflt
58 = getGhcField fields mkvar key id on_fail
59 where
60 on_fail = putStrLn (mkvar ++ '=' : deflt)
61
62 getGhcFieldProgWithDefault
63 :: [(String,String)]
64 -> String -> String -> String
65 -> IO ()
66 getGhcFieldProgWithDefault fields mkvar key deflt
67 = getGhcField fields mkvar key fix on_fail
68 where
69 fix val = fixSlashes (fixTopdir topdir val)
70 topdir = fromMaybe "" (lookup "LibDir" fields)
71 on_fail = putStrLn (mkvar ++ '=' : deflt)
72
73 getGhcField
74 :: [(String,String)] -> String -> String
75 -> (String -> String)
76 -> IO ()
77 -> IO ()
78 getGhcField fields mkvar key fix on_fail =
79 case lookup key fields of
80 Nothing -> on_fail
81 Just val -> putStrLn (mkvar ++ '=' : fix val)
82
83 fixTopdir :: String -> String -> String
84 fixTopdir t "" = ""
85 fixTopdir t ('$':'t':'o':'p':'d':'i':'r':s) = t ++ s
86 fixTopdir t (c:s) = c : fixTopdir t s
87
88 fixSlashes :: FilePath -> FilePath
89 fixSlashes = map f
90 where f '\\' = '/'
91 f c = c
92
93 parseVersion :: String -> [Int]
94 parseVersion v = case break (== '.') v of
95 (n, rest) -> read n : case rest of
96 [] -> []
97 ('.':v') -> parseVersion v'
98 _ -> error "bug in parseVersion"