X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FMain.hs;h=bc18dae09ff3859470738bf1bf1d53f1016e95ca;hb=a8dc65d6582cc8dda6a1de2862e2d6da80a78d0c;hp=3c94bf55865c412824587d134d0915769b147f09;hpb=d4050431de1adddedb240e497f77f89301f77070;p=ghc-hetmet.git

diff --git a/compiler/main/Main.hs b/compiler/main/Main.hs
index 3c94bf5..bc18dae 100644
--- a/compiler/main/Main.hs
+++ b/compiler/main/Main.hs
@@ -85,6 +85,8 @@ main =
   -- to find out what version of GHC it's using before package.conf
   -- exists, so starting the session fails.
   case cli_mode of
+    ShowInfo                -> do showInfo
+                                  exitWith ExitSuccess
     ShowSupportedLanguages  -> do showSupportedLanguages
                                   exitWith ExitSuccess
     ShowVersion             -> do showVersion
@@ -296,6 +298,7 @@ verifyOutputFiles dflags = do
 data CmdLineMode
   = ShowUsage               -- ghc -?
   | PrintLibdir             -- ghc --print-libdir
+  | ShowInfo                -- ghc --info
   | ShowSupportedLanguages  -- ghc --supported-languages
   | ShowVersion             -- ghc -V/--version
   | ShowNumVersion          -- ghc --numeric-version
@@ -360,6 +363,7 @@ mode_flags =
   ,  ( "V"	 	 , PassFlag (setMode ShowVersion))
   ,  ( "-version"	 , PassFlag (setMode ShowVersion))
   ,  ( "-numeric-version", PassFlag (setMode ShowNumVersion))
+  ,  ( "-info", PassFlag (setMode ShowInfo))
   ,  ( "-supported-languages", PassFlag (setMode ShowSupportedLanguages))
 
       ------- interfaces ----------------------------------------------------
@@ -449,6 +453,14 @@ showBanner cli_mode dflags = do
        hPutStr stderr " booted by GHC version "
        hPutStrLn stderr cBooterVersion
 
+-- We print out a Read-friendly string, but a prettier one than the
+-- Show instance gives us
+showInfo :: IO ()
+showInfo = do
+    let sq x = " [" ++ x ++ "\n ]"
+    putStrLn $ sq $ concat $ intersperse "\n ," $ map show compilerInfo
+    exitWith ExitSuccess
+
 showSupportedLanguages :: IO ()
 showSupportedLanguages = do mapM_ putStrLn supportedLanguages
                             exitWith ExitSuccess