Rename "extra-gcc-opts" to "settings", and start generalising it
[ghc-hetmet.git] / ghc / Main.hs
index 9c99334..15327f8 100644 (file)
@@ -358,9 +358,6 @@ showVersionMode             = mkPreStartupMode ShowVersion
 showNumVersionMode          = mkPreStartupMode ShowNumVersion
 showSupportedExtensionsMode = mkPreStartupMode ShowSupportedExtensions
 
-printMode :: String -> Mode
-printMode str              = mkPreStartupMode (Print str)
-
 mkPreStartupMode :: PreStartupMode -> Mode
 mkPreStartupMode = Left
 
@@ -383,8 +380,10 @@ showGhcUsageMode = mkPreLoadMode ShowGhcUsage
 showGhciUsageMode = mkPreLoadMode ShowGhciUsage
 showInfoMode = mkPreLoadMode ShowInfo
 
-printWithDynFlagsMode :: (DynFlags -> String) -> Mode
-printWithDynFlagsMode f = mkPreLoadMode (PrintWithDynFlags f)
+printSetting :: String -> Mode
+printSetting k = mkPreLoadMode (PrintWithDynFlags f)
+    where f dflags = fromMaybe (panic ("Setting not found: " ++ show k))
+                   $ lookup k (compilerInfo dflags)
 
 mkPreLoadMode :: PreLoadMode -> Mode
 mkPreLoadMode = Right . Left
@@ -504,14 +503,30 @@ mode_flags =
   , Flag "-supported-languages"  (PassFlag (setMode showSupportedExtensionsMode))
   , Flag "-supported-extensions" (PassFlag (setMode showSupportedExtensionsMode))
   ] ++
-  [ Flag k'                     (PassFlag (setMode mode))
-  | (k, v) <- compilerInfo,
+  [ Flag k'                     (PassFlag (setMode (printSetting k)))
+  | k <- ["Project version",
+          "Booter version",
+          "Stage",
+          "Build platform",
+          "Host platform",
+          "Target platform",
+          "Have interpreter",
+          "Object splitting supported",
+          "Have native code generator",
+          "Support SMP",
+          "Unregisterised",
+          "Tables next to code",
+          "RTS ways",
+          "Leading underscore",
+          "Debug on",
+          "LibDir",
+          "Global Package DB",
+          "C compiler flags",
+          "Gcc Linker flags",
+          "Ld Linker flags"],
     let k' = "-print-" ++ map (replaceSpace . toLower) k
         replaceSpace ' ' = '-'
         replaceSpace c   = c
-        mode = case v of
-               String str -> printMode str
-               FromDynFlags f -> printWithDynFlagsMode f
   ] ++
       ------- interfaces ----------------------------------------------------
   [ Flag "-show-iface"  (HasArg (\f -> setMode (showInterfaceMode f)
@@ -649,9 +664,7 @@ showBanner _postLoadMode dflags = do
 showInfo :: DynFlags -> IO ()
 showInfo dflags = do
         let sq x = " [" ++ x ++ "\n ]"
-        putStrLn $ sq $ concat $ intersperse "\n ," $ map (show . flatten) compilerInfo
-    where flatten (k, String v)       = (k, v)
-          flatten (k, FromDynFlags f) = (k, f dflags)
+        putStrLn $ sq $ intercalate "\n ," $ map show $ compilerInfo dflags
 
 showSupportedExtensions :: IO ()
 showSupportedExtensions = mapM_ putStrLn supportedLanguagesAndExtensions