Build system: check $CLEANING instead of $MAKECMDGOALS
[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 getGhcFieldProgWithDefault fields "AR" "ar command" "ar"
29 getGhcFieldProgWithDefault fields "LLC" "LLVM llc command" "llc"
30
31 let pkgdb_flag = case lookup "Project version" fields of
32 Just v
33 | parseVersion v >= [7,5] -> "package-db"
34 _ -> "package-conf"
35 putStrLn $ "GhcPackageDbFlag" ++ '=':pkgdb_flag
36
37
38 getGhcFieldOrFail :: [(String,String)] -> String -> String -> IO ()
39 getGhcFieldOrFail fields mkvar key
40 = getGhcField fields mkvar key id (fail ("No field: " ++ key))
41
42 getGhcFieldOrDefault :: [(String,String)] -> String -> String -> String -> IO ()
43 getGhcFieldOrDefault fields mkvar key deflt
44 = getGhcField fields mkvar key id on_fail
45 where
46 on_fail = putStrLn (mkvar ++ '=' : deflt)
47
48 getGhcFieldProgWithDefault
49 :: [(String,String)]
50 -> String -> String -> String
51 -> IO ()
52 getGhcFieldProgWithDefault fields mkvar key deflt
53 = getGhcField fields mkvar key fix on_fail
54 where
55 fix val = fixSlashes (fixTopdir topdir val)
56 topdir = fromMaybe "" (lookup "LibDir" fields)
57 on_fail = putStrLn (mkvar ++ '=' : deflt)
58
59 getGhcField
60 :: [(String,String)] -> String -> String
61 -> (String -> String)
62 -> IO ()
63 -> IO ()
64 getGhcField fields mkvar key fix on_fail =
65 case lookup key fields of
66 Nothing -> on_fail
67 Just val -> putStrLn (mkvar ++ '=' : fix val)
68
69 fixTopdir :: String -> String -> String
70 fixTopdir t "" = ""
71 fixTopdir t ('$':'t':'o':'p':'d':'i':'r':s) = t ++ s
72 fixTopdir t (c:s) = c : fixTopdir t s
73
74 fixSlashes :: FilePath -> FilePath
75 fixSlashes = map f
76 where f '\\' = '/'
77 f c = c
78
79 parseVersion :: String -> [Int]
80 parseVersion v = case break (== '.') v of
81 (n, rest) -> read n : case rest of
82 [] -> []
83 ('.':v') -> parseVersion v'
84 _ -> error "bug in parseVersion"