-----------------------------------------------------------------------------
--- $Id: DriverFlags.hs,v 1.119 2003/08/11 08:53:39 simonmar Exp $
--
-- Driver flags
--
--- (c) Simon Marlow 2000
+-- (c) The University of Glasgow 2000-2003
--
-----------------------------------------------------------------------------
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 ->
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
, ( "-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))
, ( "-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
------- 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 )
, ( "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-<blah>" options cancel out "-f<blah>" on the hsc cmdline
, ( "fno-", PrefixPred (\s -> isStaticHscFlag ("f"++s))
(\s -> add v_Anti_opt_C ("-f"++s)) )
, ( "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) )
, ( "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) )
, ( "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",
( "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)
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"
| prefixMatch "ia64" cTARGETPLATFORM
= return ( [], ["-fomit-frame-pointer", "-G0"] )
+ | prefixMatch "x86_64" cTARGETPLATFORM
+ = return ( [], ["-fomit-frame-pointer"] )
+
| prefixMatch "mips" cTARGETPLATFORM
= return ( ["-static"], [] )
| otherwise = throwDyn (UsageError "can't parse verbosity flag (-v<n>)")
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
projects / ghc-hetmet.git / blobdiff