2 % (c) The University of Glasgow, 1996-2000
4 \section[CmdLineOpts]{Things to do with command-line options}
10 SimplifierSwitch(..), isAmongSimpl,
14 DynFlag(..), -- needed non-abstractly by DriverFlags
29 -- other dynamic flags
36 opt_AutoSccsOnAllToplevs,
37 opt_AutoSccsOnExportedToplevs,
38 opt_AutoSccsOnIndividualCafs,
46 opt_MaxContextReductionDepth,
47 opt_IrrefutableTuples,
55 opt_LiberateCaseThreshold,
56 opt_StgDoLetNoEscapes,
59 opt_UnboxStrictFields,
60 opt_SimplNoPreInlining,
61 opt_SimplDoEtaReduction,
62 opt_SimplDoLambdaEtaExpansion,
65 opt_SimplPedanticBottoms,
66 opt_SimplExcessPrecision,
69 opt_UF_HiFileThreshold,
70 opt_UF_CreationThreshold,
72 opt_UF_FunAppDiscount,
81 opt_EnsureSplittableC,
86 opt_IgnoreIfacePragmas,
89 opt_OmitInterfacePragmas,
97 #include "HsVersions.h"
99 import Array ( array, (//) )
101 import IOExts ( IORef, readIORef )
102 import Constants -- Default values for some flags
106 import Maybes ( firstJust )
107 import Panic ( panic )
109 #if __GLASGOW_HASKELL__ < 301
110 import ArrBase ( Array(..) )
112 import PrelArr ( Array(..) )
116 %************************************************************************
118 \subsection{Command-line options}
120 %************************************************************************
122 The hsc command-line options are split into two categories:
127 Static flags are represented by top-level values of type Bool or Int,
128 for example. They therefore have the same value throughout the
131 Dynamic flags are represented by an abstract type, DynFlags, which is
132 passed into hsc by the compilation manager for every compilation.
133 Dynamic flags are those that change on a per-compilation basis,
134 perhaps because they may be present in the OPTIONS pragma at the top
137 Other flag-related blurb:
139 A list of {\em ToDo}s is things to be done in a particular part of
140 processing. A (fictitious) example for the Core-to-Core simplifier
141 might be: run the simplifier, then run the strictness analyser, then
142 run the simplifier again (three ``todos'').
144 There are three ``to-do processing centers'' at the moment. In the
145 main loop (\tr{main/Main.lhs}), in the Core-to-Core processing loop
146 (\tr{simplCore/SimplCore.lhs), and in the STG-to-STG processing loop
147 (\tr{simplStg/SimplStg.lhs}).
149 %************************************************************************
151 \subsection{Datatypes associated with command-line options}
153 %************************************************************************
157 = SwBool Bool -- on/off
158 | SwString FAST_STRING -- nothing or a String
159 | SwInt Int -- nothing or an Int
163 data CoreToDo -- These are diff core-to-core passes,
164 -- which may be invoked in any order,
165 -- as many times as you like.
167 = CoreDoSimplify -- The core-to-core simplifier.
168 (SimplifierSwitch -> SwitchResult)
169 -- Each run of the simplifier can take a different
170 -- set of simplifier-specific flags.
172 | CoreDoFloatOutwards Bool -- True <=> float lambdas to top level
177 | CoreDoWorkerWrapper
184 | CoreDoNothing -- useful when building up lists of these things
191 | StgDoMassageForProfiling -- should be (next to) last
192 -- There's also setStgVarInfo, but its absolute "lastness"
193 -- is so critical that it is hardwired in (no flag).
198 data SimplifierSwitch
199 = MaxSimplifierIterations Int
200 | SimplInlinePhase Int
206 %************************************************************************
208 \subsection{Dynamic command-line options}
210 %************************************************************************
225 | Opt_D_dump_inlinings
226 | Opt_D_dump_occur_anal
231 | Opt_D_dump_simpl_iterations
240 | Opt_D_dump_worker_wrapper
242 | Opt_D_dump_rn_trace
243 | Opt_D_dump_rn_stats
245 | Opt_D_dump_simpl_stats
247 | Opt_D_verbose_core2core
248 | Opt_D_verbose_stg2stg
249 | Opt_D_dump_hi_diffs
250 | Opt_D_dump_minimal_imports
255 | Opt_WarnDuplicateExports
257 | Opt_WarnIncompletePatterns
258 | Opt_WarnMissingFields
259 | Opt_WarnMissingMethods
260 | Opt_WarnMissingSigs
261 | Opt_WarnNameShadowing
262 | Opt_WarnOverlappingPatterns
263 | Opt_WarnSimplePatterns
264 | Opt_WarnTypeDefaults
265 | Opt_WarnUnusedBinds
266 | Opt_WarnUnusedImports
267 | Opt_WarnUnusedMatches
268 | Opt_WarnDeprecations
271 | Opt_AllowOverlappingInstances
272 | Opt_AllowUndecidableInstances
275 | Opt_NoImplicitPrelude
281 data DynFlags = DynFlags {
282 coreToDo :: [CoreToDo],
283 stgToDo :: [StgToDo],
285 hscOutName :: String, -- name of the file in which to place output
289 dopt :: DynFlag -> DynFlags -> Bool
290 dopt f dflags = f `elem` (flags dflags)
292 dopt_CoreToDo :: DynFlags -> [CoreToDo]
293 dopt_CoreToDo = coreToDo
295 dopt_StgToDo :: DynFlags -> [StgToDo]
296 dopt_StgToDo = stgToDo
298 dopt_OutName :: DynFlags -> String
299 dopt_OutName = hscOutName
308 dopt_HscLang :: DynFlags -> HscLang
309 dopt_HscLang = hscLang
312 %************************************************************************
314 \subsection{Classifying command-line options}
316 %************************************************************************
319 -- v_Statis_hsc_opts is here to avoid a circular dependency with
321 GLOBAL_VAR(v_Static_hsc_opts, [], [String])
323 lookUp :: FAST_STRING -> Bool
324 lookup_int :: String -> Maybe Int
325 lookup_def_int :: String -> Int -> Int
326 lookup_def_float :: String -> Float -> Float
327 lookup_str :: String -> Maybe String
329 unpacked_static_opts = unsafePerformIO (readIORef v_Static_hsc_opts)
330 packed_static_opts = map _PK_ unpacked_static_opts
332 lookUp sw = sw `elem` packed_static_opts
334 lookup_str sw = firstJust (map (startsWith sw) unpacked_static_opts)
336 lookup_int sw = case (lookup_str sw) of
338 Just xx -> Just (read xx)
340 lookup_def_int sw def = case (lookup_str sw) of
341 Nothing -> def -- Use default
344 lookup_def_float sw def = case (lookup_str sw) of
345 Nothing -> def -- Use default
350 Putting the compiler options into temporary at-files
351 may turn out to be necessary later on if we turn hsc into
352 a pure Win32 application where I think there's a command-line
353 length limit of 255. unpacked_opts understands the @ option.
355 unpacked_opts :: [String]
359 map _UNPK_ argv -- NOT ARGV any more: v_Static_hsc_opts
361 expandAts ('@':fname) = words (unsafePerformIO (readFile fname))
366 %************************************************************************
368 \subsection{Static options}
370 %************************************************************************
374 opt_PprStyle_NoPrags = lookUp SLIT("-dppr-noprags")
375 opt_PprStyle_Debug = lookUp SLIT("-dppr-debug")
376 opt_PprUserLength = lookup_def_int "-dppr-user-length" 5 --ToDo: give this a name
379 opt_AutoSccsOnAllToplevs = lookUp SLIT("-fauto-sccs-on-all-toplevs")
380 opt_AutoSccsOnExportedToplevs = lookUp SLIT("-fauto-sccs-on-exported-toplevs")
381 opt_AutoSccsOnIndividualCafs = lookUp SLIT("-fauto-sccs-on-individual-cafs")
382 opt_AutoSccsOnDicts = lookUp SLIT("-fauto-sccs-on-dicts")
383 opt_SccProfilingOn = lookUp SLIT("-fscc-profiling")
384 opt_DoTickyProfiling = lookUp SLIT("-fticky-ticky")
387 opt_AllStrict = lookUp SLIT("-fall-strict")
388 opt_DictsStrict = lookUp SLIT("-fdicts-strict")
389 opt_IrrefutableTuples = lookUp SLIT("-firrefutable-tuples")
390 opt_MaxContextReductionDepth = lookup_def_int "-fcontext-stack" mAX_CONTEXT_REDUCTION_DEPTH
391 opt_NumbersStrict = lookUp SLIT("-fnumbers-strict")
392 opt_Parallel = lookUp SLIT("-fparallel")
393 opt_SMP = lookUp SLIT("-fsmp")
396 opt_DoSemiTagging = lookUp SLIT("-fsemi-tagging")
397 opt_FoldrBuildOn = lookUp SLIT("-ffoldr-build-on")
398 opt_LiberateCaseThreshold = lookup_def_int "-fliberate-case-threshold" (10::Int)
399 opt_StgDoLetNoEscapes = lookUp SLIT("-flet-no-escape")
400 opt_UnfoldCasms = lookUp SLIT("-funfold-casms-in-hi-file")
401 opt_UsageSPOn = lookUp SLIT("-fusagesp-on")
402 opt_UnboxStrictFields = lookUp SLIT("-funbox-strict-fields")
405 The optional '-inpackage=P' flag tells what package
406 we are compiling this module for.
407 The Prelude, for example is compiled with '-package prelude'
409 opt_InPackage = case lookup_str "-inpackage=" of
411 Nothing -> SLIT("Main") -- The package name if none is specified
413 opt_EmitCExternDecls = lookUp SLIT("-femit-extern-decls")
414 opt_EnsureSplittableC = lookUp SLIT("-fglobalise-toplev-names")
415 opt_GranMacros = lookUp SLIT("-fgransim")
416 opt_HiVersion = lookup_def_int "-fhi-version=" 0 -- what version we're compiling.
417 opt_HistorySize = lookup_def_int "-fhistory-size" 20
418 opt_IgnoreAsserts = lookUp SLIT("-fignore-asserts")
419 opt_IgnoreIfacePragmas = lookUp SLIT("-fignore-interface-pragmas")
420 opt_NoHiCheck = lookUp SLIT("-fno-hi-version-check")
421 opt_OmitBlackHoling = lookUp SLIT("-dno-black-holing")
422 opt_OmitInterfacePragmas = lookUp SLIT("-fomit-interface-pragmas")
424 -- Simplifier switches
425 opt_SimplNoPreInlining = lookUp SLIT("-fno-pre-inlining")
426 -- NoPreInlining is there just to see how bad things
427 -- get if you don't do it!
428 opt_SimplDoEtaReduction = lookUp SLIT("-fdo-eta-reduction")
429 opt_SimplDoLambdaEtaExpansion = lookUp SLIT("-fdo-lambda-eta-expansion")
430 opt_SimplCaseOfCase = lookUp SLIT("-fcase-of-case")
431 opt_SimplCaseMerge = lookUp SLIT("-fcase-merge")
432 opt_SimplPedanticBottoms = lookUp SLIT("-fpedantic-bottoms")
433 opt_SimplExcessPrecision = lookUp SLIT("-fexcess-precision")
436 opt_UF_HiFileThreshold = lookup_def_int "-funfolding-interface-threshold" (45::Int)
437 opt_UF_CreationThreshold = lookup_def_int "-funfolding-creation-threshold" (45::Int)
438 opt_UF_UseThreshold = lookup_def_int "-funfolding-use-threshold" (8::Int) -- Discounts can be big
439 opt_UF_FunAppDiscount = lookup_def_int "-funfolding-fun-discount" (6::Int) -- It's great to inline a fn
440 opt_UF_KeenessFactor = lookup_def_float "-funfolding-keeness-factor" (1.5::Float)
441 opt_UF_UpdateInPlace = lookUp SLIT("-funfolding-update-in-place")
443 opt_UF_CheapOp = ( 1 :: Int) -- Only one instruction; and the args are charged for
444 opt_UF_DearOp = ( 4 :: Int)
446 opt_NoPruneDecls = lookUp SLIT("-fno-prune-decls")
447 opt_NoPruneTyDecls = lookUp SLIT("-fno-prune-tydecls")
448 opt_Static = lookUp SLIT("-static")
449 opt_Unregisterised = lookUp SLIT("-funregisterised")
450 opt_Verbose = lookUp SLIT("-v")
453 %************************************************************************
455 \subsection{List of static hsc flags}
457 %************************************************************************
462 "fauto-sccs-on-all-toplevs",
463 "fauto-sccs-on-exported-toplevs",
464 "fauto-sccs-on-individual-cafs",
465 "fauto-sccs-on-dicts",
470 "firrefutable-tuples",
477 "funfold-casms-in-hi-file",
479 "funbox-strict-fields",
480 "femit-extern-decls",
481 "fglobalise-toplev-names",
484 "fignore-interface-pragmas",
485 "fno-hi-version-check",
486 "fno-implicit-prelude",
488 "fomit-interface-pragmas",
491 "fdo-lambda-eta-expansion",
496 "funfolding-update-in-place",
503 || any (flip prefixMatch f) [
505 "fliberate-case-threshold",
508 "funfolding-interface-threshold",
509 "funfolding-creation-threshold",
510 "funfolding-use-threshold",
511 "funfolding-fun-discount",
512 "funfolding-keeness-factor"
516 %************************************************************************
518 \subsection{Switch ordering}
520 %************************************************************************
522 These things behave just like enumeration types.
525 instance Eq SimplifierSwitch where
526 a == b = tagOf_SimplSwitch a ==# tagOf_SimplSwitch b
528 instance Ord SimplifierSwitch where
529 a < b = tagOf_SimplSwitch a <# tagOf_SimplSwitch b
530 a <= b = tagOf_SimplSwitch a <=# tagOf_SimplSwitch b
533 tagOf_SimplSwitch (SimplInlinePhase _) = _ILIT(1)
534 tagOf_SimplSwitch (MaxSimplifierIterations _) = _ILIT(2)
535 tagOf_SimplSwitch DontApplyRules = _ILIT(3)
536 tagOf_SimplSwitch SimplLetToCase = _ILIT(4)
537 tagOf_SimplSwitch NoCaseOfCase = _ILIT(5)
539 -- If you add anything here, be sure to change lAST_SIMPL_SWITCH_TAG, too!
541 lAST_SIMPL_SWITCH_TAG = 5
544 %************************************************************************
546 \subsection{Switch lookup}
548 %************************************************************************
551 isAmongSimpl :: [SimplifierSwitch] -> SimplifierSwitch -> SwitchResult
552 isAmongSimpl on_switches -- Switches mentioned later occur *earlier*
553 -- in the list; defaults right at the end.
555 tidied_on_switches = foldl rm_dups [] on_switches
556 -- The fold*l* ensures that we keep the latest switches;
557 -- ie the ones that occur earliest in the list.
559 sw_tbl :: Array Int SwitchResult
560 sw_tbl = (array (0, lAST_SIMPL_SWITCH_TAG) -- bounds...
564 all_undefined = [ (i, SwBool False) | i <- [0 .. lAST_SIMPL_SWITCH_TAG ] ]
566 defined_elems = map mk_assoc_elem tidied_on_switches
568 -- (avoid some unboxing, bounds checking, and other horrible things:)
569 #if __GLASGOW_HASKELL__ < 405
570 case sw_tbl of { Array bounds_who_needs_'em stuff ->
572 case sw_tbl of { Array _ _ stuff ->
575 case (indexArray# stuff (tagOf_SimplSwitch switch)) of
576 #if __GLASGOW_HASKELL__ < 400
578 #elif __GLASGOW_HASKELL__ < 403
585 mk_assoc_elem k@(MaxSimplifierIterations lvl)
586 = (iBox (tagOf_SimplSwitch k), SwInt lvl)
587 mk_assoc_elem k@(SimplInlinePhase n)
588 = (iBox (tagOf_SimplSwitch k), SwInt n)
590 = (iBox (tagOf_SimplSwitch k), SwBool True) -- I'm here, Mom!
592 -- cannot have duplicates if we are going to use the array thing
593 rm_dups switches_so_far switch
594 = if switch `is_elem` switches_so_far
596 else switch : switches_so_far
598 sw `is_elem` [] = False
599 sw `is_elem` (s:ss) = (tagOf_SimplSwitch sw) ==# (tagOf_SimplSwitch s)
604 %************************************************************************
606 \subsection{Misc functions for command-line options}
608 %************************************************************************
612 switchIsOn :: (switch -> SwitchResult) -> switch -> Bool
614 switchIsOn lookup_fn switch
615 = case (lookup_fn switch) of
616 SwBool False -> False
619 intSwitchSet :: (switch -> SwitchResult)
623 intSwitchSet lookup_fn switch
624 = case (lookup_fn (switch (panic "intSwitchSet"))) of
625 SwInt int -> Just int
630 startsWith :: String -> String -> Maybe String
631 -- startsWith pfx (pfx++rest) = Just rest
633 startsWith [] str = Just str
634 startsWith (c:cs) (s:ss)
635 = if c /= s then Nothing else startsWith cs ss
636 startsWith _ [] = Nothing
638 endsWith :: String -> String -> Maybe String
640 = case (startsWith (reverse cs) (reverse ss)) of
642 Just rs -> Just (reverse rs)