X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2FMain.hs;h=fab773ba95771c608e6bf95637ee1ee79ca110d2;hb=d108044bef62f6a0d579c92ced5e8188f72edc2d;hp=a62663d033c68c94311c6a3cec7c788ac86d6637;hpb=1971591f865ac0806802c476f23792ae2c89411a;p=ghc-hetmet.git diff --git a/ghc/Main.hs b/ghc/Main.hs index a62663d..fab773b 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -497,24 +497,15 @@ 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 showSupportedExtensionsMode)) - Supported , Flag "-supported-extensions" (PassFlag (setMode showSupportedExtensionsMode)) - Supported ] ++ [ Flag k' (PassFlag (setMode mode)) - Supported | (k, v) <- compilerInfo, let k' = "-print-" ++ map (replaceSpace . toLower) k replaceSpace ' ' = '-' @@ -526,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 @@ -595,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" @@ -677,7 +658,7 @@ showInfo dflags = do flatten (k, FromDynFlags f) = (k, f dflags) showSupportedExtensions :: IO () -showSupportedExtensions = mapM_ putStrLn supportedExtensions +showSupportedExtensions = mapM_ putStrLn supportedLanguagesAndExtensions showVersion :: IO () showVersion = putStrLn (cProjectName ++ ", version " ++ cProjectVersion)