X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FDriverFlags.hs;h=701f2ba586e4b54269f5b366bdfc728c1fa87504;hb=98688c6e8fd33f31c51218cf93cbf03fe3a5e73d;hp=22e416a312f6239e277741242e0a64a84f1023be;hpb=ef271579634228a7a5586baa61977e1db9a53aec;p=ghc-hetmet.git diff --git a/ghc/compiler/main/DriverFlags.hs b/ghc/compiler/main/DriverFlags.hs index 22e416a..701f2ba 100644 --- a/ghc/compiler/main/DriverFlags.hs +++ b/ghc/compiler/main/DriverFlags.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $Id: DriverFlags.hs,v 1.115 2003/05/27 12:40:19 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,28 +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", - PrefixPred (all isDigit) (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)) ) @@ -387,6 +371,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) ) @@ -416,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) ) @@ -423,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", @@ -450,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) @@ -498,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" @@ -520,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 @@ -584,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"], [] ) @@ -630,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