X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FDriverFlags.hs;h=b2db529e5738600026b764e7ee3210ba2f447f19;hb=58eba7cdb39ad4a9ddd23eeaf2bb76a561aa813d;hp=62e6524e32b1c72827f501b12fad9b17e1ba1fc3;hpb=957bf3756ffd56f5329a2aabe1022d6f996dd641;p=ghc-hetmet.git diff --git a/ghc/compiler/main/DriverFlags.hs b/ghc/compiler/main/DriverFlags.hs index 62e6524..b2db529 100644 --- a/ghc/compiler/main/DriverFlags.hs +++ b/ghc/compiler/main/DriverFlags.hs @@ -1,9 +1,8 @@ ----------------------------------------------------------------------------- --- $Id: DriverFlags.hs,v 1.111 2003/02/04 15:09:40 simonpj Exp $ -- -- Driver flags -- --- (c) Simon Marlow 2000 +-- (c) The University of Glasgow 2000-2003 -- ----------------------------------------------------------------------------- @@ -94,7 +93,7 @@ processOneArg action rest (dash_arg@('-':arg):args) = if rest /= "" then fio rest >> return args else case args of - [] -> unknownFlagErr dash_arg + [] -> missingArgErr dash_arg (arg1:args1) -> fio arg1 >> return args1 SepArg fio -> @@ -127,7 +126,7 @@ findArg :: [(String,OptKind)] -> String -> Maybe (String,OptKind) findArg spec arg = case [ (remove_spaces rest, k) | (pat,k) <- spec, - Just rest <- [my_prefix_match pat arg], + Just rest <- [maybePrefixMatch pat arg], arg_ok k rest arg ] of [] -> Nothing @@ -156,9 +155,8 @@ static_flags = , ( "-help" , NoArg showGhcUsage) , ( "-print-libdir" , NoArg (do getTopDir >>= putStrLn exitWith ExitSuccess)) - , ( "-version" , NoArg (do putStrLn (cProjectName - ++ ", version " ++ cProjectVersion) - exitWith ExitSuccess)) + , ( "V" , NoArg showVersion) + , ( "-version" , NoArg showVersion) , ( "-numeric-version", NoArg (do putStrLn cProjectVersion exitWith ExitSuccess)) @@ -179,6 +177,7 @@ static_flags = , ( "-make" , PassFlag (setMode DoMake)) , ( "-interactive" , PassFlag (setMode DoInteractive)) , ( "-mk-dll" , PassFlag (setMode DoMkDLL)) + , ( "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 @@ -225,6 +224,7 @@ static_flags = ------- Miscellaneous ----------------------------------------------- , ( "no-link-chk" , NoArg (return ()) ) -- ignored for backwards compat , ( "no-hs-main" , NoArg (writeIORef v_NoHsMain True) ) + , ( "main-is" , SepArg setMainIs ) ------- Output Redirection ------------------------------------------ , ( "odir" , HasArg (writeIORef v_Output_dir . Just) ) @@ -251,7 +251,7 @@ static_flags = then do writeIORef v_Split_object_files True add v_Opt_C "-fglobalise-toplev-names" else hPutStrLn stderr - "warning: don't know how to split \ + "warning: don't know how to split \ \object files on this architecture" ) ) @@ -279,13 +279,13 @@ static_flags = ------- Specific phases -------------------------------------------- , ( "pgmL" , HasArg setPgmL ) , ( "pgmP" , HasArg setPgmP ) - , ( "pgmP" , HasArg setPgmP ) , ( "pgmF" , HasArg setPgmF ) , ( "pgmc" , HasArg setPgmc ) , ( "pgmm" , HasArg setPgmm ) , ( "pgms" , HasArg setPgms ) , ( "pgma" , HasArg setPgma ) , ( "pgml" , HasArg setPgml ) + , ( "pgmdll" , HasArg setPgmDLL ) #ifdef ILX , ( "pgmI" , HasArg setPgmI ) , ( "pgmi" , HasArg setPgmi ) @@ -306,28 +306,11 @@ static_flags = , ( "Rghc-timing" , NoArg (enableTimingStats) ) ------ Compiler flags ----------------------------------------------- - , ( "O2-for-C" , NoArg (writeIORef v_minus_o2_for_C True) ) - , ( "O" , NoArg (setOptLevel 1)) - , ( "Onot" , NoArg (setOptLevel 0)) - , ( "O" , PrefixPred (all isDigit) (setOptLevel . read)) - , ( "fno-asm-mangling" , NoArg (writeIORef v_Do_asm_mangling False) ) - , ( "fmax-simplifier-iterations", - Prefix (writeIORef v_MaxSimplifierIterations . read) ) - - , ( "frule-check", - SepArg (\s -> writeIORef v_RuleCheck (Just s)) ) - , ( "fexcess-precision" , NoArg (do writeIORef v_Excess_precision True add v_Opt_C "-fexcess-precision")) - -- Optimisation flags are treated specially, so the normal - -- -fno-* pattern below doesn't work. We therefore allow - -- certain optimisation passes to be turned off explicitly: - , ( "fno-strictness" , NoArg (writeIORef v_Strictness False) ) - , ( "fno-cse" , NoArg (writeIORef v_CSE False) ) - -- All other "-fno-" options cancel out "-f" on the hsc cmdline , ( "fno-", PrefixPred (\s -> isStaticHscFlag ("f"++s)) (\s -> add v_Anti_opt_C ("-f"++s)) ) @@ -356,19 +339,8 @@ dynamic_flags = [ #endif ------ HsCpp opts --------------------------------------------------- - -- With a C compiler whose system() doesn't use a UNIX shell (i.e. - -- mingwin gcc), -D and -U args must *not* be quoted, as the quotes - -- will be interpreted as part of the arguments, and not stripped; - -- on all other systems, quoting is necessary, to avoid interpretation - -- of shell metacharacters in the arguments (e.g. green-card's - -- -DBEGIN_GHC_ONLY='}-' trick). -#ifndef mingw32_HOST_OS - , ( "D", Prefix (\s -> addOpt_P ("-D'"++s++"'") ) ) - , ( "U", Prefix (\s -> addOpt_P ("-U'"++s++"'") ) ) -#else - , ( "D", Prefix (\s -> addOpt_P ("-D"++s) ) ) - , ( "U", Prefix (\s -> addOpt_P ("-U"++s) ) ) -#endif + , ( "D", AnySuffix addOpt_P ) + , ( "U", AnySuffix addOpt_P ) ------ Debugging ---------------------------------------------------- , ( "dstg-stats", NoArg (writeIORef v_StgStats True) ) @@ -398,6 +370,7 @@ dynamic_flags = [ , ( "ddump-worker-wrapper", NoArg (setDynFlag Opt_D_dump_worker_wrapper) ) , ( "dshow-passes", NoArg (setVerbosity "2") ) , ( "ddump-rn-trace", NoArg (setDynFlag Opt_D_dump_rn_trace) ) + , ( "ddump-if-trace", NoArg (setDynFlag Opt_D_dump_if_trace) ) , ( "ddump-tc-trace", NoArg (setDynFlag Opt_D_dump_tc_trace) ) , ( "ddump-splices", NoArg (setDynFlag Opt_D_dump_splices) ) , ( "ddump-rn-stats", NoArg (setDynFlag Opt_D_dump_rn_stats) ) @@ -427,6 +400,19 @@ dynamic_flags = [ , ( "Wnot" , NoArg (mapM_ unSetDynFlag minusWallOpts) ) /* DEPREC */ , ( "w" , NoArg (mapM_ unSetDynFlag minusWallOpts) ) + ------ Optimisation flags ------------------------------------------ + , ( "O" , NoArg (setOptLevel 1)) + , ( "Onot" , NoArg (setOptLevel 0)) + , ( "O" , PrefixPred (all isDigit) (setOptLevel . read)) + + , ( "fmax-simplifier-iterations", + PrefixPred (all isDigit) + (\n -> updDynFlags (\dfs -> + dfs{ maxSimplIterations = read n })) ) + + , ( "frule-check", + SepArg (\s -> updDynFlags (\dfs -> dfs{ ruleCheck = Just s }))) + ------ Compiler flags ----------------------------------------------- , ( "fasm", AnySuffix (\_ -> setLang HscAsm) ) @@ -434,6 +420,9 @@ dynamic_flags = [ , ( "fvia-C", NoArg (setLang HscC) ) , ( "filx", NoArg (setLang HscILX) ) + , ( "fglasgow-exts", NoArg (mapM_ setDynFlag glasgowExtsFlags) ) + , ( "fno-glasgow-exts", NoArg (mapM_ unSetDynFlag glasgowExtsFlags) ) + -- "active negatives" , ( "fno-implicit-prelude", NoArg (setDynFlag Opt_NoImplicitPrelude) ) , ( "fno-monomorphism-restriction", @@ -461,17 +450,29 @@ fFlags = [ ( "warn-unused-imports", Opt_WarnUnusedImports ), ( "warn-unused-matches", Opt_WarnUnusedMatches ), ( "warn-deprecations", Opt_WarnDeprecations ), - ( "glasgow-exts", Opt_GlasgowExts ), ( "fi", Opt_FFI ), -- support `-ffi'... ( "ffi", Opt_FFI ), -- ...and also `-fffi' - ( "with", Opt_With ), -- with keyword + ( "arrows", Opt_Arrows ), -- arrow syntax ( "parr", Opt_PArr ), + ( "th", Opt_TH ), + ( "implicit-params", Opt_ImplicitParams ), ( "allow-overlapping-instances", Opt_AllowOverlappingInstances ), ( "allow-undecidable-instances", Opt_AllowUndecidableInstances ), ( "allow-incoherent-instances", Opt_AllowIncoherentInstances ), - ( "generics", Opt_Generics ) + ( "generics", Opt_Generics ), + ( "strictness", Opt_Strictness ), + ( "cse", Opt_CSE ), + ( "ignore-interface-pragmas", Opt_IgnoreInterfacePragmas ), + ( "omit-interface-pragmas", Opt_OmitInterfacePragmas ), + ( "do-lambda-eta-expansion", Opt_DoLambdaEtaExpansion ), + ( "ignore-asserts", Opt_IgnoreAsserts ), + ( "do-eta-reduction", Opt_DoEtaReduction ), + ( "case-merge", Opt_CaseMerge ), + ( "unbox-strict-fields", Opt_UnboxStrictFields ) ] +glasgowExtsFlags = [ Opt_GlasgowExts, Opt_FFI, Opt_TH, Opt_ImplicitParams ] + isFFlag f = f `elem` (map fst fFlags) getFFlag f = fromJust (lookup f fFlags) @@ -509,21 +510,10 @@ buildStaticHscOpts = do opt_C_ <- getStaticOpts v_Opt_C -- misc hsc opts from the command line - -- optimisation - minus_o <- readIORef v_OptLevel - let optimisation_opts = - case minus_o of - 0 -> hsc_minusNoO_flags - 1 -> hsc_minusO_flags - 2 -> hsc_minusO2_flags - n -> throwDyn (CmdLineError ("unknown optimisation level: " - ++ show n)) - -- ToDo: -Ofile - -- take into account -fno-* flags by removing the equivalent -f* -- flag from our list. anti_flags <- getStaticOpts v_Anti_opt_C - let basic_opts = opt_C_ ++ optimisation_opts + let basic_opts = opt_C_ filtered_opts = filter (`notElem` anti_flags) basic_opts static <- (do s <- readIORef v_Static; if s then return "-static" @@ -531,6 +521,21 @@ buildStaticHscOpts = do return ( static : filtered_opts ) +setMainIs :: String -> IO () +setMainIs arg + | not (null main_mod) -- The arg looked like "Foo.baz" + = do { writeIORef v_MainFunIs (Just main_fn) ; + writeIORef v_MainModIs (Just main_mod) } + + | isUpper (head main_fn) -- The arg looked like "Foo" + = writeIORef v_MainModIs (Just main_fn) + + | otherwise -- The arg looked like "baz" + = writeIORef v_MainFunIs (Just main_fn) + where + (main_mod, main_fn) = split_longest_prefix arg (== '.') + + ----------------------------------------------------------------------------- -- Via-C compilation stuff @@ -595,6 +600,9 @@ machdepCCOpts | prefixMatch "ia64" cTARGETPLATFORM = return ( [], ["-fomit-frame-pointer", "-G0"] ) + | prefixMatch "x86_64" cTARGETPLATFORM + = return ( [], ["-fomit-frame-pointer"] ) + | prefixMatch "mips" cTARGETPLATFORM = return ( ["-static"], [] ) @@ -641,3 +649,25 @@ setVerbosity n | otherwise = throwDyn (UsageError "can't parse verbosity flag (-v)") addCmdlineHCInclude a = updDynFlags (\s -> s{cmdlineHcIncludes = a : cmdlineHcIncludes s}) + +-- ----------------------------------------------------------------------------- +-- Version and usage messages + +showVersion :: IO () +showVersion = do + putStrLn (cProjectName ++ ", version " ++ cProjectVersion) + exitWith ExitSuccess + +showGhcUsage = do + (ghc_usage_path,ghci_usage_path) <- getUsageMsgPaths + mode <- readIORef v_GhcMode + let usage_path + | mode == DoInteractive = ghci_usage_path + | otherwise = ghc_usage_path + usage <- readFile usage_path + dump usage + exitWith ExitSuccess + where + dump "" = return () + dump ('$':'$':s) = hPutStr stderr progName >> dump s + dump (c:s) = hPutChar stderr c >> dump s