ghc-dup: 5ab49eb1ce96e29842bd3fa3e08b2450d7941f34
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: getGhcField fields "HostOS" "Host OS"
11: getGhcField fields "WORDSIZE" "Word size"
12: getGhcField fields "TARGETPLATFORM" "Target platform"
13: getGhcField fields "TargetOS_CPP" "Target OS"
14: getGhcField fields "TargetARCH_CPP" "Target architecture"
15:
16: info <- readProcess ghc ["--info"] ""
17: let fields = read info :: [(String,String)]
18:
19: getGhcField fields "GhcStage" "Stage"
20: getGhcField fields "GhcWithNativeCodeGen" "Have native code generator"
21: getGhcField fields "GhcWithInterpreter" "Have interpreter"
22: getGhcField fields "GhcUnregisterised" "Unregisterised"
23: getGhcField fields "GhcWithSMP" "Support SMP"
24: getGhcField fields "GhcRTSWays" "RTS ways"
25: getGhcFieldProgWithDefault fields "AR" "ar command" "ar"
26:
27: let pkgdb_flag = case lookup "Project version" fields of
28: Just v
29: | parseVersion v >= [7,5] -> "package-db"
30: _ -> "package-conf"
31: putStrLn $ "GhcPackageDbFlag" ++ '=':pkgdb_flag
32:
33:
34: getGhcField :: [(String,String)] -> String -> String -> IO ()
35: getGhcField fields mkvar key =
36: case lookup key fields of
37: Nothing -> fail ("No field: " ++ key)
38: Just val -> putStrLn (mkvar ++ '=':val)
39:
40: getGhcFieldProgWithDefault :: [(String,String)]
41: -> String -> String -> String -> IO ()
42: getGhcFieldProgWithDefault fields mkvar key deflt = do
43: case lookup key fields of
44: Nothing -> putStrLn (mkvar ++ '=' : deflt)
45: Just val -> putStrLn (mkvar ++ '=' : fixSlashes (fixTopdir topdir val))
46: where
47: topdir = fromMaybe "" (lookup "LibDir" fields)
48:
49: fixTopdir :: String -> String -> String
50: fixTopdir t "" = ""
51: fixTopdir t ('$':'t':'o':'p':'d':'i':'r':s) = t ++ s
52: fixTopdir t (c:s) = c : fixTopdir t s
53:
54: fixSlashes :: FilePath -> FilePath
55: fixSlashes = map f
56: where f '\\' = '/'
57: f c = c
58:
59: parseVersion :: String -> [Int]
60: parseVersion v = case break (== '.') v of
61: (n, rest) -> read n : case rest of
62: [] -> []
63: ('.':v') -> parseVersion v'
64: _ -> error "bug in parseVersion"
Generated by git2html.