X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FDriverFlags.hs;h=701f2ba586e4b54269f5b366bdfc728c1fa87504;hb=98688c6e8fd33f31c51218cf93cbf03fe3a5e73d;hp=4c110c0b4e21cc5950a8ff1da487ada392fc61d8;hpb=1a4238bccc8be8a71f8ebec15f25d8edf8d084ad;p=ghc-hetmet.git diff --git a/ghc/compiler/main/DriverFlags.hs b/ghc/compiler/main/DriverFlags.hs index 4c110c0..701f2ba 100644 --- a/ghc/compiler/main/DriverFlags.hs +++ b/ghc/compiler/main/DriverFlags.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $Id: DriverFlags.hs,v 1.110 2003/01/09 11:39:20 simonmar Exp $ +-- $Id: DriverFlags.hs,v 1.127 2003/10/09 11:58:56 simonpj Exp $ -- -- Driver flags -- @@ -127,7 +127,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 +156,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 +178,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 +225,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 +252,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" ) ) @@ -306,31 +307,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)) ) - - , ( "fusagesp" , NoArg (do writeIORef v_UsageSPInf True - add v_Opt_C "-fusagesp-on") ) - , ( "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)) ) @@ -359,19 +340,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) ) @@ -397,11 +367,11 @@ dynamic_flags = [ , ( "ddump-tc", NoArg (setDynFlag Opt_D_dump_tc) ) , ( "ddump-types", NoArg (setDynFlag Opt_D_dump_types) ) , ( "ddump-rules", NoArg (setDynFlag Opt_D_dump_rules) ) - , ( "ddump-usagesp", NoArg (setDynFlag Opt_D_dump_usagesp) ) , ( "ddump-cse", NoArg (setDynFlag Opt_D_dump_cse) ) , ( "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) ) @@ -417,7 +387,6 @@ dynamic_flags = [ , ( "ddump-vect", NoArg (setDynFlag Opt_D_dump_vect) ) , ( "dcore-lint", NoArg (setDynFlag Opt_DoCoreLinting) ) , ( "dstg-lint", NoArg (setDynFlag Opt_DoStgLinting) ) - , ( "dusagesp-lint", NoArg (setDynFlag Opt_DoUSPLinting) ) ------ Machine dependant (-m) stuff --------------------------- @@ -432,6 +401,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) ) @@ -439,6 +421,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", @@ -466,17 +451,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) @@ -514,21 +511,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" @@ -536,6 +522,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 @@ -600,6 +601,9 @@ machdepCCOpts | prefixMatch "ia64" cTARGETPLATFORM = return ( [], ["-fomit-frame-pointer", "-G0"] ) + | prefixMatch "x86_64" cTARGETPLATFORM + = return ( [], ["-fomit-frame-pointer"] ) + | prefixMatch "mips" cTARGETPLATFORM = return ( ["-static"], [] ) @@ -646,3 +650,8 @@ setVerbosity n | otherwise = throwDyn (UsageError "can't parse verbosity flag (-v)") addCmdlineHCInclude a = updDynFlags (\s -> s{cmdlineHcIncludes = a : cmdlineHcIncludes s}) + +showVersion :: IO () +showVersion = do + putStrLn (cProjectName ++ ", version " ++ cProjectVersion) + exitWith ExitSuccess