X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FMain.hs;h=d41e5906c97a11891283cc5a6e686b41ee53d5bd;hb=c395b75ce4f20583a5b28c5df79c4de019beecb9;hp=1e5dedc0a12e9047643a6196d61a7468b3d2e887;hpb=14d3b9c995a69f021704a23451f6d68ba7d4607d;p=ghc-hetmet.git diff --git a/compiler/main/Main.hs b/compiler/main/Main.hs index 1e5dedc..d41e590 100644 --- a/compiler/main/Main.hs +++ b/compiler/main/Main.hs @@ -1,4 +1,11 @@ {-# OPTIONS -fno-warn-incomplete-patterns -optc-DNON_POSIX_SOURCE #-} +{-# OPTIONS -w #-} +-- The above warning supression flag is a temporary kludge. +-- While working on this module you are encouraged to remove it and fix +-- any warnings in the module. See +-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings +-- for details + ----------------------------------------------------------------------------- -- -- GHC Driver program @@ -7,13 +14,6 @@ -- ----------------------------------------------------------------------------- -{-# OPTIONS -w #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and fix --- any warnings in the module. See --- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings --- for details - module Main (main) where #include "HsVersions.h" @@ -54,6 +54,7 @@ import System.IO import System.Directory ( doesDirectoryExist ) import System.Environment import System.Exit +import System.FilePath import Control.Monad import Data.List import Data.Maybe @@ -147,7 +148,7 @@ main = -- To simplify the handling of filepaths, we normalise all filepaths right -- away - e.g., for win32 platforms, backslashes are converted -- into forward slashes. - normal_fileish_paths = map normalisePath fileish_args + normal_fileish_paths = map normalise fileish_args (srcs, objs) = partition_args normal_fileish_paths [] [] -- Note: have v_Ld_inputs maintain the order in which 'objs' occurred on @@ -171,7 +172,6 @@ main = ShowUsage -> showGhcUsage dflags cli_mode PrintLibdir -> putStrLn (topDir dflags) ShowSupportedLanguages -> alreadyHandled - ShowDocDir -> showDocDir (topDir dflags) ShowVersion -> alreadyHandled ShowNumVersion -> alreadyHandled ShowInterface f -> doShowIface dflags f @@ -306,7 +306,6 @@ verifyOutputFiles dflags = do data CmdLineMode = ShowUsage -- ghc -? | PrintLibdir -- ghc --print-libdir - | ShowDocDir -- ghc --print-docdir | ShowInfo -- ghc --info | ShowSupportedLanguages -- ghc --supported-languages | ShowVersion -- ghc -V/--version @@ -369,7 +368,6 @@ mode_flags = ( "?" , PassFlag (setMode ShowUsage)) , ( "-help" , PassFlag (setMode ShowUsage)) , ( "-print-libdir" , PassFlag (setMode PrintLibdir)) - , ( "-print-docdir" , PassFlag (setMode ShowDocDir)) , ( "V" , PassFlag (setMode ShowVersion)) , ( "-version" , PassFlag (setMode ShowVersion)) , ( "-numeric-version" , PassFlag (setMode ShowNumVersion)) @@ -378,31 +376,31 @@ mode_flags = ------- interfaces ---------------------------------------------------- , ( "-show-iface" , HasArg (\f -> setMode (ShowInterface f) - "--show-iface")) + "--show-iface")) ------- primary modes ------------------------------------------------ - , ( "M" , PassFlag (setMode DoMkDependHS)) - , ( "E" , PassFlag (setMode (StopBefore anyHsc))) - , ( "C" , PassFlag (\f -> do setMode (StopBefore HCc) f - addFlag "-fvia-C")) - , ( "S" , PassFlag (setMode (StopBefore As))) - , ( "-make" , PassFlag (setMode DoMake)) - , ( "-interactive" , PassFlag (setMode DoInteractive)) + , ( "M" , PassFlag (setMode DoMkDependHS)) + , ( "E" , PassFlag (setMode (StopBefore anyHsc))) + , ( "C" , PassFlag (\f -> do setMode (StopBefore HCc) f + addFlag "-fvia-C")) + , ( "S" , PassFlag (setMode (StopBefore As))) + , ( "-make" , PassFlag (setMode DoMake)) + , ( "-interactive" , PassFlag (setMode DoInteractive)) , ( "e" , HasArg (\s -> setMode (DoEval s) "-e")) - -- -fno-code says to stop after Hsc but don't generate any code. - , ( "fno-code" , PassFlag (\f -> do setMode (StopBefore HCc) f - addFlag "-fno-code" - addFlag "-no-recomp")) + -- -fno-code says to stop after Hsc but don't generate any code. + , ( "fno-code" , PassFlag (\f -> do setMode (StopBefore HCc) f + addFlag "-fno-code" + addFlag "-no-recomp")) ] setMode :: CmdLineMode -> String -> ModeM () setMode m flag = do (old_mode, old_flag, flags) <- getCmdLineState - when (notNull old_flag && flag /= old_flag) $ - throwDyn (UsageError - ("cannot use `" ++ old_flag ++ "' with `" ++ flag ++ "'")) - putCmdLineState (m, flag, flags) + if notNull old_flag && flag /= old_flag + then throwDyn (UsageError + ("cannot use `" ++ old_flag ++ "' with `" ++ flag ++ "'")) + else putCmdLineState (m, flag, flags) addFlag :: String -> ModeM () addFlag s = do @@ -475,12 +473,6 @@ showSupportedLanguages :: IO () showSupportedLanguages = do mapM_ putStrLn supportedLanguages exitWith ExitSuccess -showDocDir :: FilePath -> IO () -showDocDir topdir = putStrLn docDir - where docDir = if cRelocatableBuild - then topdir ++ "/doc" - else cDocDir - showVersion :: IO () showVersion = do putStrLn (cProjectName ++ ", version " ++ cProjectVersion)