X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2FMain.hs;h=fab773ba95771c608e6bf95637ee1ee79ca110d2;hb=cfb69428a10e245bc5b64417803b637693977b24;hp=519d9cd0759333430bdb32bf754b355266047d80;hpb=7828bf3ea2ea34e7a3a8662f5f621ef706ffee5c;p=ghc-hetmet.git

diff --git a/ghc/Main.hs b/ghc/Main.hs
index 519d9cd..fab773b 100644
--- a/ghc/Main.hs
+++ b/ghc/Main.hs
@@ -76,8 +76,9 @@ import Data.Maybe
 -- GHC's command-line interface
 
 main :: IO ()
-main =
-    GHC.defaultErrorHandler defaultDynFlags $ do
+main = do
+   hSetBuffering stdout NoBuffering
+   GHC.defaultErrorHandler defaultDynFlags $ do
     -- 1. extract the -B flag from the args
     argv0 <- getArgs
 
@@ -104,7 +105,7 @@ main =
     case mode of
         Left preStartupMode ->
             do case preStartupMode of
-                   ShowSupportedLanguages  -> showSupportedLanguages
+                   ShowSupportedExtensions -> showSupportedExtensions
                    ShowVersion             -> showVersion
                    ShowNumVersion          -> putStrLn cProjectVersion
                    Print str               -> putStrLn str
@@ -350,13 +351,13 @@ type PostStartupMode = Either PreLoadMode PostLoadMode
 data PreStartupMode
   = ShowVersion             -- ghc -V/--version
   | ShowNumVersion          -- ghc --numeric-version
-  | ShowSupportedLanguages  -- ghc --supported-languages
+  | ShowSupportedExtensions -- ghc --supported-extensions
   | Print String            -- ghc --print-foo
 
-showVersionMode, showNumVersionMode, showSupportedLanguagesMode :: Mode
-showVersionMode            = mkPreStartupMode ShowVersion
-showNumVersionMode         = mkPreStartupMode ShowNumVersion
-showSupportedLanguagesMode = mkPreStartupMode ShowSupportedLanguages
+showVersionMode, showNumVersionMode, showSupportedExtensionsMode :: Mode
+showVersionMode             = mkPreStartupMode ShowVersion
+showNumVersionMode          = mkPreStartupMode ShowNumVersion
+showSupportedExtensionsMode = mkPreStartupMode ShowSupportedExtensions
 
 printMode :: String -> Mode
 printMode str              = mkPreStartupMode (Print str)
@@ -495,23 +496,16 @@ type ModeM = CmdLineP (Maybe (Mode, String), [String], [Located String])
 mode_flags :: [Flag ModeM]
 mode_flags =
   [  ------- help / version ----------------------------------------------
-    Flag "?"                    (PassFlag (setMode showGhcUsageMode))
-         Supported
-  , Flag "-help"                (PassFlag (setMode showGhcUsageMode))
-         Supported
-  , Flag "V"                    (PassFlag (setMode showVersionMode))
-         Supported
-  , Flag "-version"             (PassFlag (setMode showVersionMode))
-         Supported
-  , Flag "-numeric-version"     (PassFlag (setMode showNumVersionMode))
-         Supported
-  , Flag "-info"                (PassFlag (setMode showInfoMode))
-         Supported
-  , Flag "-supported-languages" (PassFlag (setMode showSupportedLanguagesMode))
-         Supported
+    Flag "?"                     (PassFlag (setMode showGhcUsageMode))
+  , Flag "-help"                 (PassFlag (setMode showGhcUsageMode))
+  , Flag "V"                     (PassFlag (setMode showVersionMode))
+  , Flag "-version"              (PassFlag (setMode showVersionMode))
+  , Flag "-numeric-version"      (PassFlag (setMode showNumVersionMode))
+  , Flag "-info"                 (PassFlag (setMode showInfoMode))
+  , Flag "-supported-languages"  (PassFlag (setMode showSupportedExtensionsMode))
+  , Flag "-supported-extensions" (PassFlag (setMode showSupportedExtensionsMode))
   ] ++
   [ Flag k'                     (PassFlag (setMode mode))
-         Supported
   | (k, v) <- compilerInfo,
     let k' = "-print-" ++ map (replaceSpace . toLower) k
         replaceSpace ' ' = '-'
@@ -523,33 +517,23 @@ mode_flags =
       ------- interfaces ----------------------------------------------------
   [ Flag "-show-iface"  (HasArg (\f -> setMode (showInterfaceMode f)
                                                "--show-iface"))
-         Supported
 
       ------- primary modes ------------------------------------------------
   , Flag "c"            (PassFlag (\f -> do setMode (stopBeforeMode StopLn) f
                                             addFlag "-no-link" f))
-         Supported
   , Flag "M"            (PassFlag (setMode doMkDependHSMode))
-         Supported
   , Flag "E"            (PassFlag (setMode (stopBeforeMode anyHsc)))
-         Supported
   , Flag "C"            (PassFlag (\f -> do setMode (stopBeforeMode HCc) f
                                             addFlag "-fvia-C" f))
-         Supported
   , Flag "S"            (PassFlag (setMode (stopBeforeMode As)))
-         Supported
   , Flag "-make"        (PassFlag (setMode doMakeMode))
-         Supported
   , Flag "-interactive" (PassFlag (setMode doInteractiveMode))
-         Supported
   , Flag "-abi-hash"    (PassFlag (setMode doAbiHashMode))
-         Supported
   , Flag "e"            (SepArg   (\s -> setMode (doEvalMode s) "-e"))
-         Supported
   ]
 
-setMode :: Mode -> String -> ModeM ()
-setMode newMode newFlag = do
+setMode :: Mode -> String -> EwM ModeM ()
+setMode newMode newFlag = liftEwM $ do
     (mModeFlag, errs, flags') <- getCmdLineState
     let (modeFlag', errs') =
             case mModeFlag of
@@ -592,8 +576,8 @@ flagMismatchErr :: String -> String -> String
 flagMismatchErr oldFlag newFlag
     = "cannot use `" ++ oldFlag ++  "' with `" ++ newFlag ++ "'"
 
-addFlag :: String -> String -> ModeM ()
-addFlag s flag = do
+addFlag :: String -> String -> EwM ModeM ()
+addFlag s flag = liftEwM $ do
   (m, e, flags') <- getCmdLineState
   putCmdLineState (m, e, mkGeneralLocated loc s : flags')
     where loc = "addFlag by " ++ flag ++ " on the commandline"
@@ -673,8 +657,8 @@ showInfo dflags = do
     where flatten (k, String v)       = (k, v)
           flatten (k, FromDynFlags f) = (k, f dflags)
 
-showSupportedLanguages :: IO ()
-showSupportedLanguages = mapM_ putStrLn supportedLanguages
+showSupportedExtensions :: IO ()
+showSupportedExtensions = mapM_ putStrLn supportedLanguagesAndExtensions
 
 showVersion :: IO ()
 showVersion = putStrLn (cProjectName ++ ", version " ++ cProjectVersion)