DriverFlags.hs 26.7 KB
Newer Older
1 2 3 4
-----------------------------------------------------------------------------
--
-- Driver flags
--
5
-- (c) The University of Glasgow 2000-2003
6 7 8
--
-----------------------------------------------------------------------------

9 10
module DriverFlags ( 
	processArgs, OptKind(..), static_flags, dynamic_flags, 
11
	addCmdlineHCInclude,
12 13 14
	buildStaticHscOpts, 
	machdepCCOpts
  ) where
15 16

#include "HsVersions.h"
17
#include "../includes/ghcconfig.h"
18

19
import MkIface		( showIface )
20
import DriverState
21
import DriverPhases
22
import DriverUtil
23
import SysTools
24 25 26
import CmdLineOpts
import Config
import Util
27 28
import Panic

29 30
import EXCEPTION
import DATA_IOREF	( readIORef, writeIORef )
31

32
import System		( exitWith, ExitCode(..) )
33
import IO
34
import Maybe
35
import Monad
36 37 38 39 40 41 42 43 44
import Char

-----------------------------------------------------------------------------
-- Flags

-- Flag parsing is now done in stages:
--
--     * parse the initial list of flags and remove any flags understood
--	 by the driver only.  Determine whether we're in multi-compilation
45
--	 or single-compilation mode (done in Main.main).
46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71
--
--     * gather the list of "static" hsc flags, and assign them to the global
--	 static hsc flags variable.
--
--     * build the inital DynFlags from the remaining flags.
--
--     * complain if we've got any flags left over.
--
--     * for each source file: grab the OPTIONS, and build a new DynFlags
--       to pass to the compiler.

-----------------------------------------------------------------------------
-- Process command-line  

data OptKind
	= NoArg (IO ()) 		    -- flag with no argument
	| HasArg (String -> IO ())	    -- flag has an argument (maybe prefix)
	| SepArg (String -> IO ())	    -- flag has a separate argument
	| Prefix (String -> IO ())	    -- flag is a prefix only
	| OptPrefix (String -> IO ())       -- flag may be a prefix
	| AnySuffix (String -> IO ())       -- flag is a prefix, pass whole arg to fn
	| PassFlag  (String -> IO ())       -- flag with no arg, pass flag to fn
	| PrefixPred (String -> Bool) (String -> IO ())
	| AnySuffixPred (String -> Bool) (String -> IO ())

processArgs :: [(String,OptKind)] -> [String] -> [String]
72
	    -> IO [String]  -- returns spare args
73
processArgs _spec [] spare = return (reverse spare)
74

75
processArgs spec args@(('-':arg):args') spare = do
76
  case findArg spec arg of
77 78
    Just (rest,action) -> do args' <- processOneArg action rest args
			     processArgs spec args' spare
79 80
    Nothing	       -> processArgs spec args' (('-':arg):spare)

81 82 83 84 85 86 87 88 89 90 91 92 93 94 95
processArgs spec (arg:args) spare = 
  processArgs spec args (arg:spare)

processOneArg :: OptKind -> String -> [String] -> IO [String]
processOneArg action rest (dash_arg@('-':arg):args) =
  case action of
	NoArg  io -> 
		if rest == ""
			then io >> return args
			else unknownFlagErr dash_arg

	HasArg fio -> 
		if rest /= "" 
			then fio rest >> return args
			else case args of
96
				[] -> missingArgErr dash_arg
97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126
				(arg1:args1) -> fio arg1 >> return args1

	SepArg fio -> 
		case args of
			[] -> unknownFlagErr dash_arg
			(arg1:args1) -> fio arg1 >> return args1

	Prefix fio -> 
		if rest /= ""
			then fio rest >> return args
			else unknownFlagErr dash_arg
	
	PrefixPred p fio -> 
		if rest /= ""
			then fio rest >> return args
			else unknownFlagErr dash_arg
	
	OptPrefix fio       -> fio rest >> return args

	AnySuffix fio       -> fio dash_arg >> return args

	AnySuffixPred p fio -> fio dash_arg >> return args

	PassFlag fio  -> 
		if rest /= ""
			then unknownFlagErr dash_arg
			else fio dash_arg >> return args

findArg :: [(String,OptKind)] -> String -> Maybe (String,OptKind)
findArg spec arg
127
  = case [ (remove_spaces rest, k) 
128
	 | (pat,k)   <- spec, 
129
	   Just rest <- [maybePrefixMatch pat arg],
130
	   arg_ok k rest arg ] 
131 132 133 134 135 136 137
    of
	[]      -> Nothing
	(one:_) -> Just one

arg_ok (NoArg _)            rest arg = null rest
arg_ok (HasArg _)           rest arg = True
arg_ok (SepArg _)           rest arg = null rest
sof's avatar
sof committed
138 139
arg_ok (Prefix _)	    rest arg = notNull rest
arg_ok (PrefixPred p _)     rest arg = notNull rest && p rest
140 141
arg_ok (OptPrefix _)	    rest arg = True
arg_ok (PassFlag _)         rest arg = null rest 
142 143
arg_ok (AnySuffix _)        rest arg = True
arg_ok (AnySuffixPred p _)  rest arg = p arg
144 145 146 147 148 149 150 151 152

-----------------------------------------------------------------------------
-- Static flags

-- note that ordering is important in the following list: any flag which
-- is a prefix flag (i.e. HasArg, Prefix, OptPrefix, AnySuffix) will override
-- flags further down the list with the same prefix.

static_flags = 
153 154 155 156 157
  [  ------- help / version ----------------------------------------------
     ( "?"    		 , NoArg showGhcUsage)
  ,  ( "-help"	 	 , NoArg showGhcUsage)
  ,  ( "-print-libdir"   , NoArg (do getTopDir >>= putStrLn
				     exitWith ExitSuccess))  
158 159
  ,  ( "V"	 	 , NoArg showVersion)
  ,  ( "-version"	 , NoArg showVersion)
160
  ,  ( "-numeric-version", NoArg (do putStrLn cProjectVersion
161 162
				     exitWith ExitSuccess))

163 164 165 166
      ------- interfaces ----------------------------------------------------
  ,  ( "-show-iface"     , HasArg (\f -> do showIface f
					    exitWith ExitSuccess))

167
      ------- verbosity ----------------------------------------------------
168
  ,  ( "n"              , NoArg setDryRun )
169

170 171 172 173 174 175 176 177 178 179
      ------- primary modes ------------------------------------------------
  ,  ( "M"		, PassFlag (setMode DoMkDependHS))
  ,  ( "E"		, PassFlag (setMode (StopBefore Hsc)))
  ,  ( "C"		, PassFlag (\f -> do setMode (StopBefore HCc) f
					     setLang HscC))
  ,  ( "S"		, PassFlag (setMode (StopBefore As)))
  ,  ( "c"		, PassFlag (setMode (StopBefore Ln)))
  ,  ( "-make"		, PassFlag (setMode DoMake))
  ,  ( "-interactive"	, PassFlag (setMode DoInteractive))
  ,  ( "-mk-dll"	, PassFlag (setMode DoMkDLL))
180
  ,  ( "e"              , HasArg   (\s -> setMode (DoEval s) "-e"))
181 182 183 184 185 186

	-- -fno-code says to stop after Hsc but don't generate any code.
  ,  ( "fno-code"	, PassFlag (\f -> do setMode (StopBefore HCc) f
				             setLang HscNothing
				             writeIORef v_Recomp False))

187 188 189 190
	------- GHCi -------------------------------------------------------
  ,  ( "ignore-dot-ghci", NoArg (writeIORef v_Read_DotGHCi False) )
  ,  ( "read-dot-ghci"  , NoArg (writeIORef v_Read_DotGHCi True) )

191
	------- recompilation checker --------------------------------------
192 193
  ,  ( "recomp"		, NoArg (writeIORef v_Recomp True) )
  ,  ( "no-recomp"  	, NoArg (writeIORef v_Recomp False) )
194 195

	------- ways --------------------------------------------------------
196 197 198 199 200 201 202
  ,  ( "prof"		, NoArg (addNoDups v_Ways	WayProf) )
  ,  ( "unreg"		, NoArg (addNoDups v_Ways	WayUnreg) )
  ,  ( "ticky"		, NoArg (addNoDups v_Ways	WayTicky) )
  ,  ( "parallel"	, NoArg (addNoDups v_Ways	WayPar) )
  ,  ( "gransim"	, NoArg (addNoDups v_Ways	WayGran) )
  ,  ( "smp"		, NoArg (addNoDups v_Ways	WaySMP) )
  ,  ( "debug"		, NoArg (addNoDups v_Ways	WayDebug) )
chak's avatar
chak committed
203
  ,  ( "ndp"		, NoArg (addNoDups v_Ways	WayNDP) )
204
  ,  ( "threaded"	, NoArg (addNoDups v_Ways	WayThreaded) )
205 206
 	-- ToDo: user ways

207 208
	------ RTS ways -----------------------------------------------------

209
	------ Debugging ----------------------------------------------------
210 211 212
  ,  ( "dppr-noprags",     PassFlag (add v_Opt_C) )
  ,  ( "dppr-debug",       PassFlag (add v_Opt_C) )
  ,  ( "dppr-user-length", AnySuffix (add v_Opt_C) )
213 214 215
      -- rest of the debugging flags are dynamic

	--------- Profiling --------------------------------------------------
216 217 218 219
  ,  ( "auto-dicts"	, NoArg (add v_Opt_C "-fauto-sccs-on-dicts") )
  ,  ( "auto-all"	, NoArg (add v_Opt_C "-fauto-sccs-on-all-toplevs") )
  ,  ( "auto"		, NoArg (add v_Opt_C "-fauto-sccs-on-exported-toplevs") )
  ,  ( "caf-all"	, NoArg (add v_Opt_C "-fauto-sccs-on-individual-cafs") )
220 221
         -- "ignore-sccs"  doesn't work  (ToDo)

222 223 224 225
  ,  ( "no-auto-dicts"	, NoArg (add v_Anti_opt_C "-fauto-sccs-on-dicts") )
  ,  ( "no-auto-all"	, NoArg (add v_Anti_opt_C "-fauto-sccs-on-all-toplevs") )
  ,  ( "no-auto"	, NoArg (add v_Anti_opt_C "-fauto-sccs-on-exported-toplevs") )
  ,  ( "no-caf-all"	, NoArg (add v_Anti_opt_C "-fauto-sccs-on-individual-cafs") )
226 227 228

	------- Miscellaneous -----------------------------------------------
  ,  ( "no-link-chk"    , NoArg (return ()) ) -- ignored for backwards compat
rrt's avatar
rrt committed
229
  ,  ( "no-hs-main"     , NoArg (writeIORef v_NoHsMain True) )
230
  ,  ( "main-is"   	, SepArg setMainIs )
231 232

	------- Output Redirection ------------------------------------------
233 234
  ,  ( "odir"		, HasArg (writeIORef v_Output_dir  . Just) )
  ,  ( "o"		, SepArg (writeIORef v_Output_file . Just) )
235
  ,  ( "osuf"		, HasArg (writeIORef v_Object_suf) )
236
  ,  ( "hcsuf"		, HasArg (writeIORef v_HC_suf      . Just) )
237
  ,  ( "hisuf"		, HasArg (writeIORef v_Hi_suf) )
238
  ,  ( "hidir"		, HasArg (writeIORef v_Hi_dir . Just) )
239
  ,  ( "buildtag"	, HasArg (writeIORef v_Build_tag) )
240
  ,  ( "tmpdir"		, HasArg setTmpDir)
241
  ,  ( "ohi"		, HasArg (writeIORef v_Output_hi   . Just) )
242 243
	-- -odump?

244 245 246
  ,  ( "keep-hc-file"   , AnySuffix (\_ -> writeIORef v_Keep_hc_files True) )
  ,  ( "keep-s-file"    , AnySuffix (\_ -> writeIORef v_Keep_s_files  True) )
  ,  ( "keep-raw-s-file", AnySuffix (\_ -> writeIORef v_Keep_raw_s_files  True) )
sof's avatar
sof committed
247
#ifdef ILX
rrt's avatar
rrt committed
248
  ,  ( "keep-il-file"   , AnySuffix (\_ -> writeIORef v_Keep_il_files True) )
sof's avatar
sof committed
249 250
  ,  ( "keep-ilx-file"  , AnySuffix (\_ -> writeIORef v_Keep_ilx_files True) )
#endif
251
  ,  ( "keep-tmp-files" , AnySuffix (\_ -> writeIORef v_Keep_tmp_files True) )
252 253

  ,  ( "split-objs"	, NoArg (if can_split
254 255
				    then do writeIORef v_Split_object_files True
					    add v_Opt_C "-fglobalise-toplev-names"
256
				    else hPutStrLn stderr
257
					    "warning: don't know how to split object files on this architecture"
258
				) )
259

260
	------- Include/Import Paths ----------------------------------------
261
  ,  ( "i"		, OptPrefix (addToOrDeleteDirList v_Import_paths) )
262
  ,  ( "I" 		, Prefix    (addToDirList v_Include_paths) )
263 264

	------- Libraries ---------------------------------------------------
265
  ,  ( "L"		, Prefix (addToDirList v_Library_paths) )
266
  ,  ( "l"		, AnySuffix (\s -> add v_Opt_l s >> add v_Opt_dll s) )
267

268 269 270 271 272 273
#ifdef darwin_TARGET_OS
	------- Frameworks --------------------------------------------------
        -- -framework-path should really be -F ...
  ,  ( "framework-path" , HasArg (addToDirList v_Framework_paths) )
  ,  ( "framework"	, HasArg (add v_Cmdline_frameworks) )
#endif
274
        ------- Packages ----------------------------------------------------
275
  ,  ( "package-name"   , HasArg (\s -> add v_Opt_C ("-inpackage="++s)) )
276

277
  ,  ( "package-conf"   , HasArg (readPackageConf) )
278 279 280 281
  ,  ( "package"        , HasArg (addPackage) )
  ,  ( "syslib"         , HasArg (addPackage) )	-- for compatibility w/ old vsns

        ------- Specific phases  --------------------------------------------
282 283
  ,  ( "pgmL"           , HasArg setPgmL )
  ,  ( "pgmP"           , HasArg setPgmP )
284 285 286 287 288 289
  ,  ( "pgmF"           , HasArg setPgmF )
  ,  ( "pgmc"           , HasArg setPgmc )
  ,  ( "pgmm"           , HasArg setPgmm )
  ,  ( "pgms"           , HasArg setPgms )
  ,  ( "pgma"           , HasArg setPgma )
  ,  ( "pgml"           , HasArg setPgml )
290
  ,  ( "pgmdll"		, HasArg setPgmDLL )
291 292 293 294
#ifdef ILX
  ,  ( "pgmI"           , HasArg setPgmI )
  ,  ( "pgmi"           , HasArg setPgmi )
#endif
295 296 297 298

  ,  ( "optdep"		, HasArg (add v_Opt_dep) )
  ,  ( "optl"		, HasArg (add v_Opt_l) )
  ,  ( "optdll"		, HasArg (add v_Opt_dll) )
299 300

	----- Linker --------------------------------------------------------
301
  ,  ( "no-link"	, NoArg (writeIORef v_NoLink True) )
302
  ,  ( "static" 	, NoArg (writeIORef v_Static True) )
rrt's avatar
rrt committed
303
  ,  ( "dynamic"        , NoArg (writeIORef v_Static False) )
rrt's avatar
rrt committed
304
  ,  ( "rdynamic"       , NoArg (return ()) ) -- ignored for compat w/ gcc
305

306 307
	----- RTS opts ------------------------------------------------------
  ,  ( "H"                 , HasArg (setHeapSize . fromIntegral . decodeSize) )
308
  ,  ( "Rghc-timing"	   , NoArg  (enableTimingStats) )
309

310
        ------ Compiler flags -----------------------------------------------
311
  ,  ( "fno-asm-mangling"  , NoArg (writeIORef v_Do_asm_mangling False) )
312

313 314
  ,  ( "fexcess-precision" , NoArg (do writeIORef v_Excess_precision True
				       add v_Opt_C "-fexcess-precision"))
315 316 317

	-- All other "-fno-<blah>" options cancel out "-f<blah>" on the hsc cmdline
  ,  ( "fno-",			PrefixPred (\s -> isStaticHscFlag ("f"++s))
318
				    (\s -> add v_Anti_opt_C ("-f"++s)) )
319 320

	-- Pass all remaining "-f<blah>" options to hsc
321
  ,  ( "f", 			AnySuffixPred (isStaticHscFlag) (add v_Opt_C) )
322 323 324 325
  ]

dynamic_flags = [

326
     ( "cpp",		NoArg  (updDynFlags (\s -> s{ cppFlag = True })) )
sof's avatar
sof committed
327
  ,  ( "F",             NoArg  (updDynFlags (\s -> s{ ppFlag = True })) )
328 329
  ,  ( "#include",	HasArg (addCmdlineHCInclude) )

330 331
  ,  ( "v",		OptPrefix (setVerbosity) )

332 333
  ,  ( "optL",		HasArg (addOpt_L) )
  ,  ( "optP",		HasArg (addOpt_P) )
sof's avatar
sof committed
334
  ,  ( "optF",          HasArg (addOpt_F) )
335 336 337
  ,  ( "optc",		HasArg (addOpt_c) )
  ,  ( "optm",		HasArg (addOpt_m) )
  ,  ( "opta",		HasArg (addOpt_a) )
rrt's avatar
rrt committed
338 339 340 341
#ifdef ILX
  ,  ( "optI",		HasArg (addOpt_I) )
  ,  ( "opti",		HasArg (addOpt_i) )
#endif
342 343

	------ HsCpp opts ---------------------------------------------------
344 345
  ,  ( "D",		AnySuffix addOpt_P )
  ,  ( "U",		AnySuffix addOpt_P )
346 347

	------ Debugging ----------------------------------------------------
348
  ,  ( "dstg-stats",	NoArg (writeIORef v_StgStats True) )
349

350
  ,  ( "ddump-cmm",         	 NoArg (setDynFlag Opt_D_dump_cmm) )
351 352 353 354 355 356 357 358 359 360 361 362 363
  ,  ( "ddump-asm",          	 NoArg (setDynFlag Opt_D_dump_asm) )
  ,  ( "ddump-cpranal",      	 NoArg (setDynFlag Opt_D_dump_cpranal) )
  ,  ( "ddump-deriv",        	 NoArg (setDynFlag Opt_D_dump_deriv) )
  ,  ( "ddump-ds",           	 NoArg (setDynFlag Opt_D_dump_ds) )
  ,  ( "ddump-flatC",        	 NoArg (setDynFlag Opt_D_dump_flatC) )
  ,  ( "ddump-foreign",      	 NoArg (setDynFlag Opt_D_dump_foreign) )
  ,  ( "ddump-inlinings",    	 NoArg (setDynFlag Opt_D_dump_inlinings) )
  ,  ( "ddump-occur-anal",   	 NoArg (setDynFlag Opt_D_dump_occur_anal) )
  ,  ( "ddump-parsed",       	 NoArg (setDynFlag Opt_D_dump_parsed) )
  ,  ( "ddump-rn",           	 NoArg (setDynFlag Opt_D_dump_rn) )
  ,  ( "ddump-simpl",        	 NoArg (setDynFlag Opt_D_dump_simpl) )
  ,  ( "ddump-simpl-iterations", NoArg (setDynFlag Opt_D_dump_simpl_iterations) )
  ,  ( "ddump-spec",         	 NoArg (setDynFlag Opt_D_dump_spec) )
364
  ,  ( "ddump-prep",          	 NoArg (setDynFlag Opt_D_dump_prep) )
365 366 367 368 369 370 371
  ,  ( "ddump-stg",          	 NoArg (setDynFlag Opt_D_dump_stg) )
  ,  ( "ddump-stranal",      	 NoArg (setDynFlag Opt_D_dump_stranal) )
  ,  ( "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-cse",          	 NoArg (setDynFlag Opt_D_dump_cse) )
  ,  ( "ddump-worker-wrapper",   NoArg (setDynFlag Opt_D_dump_worker_wrapper) )
372
  ,  ( "dshow-passes",           NoArg (setVerbosity "2") )
373
  ,  ( "ddump-rn-trace",         NoArg (setDynFlag Opt_D_dump_rn_trace) )
374
  ,  ( "ddump-if-trace",         NoArg (setDynFlag Opt_D_dump_if_trace) )
375
  ,  ( "ddump-tc-trace",         NoArg (setDynFlag Opt_D_dump_tc_trace) )
376
  ,  ( "ddump-splices",          NoArg (setDynFlag Opt_D_dump_splices) )
377
  ,  ( "ddump-rn-stats",         NoArg (setDynFlag Opt_D_dump_rn_stats) )
378
  ,  ( "ddump-opt-cmm",          NoArg (setDynFlag Opt_D_dump_opt_cmm) )
379
  ,  ( "ddump-simpl-stats",      NoArg (setDynFlag Opt_D_dump_simpl_stats) )
380
  ,  ( "ddump-bcos",             NoArg (setDynFlag Opt_D_dump_BCOs) )
381 382 383 384
  ,  ( "dsource-stats",          NoArg (setDynFlag Opt_D_source_stats) )
  ,  ( "dverbose-core2core",     NoArg (setDynFlag Opt_D_verbose_core2core) )
  ,  ( "dverbose-stg2stg",       NoArg (setDynFlag Opt_D_verbose_stg2stg) )
  ,  ( "ddump-hi-diffs",         NoArg (setDynFlag Opt_D_dump_hi_diffs) )
385
  ,  ( "ddump-hi",               NoArg (setDynFlag Opt_D_dump_hi) )
386
  ,  ( "ddump-minimal-imports",  NoArg (setDynFlag Opt_D_dump_minimal_imports) )
chak's avatar
chak committed
387
  ,  ( "ddump-vect",         	 NoArg (setDynFlag Opt_D_dump_vect) )
388 389
  ,  ( "dcore-lint",       	 NoArg (setDynFlag Opt_DoCoreLinting) )
  ,  ( "dstg-lint",        	 NoArg (setDynFlag Opt_DoStgLinting) )
390
  ,  ( "dcmm-lint",		 NoArg (setDynFlag Opt_DoCmmLinting) )
391 392 393

	------ Machine dependant (-m<blah>) stuff ---------------------------

394 395 396
  ,  ( "monly-2-regs", 	NoArg (updDynFlags (\s -> s{stolen_x86_regs = 2}) ))
  ,  ( "monly-3-regs", 	NoArg (updDynFlags (\s -> s{stolen_x86_regs = 3}) ))
  ,  ( "monly-4-regs", 	NoArg (updDynFlags (\s -> s{stolen_x86_regs = 4}) ))
397

398 399
	------ Warning opts -------------------------------------------------
  ,  ( "W"		, NoArg (mapM_ setDynFlag   minusWOpts)    )
400
  ,  ( "Werror"		, NoArg (setDynFlag   	    Opt_WarnIsError) )
401 402 403 404
  ,  ( "Wall"		, NoArg (mapM_ setDynFlag   minusWallOpts) )
  ,  ( "Wnot"		, NoArg (mapM_ unSetDynFlag minusWallOpts) ) /* DEPREC */
  ,  ( "w"		, NoArg (mapM_ unSetDynFlag minusWallOpts) )

405 406 407 408 409 410 411 412 413 414 415 416 417
	------ 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 })))

418 419
        ------ Compiler flags -----------------------------------------------

420 421 422
  ,  ( "fasm",		AnySuffix (\_ -> setLang HscAsm) )
  ,  ( "fvia-c",	NoArg (setLang HscC) )
  ,  ( "fvia-C",	NoArg (setLang HscC) )
423
  ,  ( "filx",		NoArg (setLang HscILX) )
424

425 426 427
  ,  ( "fglasgow-exts",    NoArg (mapM_ setDynFlag   glasgowExtsFlags) )
  ,  ( "fno-glasgow-exts", NoArg (mapM_ unSetDynFlag glasgowExtsFlags) )

428 429
	-- "active negatives"
  ,  ( "fno-implicit-prelude",  NoArg (setDynFlag Opt_NoImplicitPrelude) )
430 431
  ,  ( "fno-monomorphism-restriction",	
			NoArg (setDynFlag Opt_NoMonomorphismRestriction) )
432

433 434
	-- the rest of the -f* and -fno-* flags
  ,  ( "fno-", 		PrefixPred (\f -> isFFlag f) (\f -> unSetDynFlag (getFFlag f)) )
435
  ,  ( "f",		PrefixPred (\f -> isFFlag f) (\f -> setDynFlag (getFFlag f)) )
436
 ]
437

438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454
-- these -f<blah> flags can all be reversed with -fno-<blah>

fFlags = [
  ( "warn-duplicate-exports",    	Opt_WarnDuplicateExports ),
  ( "warn-hi-shadowing",         	Opt_WarnHiShadows ),
  ( "warn-incomplete-patterns",  	Opt_WarnIncompletePatterns ),
  ( "warn-missing-fields",       	Opt_WarnMissingFields ),
  ( "warn-missing-methods",      	Opt_WarnMissingMethods ),
  ( "warn-missing-signatures",   	Opt_WarnMissingSigs ),
  ( "warn-name-shadowing",       	Opt_WarnNameShadowing ),
  ( "warn-overlapping-patterns", 	Opt_WarnOverlappingPatterns ),
  ( "warn-simple-patterns",      	Opt_WarnSimplePatterns ),
  ( "warn-type-defaults",        	Opt_WarnTypeDefaults ),
  ( "warn-unused-binds",         	Opt_WarnUnusedBinds ),
  ( "warn-unused-imports",       	Opt_WarnUnusedImports ),
  ( "warn-unused-matches",       	Opt_WarnUnusedMatches ),
  ( "warn-deprecations",         	Opt_WarnDeprecations ),
chak's avatar
chak committed
455 456
  ( "fi",				Opt_FFI ),  -- support `-ffi'...
  ( "ffi",				Opt_FFI ),  -- ...and also `-fffi'
457
  ( "arrows",				Opt_Arrows ), -- arrow syntax
chak's avatar
chak committed
458
  ( "parr",				Opt_PArr ),
459 460
  ( "th",				Opt_TH ),
  ( "implicit-params",			Opt_ImplicitParams ),
461 462
  ( "allow-overlapping-instances", 	Opt_AllowOverlappingInstances ),
  ( "allow-undecidable-instances", 	Opt_AllowUndecidableInstances ),
463
  ( "allow-incoherent-instances", 	Opt_AllowIncoherentInstances ),
464 465
  ( "generics",  			Opt_Generics ),
  ( "strictness",			Opt_Strictness ),
466
  ( "full-laziness",			Opt_FullLaziness ),
467 468 469 470 471 472 473 474
  ( "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 )
475
  ]
476

477 478
glasgowExtsFlags = [ Opt_GlasgowExts, Opt_FFI, Opt_TH, Opt_ImplicitParams ]

479 480
isFFlag f = f `elem` (map fst fFlags)
getFFlag f = fromJust (lookup f fFlags)
481 482 483 484 485 486 487 488 489 490

-----------------------------------------------------------------------------
-- convert sizes like "3.5M" into integers

decodeSize :: String -> Integer
decodeSize str
  | c == ""		 = truncate n
  | c == "K" || c == "k" = truncate (n * 1000)
  | c == "M" || c == "m" = truncate (n * 1000 * 1000)
  | c == "G" || c == "g" = truncate (n * 1000 * 1000 * 1000)
491
  | otherwise            = throwDyn (CmdLineError ("can't decode size: " ++ str))
492 493 494 495
  where (m, c) = span pred str
        n      = read m  :: Double
	pred c = isDigit c || c == '.'

496 497 498 499

-----------------------------------------------------------------------------
-- RTS Hooks

500 501 502 503
#if __GLASGOW_HASKELL__ >= 504
foreign import ccall unsafe "setHeapSize"       setHeapSize       :: Int -> IO ()
foreign import ccall unsafe "enableTimingStats" enableTimingStats :: IO ()
#else
504 505
foreign import "setHeapSize"       unsafe setHeapSize       :: Int -> IO ()
foreign import "enableTimingStats" unsafe enableTimingStats :: IO ()
506
#endif
507

508 509 510
-----------------------------------------------------------------------------
-- Build the Hsc static command line opts

511 512
buildStaticHscOpts :: IO [String]
buildStaticHscOpts = do
513

514
  opt_C_ <- getStaticOpts v_Opt_C	-- misc hsc opts from the command line
515 516 517

	-- take into account -fno-* flags by removing the equivalent -f*
	-- flag from our list.
518
  anti_flags <- getStaticOpts v_Anti_opt_C
519
  let basic_opts = opt_C_
520 521
      filtered_opts = filter (`notElem` anti_flags) basic_opts

522 523
  static <- (do s <- readIORef v_Static; if s then return "-static" 
					      else return "")
524

525
  return ( static : filtered_opts )
526

527 528 529 530 531 532 533 534 535 536 537 538 539 540 541
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 (== '.')
  

542 543 544 545 546 547 548 549 550
-----------------------------------------------------------------------------
-- Via-C compilation stuff

-- flags returned are: ( all C compilations
--		       , registerised HC compilations
--		       )

machdepCCOpts 
   | prefixMatch "alpha"   cTARGETPLATFORM  
ken's avatar
ken committed
551 552 553 554 555
	= return ( ["-static", "-w", "-mieee"
#ifdef HAVE_THREADED_RTS_SUPPORT
		    , "-D_REENTRANT"
#endif
		   ], [] )
ken's avatar
ken committed
556 557 558
	-- For now, to suppress the gcc warning "call-clobbered
	-- register used for global register variable", we simply
	-- disable all warnings altogether using the -w flag. Oh well.
559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583

   | prefixMatch "hppa"    cTARGETPLATFORM  
        -- ___HPUX_SOURCE, not _HPUX_SOURCE, is #defined if -ansi!
        -- (very nice, but too bad the HP /usr/include files don't agree.)
	= return ( ["-static", "-D_HPUX_SOURCE"], [] )

   | prefixMatch "m68k"    cTARGETPLATFORM
      -- -fno-defer-pop : for the .hc files, we want all the pushing/
      --    popping of args to routines to be explicit; if we let things
      --    be deferred 'til after an STGJUMP, imminent death is certain!
      --
      -- -fomit-frame-pointer : *don't*
      --     It's better to have a6 completely tied up being a frame pointer
      --     rather than let GCC pick random things to do with it.
      --     (If we want to steal a6, then we would try to do things
      --     as on iX86, where we *do* steal the frame pointer [%ebp].)
	= return ( [], ["-fno-defer-pop", "-fno-omit-frame-pointer"] )

   | prefixMatch "i386"    cTARGETPLATFORM  
      -- -fno-defer-pop : basically the same game as for m68k
      --
      -- -fomit-frame-pointer : *must* in .hc files; because we're stealing
      --   the fp (%ebp) for our register maps.
	= do n_regs <- dynFlag stolen_x86_regs
	     sta    <- readIORef v_Static
sof's avatar
sof committed
584 585 586
	     return ( [ if sta then "-DDONT_WANT_WIN32_DLL_SUPPORT" else ""
--                    , if suffixMatch "mingw32" cTARGETPLATFORM then "-mno-cygwin" else "" 
		      ],
587 588 589 590 591 592 593 594 595
		      [ "-fno-defer-pop",
#ifdef HAVE_GCC_MNO_OMIT_LFPTR
			-- Some gccs are configured with
			-- -momit-leaf-frame-pointer on by default, and it
			-- apparently takes precedence over 
			-- -fomit-frame-pointer, so we disable it first here.
			"-mno-omit-leaf-frame-pointer",
#endif
			"-fomit-frame-pointer",
596 597 598 599
			-- we want -fno-builtin, because when gcc inlines
			-- built-in functions like memcpy() it tends to
			-- run out of registers, requiring -monly-n-regs
			"-fno-builtin",
600 601 602
	                "-DSTOLEN_X86_REGS="++show n_regs ]
		    )

603 604 605
   | prefixMatch "ia64"    cTARGETPLATFORM  
	= return ( [], ["-fomit-frame-pointer", "-G0"] )

606 607 608
   | prefixMatch "x86_64"  cTARGETPLATFORM
	= return ( [], ["-fomit-frame-pointer"] )

609
   | prefixMatch "mips"    cTARGETPLATFORM
ken's avatar
ken committed
610
	= return ( ["-static"], [] )
611

612 613
   | prefixMatch "sparc"    cTARGETPLATFORM
	= return ( [], ["-w"] )
ken's avatar
ken committed
614 615 616
	-- For now, to suppress the gcc warning "call-clobbered
	-- register used for global register variable", we simply
	-- disable all warnings altogether using the -w flag. Oh well.
617

sebc's avatar
sebc committed
618
   | prefixMatch "powerpc-apple-darwin" cTARGETPLATFORM
619 620 621 622 623 624 625 626 627
      -- -no-cpp-precomp:
      --     Disable Apple's precompiling preprocessor. It's a great thing
      --     for "normal" programs, but it doesn't support register variable
      --     declarations.
      -- -mdynamic-no-pic:
      --     As we don't support haskell code in shared libraries anyway,
      --     we might as well turn of PIC code generation and save space and time.
      --     This is completely optional.
       = return ( ["-no-cpp-precomp","-mdynamic-no-pic"], [] )
sebc's avatar
sebc committed
628

629 630
   | otherwise
	= return ( [], [] )
631

632 633
-----------------------------------------------------------------------------
-- local utils
634

rrt's avatar
rrt committed
635 636
addOpt_L a = updDynFlags (\s -> s{opt_L = a : opt_L s})
addOpt_P a = updDynFlags (\s -> s{opt_P = a : opt_P s})
sof's avatar
sof committed
637
addOpt_F a = updDynFlags (\s -> s{opt_F = a : opt_F s})
rrt's avatar
rrt committed
638 639 640 641 642 643 644
addOpt_c a = updDynFlags (\s -> s{opt_c = a : opt_c s})
addOpt_a a = updDynFlags (\s -> s{opt_a = a : opt_a s})
addOpt_m a = updDynFlags (\s -> s{opt_m = a : opt_m s})
#ifdef ILX
addOpt_I a = updDynFlags (\s -> s{opt_I = a : opt_I s})
addOpt_i a = updDynFlags (\s -> s{opt_i = a : opt_i s})
#endif
645 646 647 648 649 650

setVerbosity "" = updDynFlags (\dfs -> dfs{ verbosity = 3 })
setVerbosity n 
  | all isDigit n = updDynFlags (\dfs -> dfs{ verbosity = read n })
  | otherwise     = throwDyn (UsageError "can't parse verbosity flag (-v<n>)")

651
addCmdlineHCInclude a = updDynFlags (\s -> s{cmdlineHcIncludes =  a : cmdlineHcIncludes s})
652

653 654 655
-- -----------------------------------------------------------------------------
-- Version and usage messages

656 657 658 659
showVersion :: IO ()
showVersion = do
  putStrLn (cProjectName ++ ", version " ++ cProjectVersion)
  exitWith ExitSuccess
660 661 662 663 664 665 666 667 668 669 670 671 672 673

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