ghc/compiler/main/CmdLineOpts.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1996-98
   3 %
   4 \section[CmdLineOpts]{Things to do with command-line options}
   5
   6 \begin{code}
   7
   8 module CmdLineOpts (
   9         CoreToDo(..),
  10         SimplifierSwitch(..),
  11         StgToDo(..),
  12         SwitchResult(..),
  13         classifyOpts,
  14
  15         intSwitchSet,
  16         switchIsOn,
  17
  18         -- debugging opts
  19         dopt_D_dump_absC,
  20         dopt_D_dump_asm,
  21         dopt_D_dump_cpranal,
  22         dopt_D_dump_cse,
  23         dopt_D_dump_deriv,
  24         dopt_D_dump_ds,
  25         dopt_D_dump_flatC,
  26         dopt_D_dump_foreign,
  27         dopt_D_dump_hi_diffs,
  28         dopt_D_dump_inlinings,
  29         dopt_D_dump_occur_anal,
  30         dopt_D_dump_parsed,
  31         dopt_D_dump_realC,
  32         dopt_D_dump_rn,
  33         dopt_D_dump_rules,
  34         dopt_D_dump_simpl,
  35         dopt_D_dump_simpl_iterations,
  36         dopt_D_dump_simpl_stats,
  37         dopt_D_dump_spec,
  38         dopt_D_dump_stg,
  39         dopt_D_dump_stranal,
  40         dopt_D_dump_tc,
  41         dopt_D_dump_types,
  42         dopt_D_dump_usagesp,
  43         dopt_D_dump_worker_wrapper,
  44         dopt_D_show_passes,
  45         dopt_D_dump_rn_trace,
  46         dopt_D_dump_rn_stats,
  47         dopt_D_dump_stix,
  48         dopt_D_dump_minimal_imports,
  49         dopt_D_source_stats,
  50         dopt_D_verbose_core2core,
  51         dopt_D_verbose_stg2stg,
  52         dopt_DoCoreLinting,
  53         dopt_DoStgLinting,
  54         dopt_DoUSPLinting,
  55
  56         opt_PprStyle_NoPrags,
  57         opt_PprUserLength,
  58         opt_PprStyle_Debug,
  59
  60         -- other dynamic flags
  61         dopt_CoreToDo,
  62         dopt_StgToDo,
  63
  64         -- warning opts
  65         opt_WarnDuplicateExports,
  66         opt_WarnHiShadows,
  67         opt_WarnIncompletePatterns,
  68         opt_WarnMissingFields,
  69         opt_WarnMissingMethods,
  70         opt_WarnMissingSigs,
  71         opt_WarnNameShadowing,
  72         opt_WarnOverlappingPatterns,
  73         opt_WarnSimplePatterns,
  74         opt_WarnTypeDefaults,
  75         opt_WarnUnusedBinds,
  76         opt_WarnUnusedImports,
  77         opt_WarnUnusedMatches,
  78         opt_WarnDeprecations,
  79
  80         -- profiling opts
  81         opt_AutoSccsOnAllToplevs,
  82         opt_AutoSccsOnExportedToplevs,
  83         opt_AutoSccsOnIndividualCafs,
  84         opt_AutoSccsOnDicts,
  85         opt_SccProfilingOn,
  86         opt_DoTickyProfiling,
  87
  88         -- language opts
  89         opt_AllStrict,
  90         opt_DictsStrict,
  91         opt_MaxContextReductionDepth,
  92         dopt_AllowOverlappingInstances,
  93         dopt_AllowUndecidableInstances,
  94         dopt_GlasgowExts,
  95         opt_Generics,
  96         opt_IrrefutableTuples,
  97         opt_NumbersStrict,
  98         opt_Parallel,
  99         opt_SMP,
 100
 101         -- optimisation opts
 102         opt_DoSemiTagging,
 103         opt_FoldrBuildOn,
 104         opt_LiberateCaseThreshold,
 105         opt_StgDoLetNoEscapes,
 106         opt_UnfoldCasms,
 107         opt_UsageSPOn,
 108         opt_UnboxStrictFields,
 109         opt_SimplNoPreInlining,
 110         opt_SimplDoEtaReduction,
 111         opt_SimplDoLambdaEtaExpansion,
 112         opt_SimplCaseOfCase,
 113         opt_SimplCaseMerge,
 114         opt_SimplPedanticBottoms,
 115         opt_SimplExcessPrecision,
 116
 117         -- Unfolding control
 118         opt_UF_HiFileThreshold,
 119         opt_UF_CreationThreshold,
 120         opt_UF_UseThreshold,
 121         opt_UF_FunAppDiscount,
 122         opt_UF_KeenessFactor,
 123         opt_UF_UpdateInPlace,
 124         opt_UF_CheapOp,
 125         opt_UF_DearOp,
 126
 127         -- misc opts
 128         opt_InPackage,
 129         opt_EmitCExternDecls,
 130         opt_EnsureSplittableC,
 131         opt_GranMacros,
 132         opt_HiVersion,
 133         opt_HistorySize,
 134         opt_IgnoreAsserts,
 135         opt_IgnoreIfacePragmas,
 136         opt_NoHiCheck,
 137         opt_NoImplicitPrelude,
 138         opt_OmitBlackHoling,
 139         opt_OmitInterfacePragmas,
 140         opt_ProduceExportCStubs,
 141         opt_ProduceExportHStubs,
 142         opt_NoPruneTyDecls,
 143         opt_NoPruneDecls,
 144         opt_ReportCompile,
 145         opt_Static,
 146         opt_Unregisterised,
 147         opt_Verbose,
 148
 149         opt_OutputLanguage,
 150         opt_OutputFile,
 151
 152         -- Code generation
 153         opt_UseVanillaRegs,
 154         opt_UseFloatRegs,
 155         opt_UseDoubleRegs,
 156         opt_UseLongRegs
 157     ) where
 158
 159 #include "HsVersions.h"
 160
 161 import Array    ( array, (//) )
 162 import GlaExts
 163 import Argv
 164 import Constants        -- Default values for some flags
 165
 166 import Maybes           ( firstJust )
 167 import Panic            ( panic )
 168
 169 #if __GLASGOW_HASKELL__ < 301
 170 import ArrBase  ( Array(..) )
 171 #else
 172 import PrelArr  ( Array(..) )
 173 #endif
 174 \end{code}
 175
 176 %************************************************************************
 177 %*                                                                      *
 178 \subsection{Command-line options}
 179 %*                                                                      *
 180 %************************************************************************
 181
 182 The hsc command-line options are split into two categories:
 183
 184   - static flags
 185   - dynamic flags
 186
 187 Static flags are represented by top-level values of type Bool or Int,
 188 for example.  They therefore have the same value throughout the
 189 invocation of hsc.
 190
 191 Dynamic flags are represented by a function:
 192
 193         checkDynFlag :: DynFlag -> SwitchResult
 194
 195 which is passed into hsc by the compilation manager for every
 196 compilation.  Dynamic flags are those that change on a per-compilation
 197 basis, perhaps because they may be present in the OPTIONS pragma at
 198 the top of a module.
 199
 200 Other flag-related blurb:
 201
 202 A list of {\em ToDo}s is things to be done in a particular part of
 203 processing.  A (fictitious) example for the Core-to-Core simplifier
 204 might be: run the simplifier, then run the strictness analyser, then
 205 run the simplifier again (three ``todos'').
 206
 207 There are three ``to-do processing centers'' at the moment.  In the
 208 main loop (\tr{main/Main.lhs}), in the Core-to-Core processing loop
 209 (\tr{simplCore/SimplCore.lhs), and in the STG-to-STG processing loop
 210 (\tr{simplStg/SimplStg.lhs}).
 211
 212 %************************************************************************
 213 %*                                                                      *
 214 \subsection{Datatypes associated with command-line options}
 215 %*                                                                      *
 216 %************************************************************************
 217
 218 \begin{code}
 219 data SwitchResult
 220   = SwBool      Bool            -- on/off
 221   | SwString    FAST_STRING     -- nothing or a String
 222   | SwInt       Int             -- nothing or an Int
 223 \end{code}
 224
 225 \begin{code}
 226 data CoreToDo           -- These are diff core-to-core passes,
 227                         -- which may be invoked in any order,
 228                         -- as many times as you like.
 229
 230   = CoreDoSimplify      -- The core-to-core simplifier.
 231         (SimplifierSwitch -> SwitchResult)
 232                         -- Each run of the simplifier can take a different
 233                         -- set of simplifier-specific flags.
 234   | CoreDoFloatInwards
 235   | CoreDoFloatOutwards Bool    -- True <=> float lambdas to top level
 236   | CoreLiberateCase
 237   | CoreDoPrintCore
 238   | CoreDoStaticArgs
 239   | CoreDoStrictness
 240   | CoreDoWorkerWrapper
 241   | CoreDoSpecialising
 242   | CoreDoUSPInf
 243   | CoreDoCPResult
 244   | CoreDoGlomBinds
 245   | CoreCSE
 246 \end{code}
 247
 248 \begin{code}
 249 data StgToDo
 250   = StgDoStaticArgs
 251   | StgDoLambdaLift
 252   | StgDoMassageForProfiling  -- should be (next to) last
 253   -- There's also setStgVarInfo, but its absolute "lastness"
 254   -- is so critical that it is hardwired in (no flag).
 255   | D_stg_stats
 256 \end{code}
 257
 258 \begin{code}
 259 data SimplifierSwitch
 260   = MaxSimplifierIterations Int
 261   | SimplInlinePhase Int
 262   | DontApplyRules
 263   | NoCaseOfCase
 264   | SimplLetToCase
 265 \end{code}
 266
 267 %************************************************************************
 268 %*                                                                      *
 269 \subsection{Dynamic command-line options}
 270 %*                                                                      *
 271 %************************************************************************
 272
 273 \begin{code}
 274 data DynFlag
 275
 276    -- debugging flags
 277    = Opt_D_dump_all
 278    | Opt_D_dump_most
 279    | Opt_D_dump_absC
 280    | Opt_D_dump_asm
 281    | Opt_D_dump_cpranal
 282    | Opt_D_dump_deriv
 283    | Opt_D_dump_ds
 284    | Opt_D_dump_flatC
 285    | Opt_D_dump_foreign
 286    | Opt_D_dump_inlinings
 287    | Opt_D_dump_occur_anal
 288    | Opt_D_dump_parsed
 289    | Opt_D_dump_realC
 290    | Opt_D_dump_rn
 291    | Opt_D_dump_simpl
 292    | Opt_D_dump_simpl_iterations
 293    | Opt_D_dump_spec
 294    | Opt_D_dump_stg
 295    | Opt_D_dump_stranal
 296    | Opt_D_dump_tc
 297    | Opt_D_dump_types
 298    | Opt_D_dump_rules
 299    | Opt_D_dump_usagesp
 300    | Opt_D_dump_cse
 301    | Opt_D_dump_worker_wrapper
 302    | Opt_D_show_passes
 303    | Opt_D_dump_rn_trace
 304    | Opt_D_dump_rn_stats
 305    | Opt_D_dump_stix
 306    | Opt_D_dump_simpl_stats
 307    | Opt_D_source_stats
 308    | Opt_D_verbose_core2core
 309    | Opt_D_verbose_stg2stg
 310    | Opt_D_dump_hi_diffs
 311    | Opt_D_dump_minimal_imports
 312    | Opt_DoCoreLinting
 313    | Opt_DoStgLinting
 314    | Opt_DoUSPLinting
 315
 316    -- language opts
 317    | Opt_AllowOverlappingInstances
 318    | Opt_AllowUndecidableInstances
 319    | Opt_GlasgowExts
 320    deriving (Eq)
 321
 322 newtype DynFlags = DynFlags (CoreToDo, StgToDo, [(DynFlag, SwitchResult)])
 323
 324 boolOpt :: DynFlag -> DynFlags -> Bool
 325 boolOpt f (DynFlags (_, _, dflags))
 326   = case lookup f dflags of
 327         Nothing -> False
 328         Just (SwBool b) -> b
 329         _ -> panic "boolOpt"
 330
 331 dopt_D_dump_all              = boolOpt Opt_D_dump_all
 332 dopt_D_dump_most             = boolOpt Opt_D_dump_most
 333 dopt_D_dump_absC             = boolOpt Opt_D_dump_absC
 334 dopt_D_dump_asm              = boolOpt Opt_D_dump_asm
 335 dopt_D_dump_cpranal          = boolOpt Opt_D_dump_cpranal
 336 dopt_D_dump_deriv            = boolOpt Opt_D_dump_deriv
 337 dopt_D_dump_ds               = boolOpt Opt_D_dump_ds
 338 dopt_D_dump_flatC            = boolOpt Opt_D_dump_flatC
 339 dopt_D_dump_foreign          = boolOpt Opt_D_dump_foreign
 340 dopt_D_dump_inlinings        = boolOpt Opt_D_dump_inlinings
 341 dopt_D_dump_occur_anal       = boolOpt Opt_D_dump_occur_anal
 342 dopt_D_dump_parsed           = boolOpt Opt_D_dump_parsed
 343 dopt_D_dump_realC            = boolOpt Opt_D_dump_realC
 344 dopt_D_dump_rn               = boolOpt Opt_D_dump_rn
 345 dopt_D_dump_simpl            = boolOpt Opt_D_dump_simpl
 346 dopt_D_dump_simpl_iterations = boolOpt Opt_D_dump_simpl_iterations
 347 dopt_D_dump_spec             = boolOpt Opt_D_dump_spec
 348 dopt_D_dump_stg              = boolOpt Opt_D_dump_stg
 349 dopt_D_dump_stranal          = boolOpt Opt_D_dump_stranal
 350 dopt_D_dump_tc               = boolOpt Opt_D_dump_tc
 351 dopt_D_dump_types            = boolOpt Opt_D_dump_types
 352 dopt_D_dump_rules            = boolOpt Opt_D_dump_rules
 353 dopt_D_dump_usagesp          = boolOpt Opt_D_dump_usagesp
 354 dopt_D_dump_cse              = boolOpt Opt_D_dump_cse
 355 dopt_D_dump_worker_wrapper   = boolOpt Opt_D_dump_worker_wrapper
 356 dopt_D_show_passes           = boolOpt Opt_D_show_passes
 357 dopt_D_dump_rn_trace         = boolOpt Opt_D_dump_rn_trace
 358 dopt_D_dump_rn_stats         = boolOpt Opt_D_dump_rn_stats
 359 dopt_D_dump_stix             = boolOpt Opt_D_dump_stix
 360 dopt_D_dump_simpl_stats      = boolOpt Opt_D_dump_simpl_stats
 361 dopt_D_source_stats          = boolOpt Opt_D_source_stats
 362 dopt_D_verbose_core2core     = boolOpt Opt_D_verbose_core2core
 363 dopt_D_verbose_stg2stg       = boolOpt Opt_D_verbose_stg2stg
 364 dopt_D_dump_hi_diffs         = boolOpt Opt_D_dump_hi_diffs
 365 dopt_D_dump_minimal_imports  = boolOpt Opt_D_dump_minimal_imports
 366 dopt_DoCoreLinting           = boolOpt Opt_DoCoreLinting
 367 dopt_DoStgLinting            = boolOpt Opt_DoStgLinting
 368 dopt_DoUSPLinting            = boolOpt Opt_DoUSPLinting
 369
 370 dopt_AllowOverlappingInstances = boolOpt Opt_AllowOverlappingInstances
 371 dopt_AllowUndecidableInstances = boolOpt Opt_AllowUndecidableInstances
 372 dopt_GlasgowExts               = boolOpt Opt_GlasgowExts
 373
 374 dopt_CoreToDo :: DynFlags -> CoreToDo
 375 dopt_CoreToDo (DynFlags (core_todo,_,_)) = core_todo
 376
 377 dopt_StgToDo :: DynFlags -> StgToDo
 378 dopt_StgToDo (DynFlags (_,stg_todo,_)) = stg_todo
 379 \end{code}
 380
 381 %************************************************************************
 382 %*                                                                      *
 383 \subsection{Classifying command-line options}
 384 %*                                                                      *
 385 %************************************************************************
 386
 387 \begin{code}
 388 lookUp           :: FAST_STRING -> Bool
 389 lookup_int       :: String -> Maybe Int
 390 lookup_def_int   :: String -> Int -> Int
 391 lookup_def_float :: String -> Float -> Float
 392 lookup_str       :: String -> Maybe String
 393
 394 lookUp     sw = sw `elem` argv
 395
 396 lookup_str sw = firstJust (map (startsWith sw) unpacked_opts)
 397
 398 lookup_int sw = case (lookup_str sw) of
 399                   Nothing -> Nothing
 400                   Just xx -> Just (read xx)
 401
 402 lookup_def_int sw def = case (lookup_str sw) of
 403                             Nothing -> def              -- Use default
 404                             Just xx -> read xx
 405
 406 lookup_def_char sw def = case (lookup_str sw) of
 407                             Just (xx:_) -> xx
 408                             _           -> def          -- Use default
 409
 410 lookup_def_float sw def = case (lookup_str sw) of
 411                             Nothing -> def              -- Use default
 412                             Just xx -> read xx
 413
 414 unpacked_opts = map _UNPK_ argv
 415
 416 {-
 417  Putting the compiler options into temporary at-files
 418  may turn out to be necessary later on if we turn hsc into
 419  a pure Win32 application where I think there's a command-line
 420  length limit of 255. unpacked_opts understands the @ option.
 421
 422 unpacked_opts :: [String]
 423 unpacked_opts =
 424   concat $
 425   map (expandAts) $
 426   map _UNPK_ argv
 427   where
 428    expandAts ('@':fname) = words (unsafePerformIO (readFile fname))
 429    expandAts l = [l]
 430 -}
 431 \end{code}
 432
 433 %************************************************************************
 434 %*                                                                      *
 435 \subsection{Static options}
 436 %*                                                                      *
 437 %************************************************************************
 438
 439 \begin{code}
 440 -- debugging opts
 441 opt_PprStyle_NoPrags            = lookUp  SLIT("-dppr-noprags")
 442 opt_PprStyle_Debug              = lookUp  SLIT("-dppr-debug")
 443 opt_PprUserLength               = lookup_def_int "-dppr-user-length" 5 --ToDo: give this a name
 444
 445 -- warning opts
 446 opt_WarnDuplicateExports        = lookUp  SLIT("-fwarn-duplicate-exports")
 447 opt_WarnHiShadows               = lookUp  SLIT("-fwarn-hi-shadowing")
 448 opt_WarnIncompletePatterns      = lookUp  SLIT("-fwarn-incomplete-patterns")
 449 opt_WarnMissingFields           = lookUp  SLIT("-fwarn-missing-fields")
 450 opt_WarnMissingMethods          = lookUp  SLIT("-fwarn-missing-methods")
 451 opt_WarnMissingSigs             = lookUp  SLIT("-fwarn-missing-signatures")
 452 opt_WarnNameShadowing           = lookUp  SLIT("-fwarn-name-shadowing")
 453 opt_WarnOverlappingPatterns     = lookUp  SLIT("-fwarn-overlapping-patterns")
 454 opt_WarnSimplePatterns          = lookUp  SLIT("-fwarn-simple-patterns")
 455 opt_WarnTypeDefaults            = lookUp  SLIT("-fwarn-type-defaults")
 456 opt_WarnUnusedBinds             = lookUp  SLIT("-fwarn-unused-binds")
 457 opt_WarnUnusedImports           = lookUp  SLIT("-fwarn-unused-imports")
 458 opt_WarnUnusedMatches           = lookUp  SLIT("-fwarn-unused-matches")
 459 opt_WarnDeprecations            = lookUp  SLIT("-fwarn-deprecations")
 460
 461 -- profiling opts
 462 opt_AutoSccsOnAllToplevs        = lookUp  SLIT("-fauto-sccs-on-all-toplevs")
 463 opt_AutoSccsOnExportedToplevs   = lookUp  SLIT("-fauto-sccs-on-exported-toplevs")
 464 opt_AutoSccsOnIndividualCafs    = lookUp  SLIT("-fauto-sccs-on-individual-cafs")
 465 opt_AutoSccsOnDicts             = lookUp  SLIT("-fauto-sccs-on-dicts")
 466 opt_SccProfilingOn              = lookUp  SLIT("-fscc-profiling")
 467 opt_DoTickyProfiling            = lookUp  SLIT("-fticky-ticky")
 468
 469 -- language opts
 470 opt_AllStrict                   = lookUp  SLIT("-fall-strict")
 471 opt_DictsStrict                 = lookUp  SLIT("-fdicts-strict")
 472 opt_Generics                    = lookUp  SLIT("-fgenerics")
 473 opt_IrrefutableTuples           = lookUp  SLIT("-firrefutable-tuples")
 474 opt_MaxContextReductionDepth    = lookup_def_int "-fcontext-stack" mAX_CONTEXT_REDUCTION_DEPTH
 475 opt_NumbersStrict               = lookUp  SLIT("-fnumbers-strict")
 476 opt_Parallel                    = lookUp  SLIT("-fparallel")
 477 opt_SMP                         = lookUp  SLIT("-fsmp")
 478
 479 -- optimisation opts
 480 opt_DoSemiTagging               = lookUp  SLIT("-fsemi-tagging")
 481 opt_FoldrBuildOn                = lookUp  SLIT("-ffoldr-build-on")
 482 opt_LiberateCaseThreshold       = lookup_def_int "-fliberate-case-threshold" (10::Int)
 483 opt_StgDoLetNoEscapes           = lookUp  SLIT("-flet-no-escape")
 484 opt_UnfoldCasms                 = lookUp SLIT("-funfold-casms-in-hi-file")
 485 opt_UsageSPOn                   = lookUp  SLIT("-fusagesp-on")
 486 opt_UnboxStrictFields           = lookUp  SLIT("-funbox-strict-fields")
 487
 488 {-
 489    The optional '-inpackage=P' flag tells what package
 490    we are compiling this module for.
 491    The Prelude, for example is compiled with '-package prelude'
 492 -}
 493 opt_InPackage                   = case lookup_str "-inpackage=" of
 494                                     Just p  -> _PK_ p
 495                                     Nothing -> SLIT("Main")     -- The package name if none is specified
 496
 497 opt_EmitCExternDecls            = lookUp  SLIT("-femit-extern-decls")
 498 opt_EnsureSplittableC           = lookUp  SLIT("-fglobalise-toplev-names")
 499 opt_GranMacros                  = lookUp  SLIT("-fgransim")
 500 opt_HiVersion                   = lookup_def_int "-fhi-version=" 0 -- what version we're compiling.
 501 opt_HistorySize                 = lookup_def_int "-fhistory-size" 20
 502 opt_IgnoreAsserts               = lookUp  SLIT("-fignore-asserts")
 503 opt_IgnoreIfacePragmas          = lookUp  SLIT("-fignore-interface-pragmas")
 504 opt_NoHiCheck                   = lookUp  SLIT("-fno-hi-version-check")
 505 opt_NoImplicitPrelude           = lookUp  SLIT("-fno-implicit-prelude")
 506 opt_OmitBlackHoling             = lookUp  SLIT("-dno-black-holing")
 507 opt_OmitInterfacePragmas        = lookUp  SLIT("-fomit-interface-pragmas")
 508 opt_ProduceExportCStubs         = lookup_str "-F="
 509 opt_ProduceExportHStubs         = lookup_str "-FH="
 510
 511 -- Language for output: "C", "asm", "java", maybe more
 512 -- Nothing => don't output anything
 513 opt_OutputLanguage :: Maybe String
 514 opt_OutputLanguage = lookup_str "-olang="
 515
 516 opt_OutputFile :: String
 517 opt_OutputFile     = case lookup_str "-ofile=" of
 518                         Nothing -> panic "No output file specified (-ofile=xxx)"
 519                         Just f  -> f
 520
 521 -- Simplifier switches
 522 opt_SimplNoPreInlining          = lookUp SLIT("-fno-pre-inlining")
 523         -- NoPreInlining is there just to see how bad things
 524         -- get if you don't do it!
 525 opt_SimplDoEtaReduction         = lookUp SLIT("-fdo-eta-reduction")
 526 opt_SimplDoLambdaEtaExpansion   = lookUp SLIT("-fdo-lambda-eta-expansion")
 527 opt_SimplCaseOfCase             = lookUp SLIT("-fcase-of-case")
 528 opt_SimplCaseMerge              = lookUp SLIT("-fcase-merge")
 529 opt_SimplPedanticBottoms        = lookUp SLIT("-fpedantic-bottoms")
 530 opt_SimplExcessPrecision        = lookUp SLIT("-fexcess-precision")
 531
 532 -- Unfolding control
 533 opt_UF_HiFileThreshold          = lookup_def_int "-funfolding-interface-threshold" (45::Int)
 534 opt_UF_CreationThreshold        = lookup_def_int "-funfolding-creation-threshold"  (45::Int)
 535 opt_UF_UseThreshold             = lookup_def_int "-funfolding-use-threshold"       (8::Int)     -- Discounts can be big
 536 opt_UF_FunAppDiscount           = lookup_def_int "-funfolding-fun-discount"        (6::Int)     -- It's great to inline a fn
 537 opt_UF_KeenessFactor            = lookup_def_float "-funfolding-keeness-factor"    (1.5::Float)
 538 opt_UF_UpdateInPlace            = lookUp  SLIT("-funfolding-update-in-place")
 539
 540 opt_UF_CheapOp  = ( 1 :: Int)   -- Only one instruction; and the args are charged for
 541 opt_UF_DearOp   = ( 4 :: Int)
 542
 543 opt_ReportCompile               = lookUp SLIT("-freport-compile")
 544 opt_NoPruneDecls                = lookUp SLIT("-fno-prune-decls")
 545 opt_NoPruneTyDecls              = lookUp SLIT("-fno-prune-tydecls")
 546 opt_Static                      = lookUp SLIT("-static")
 547 opt_Unregisterised              = lookUp SLIT("-funregisterised")
 548 opt_Verbose                     = lookUp SLIT("-v")
 549
 550 opt_UseVanillaRegs | opt_Unregisterised = 0
 551                    | otherwise          = mAX_Real_Vanilla_REG
 552 opt_UseFloatRegs   | opt_Unregisterised = 0
 553                    | otherwise          = mAX_Real_Float_REG
 554 opt_UseDoubleRegs  | opt_Unregisterised = 0
 555                    | otherwise          = mAX_Real_Double_REG
 556 opt_UseLongRegs    | opt_Unregisterised = 0
 557                    | otherwise          = mAX_Real_Long_REG
 558 \end{code}
 559
 560 \begin{code}
 561 classifyOpts :: ([CoreToDo],    -- Core-to-Core processing spec
 562                  [StgToDo])     -- STG-to-STG   processing spec
 563
 564 classifyOpts = sep argv [] [] -- accumulators...
 565   where
 566     sep :: [FAST_STRING]                 -- cmd-line opts (input)
 567         -> [CoreToDo] -> [StgToDo]       -- to_do accumulators
 568         -> ([CoreToDo], [StgToDo])       -- result
 569
 570     sep [] core_td stg_td -- all done!
 571       = (reverse core_td, reverse stg_td)
 572
 573 #       define CORE_TD(to_do) sep opts (to_do:core_td) stg_td
 574 #       define STG_TD(to_do)  sep opts core_td (to_do:stg_td)
 575
 576     sep (opt1:opts) core_td stg_td
 577       = case (_UNPK_ opt1) of -- the non-"just match a string" options are at the end...
 578           ',' : _       -> sep opts core_td stg_td -- it is for the parser
 579
 580           "-fsimplify"  -> -- gather up SimplifierSwitches specially...
 581                            simpl_sep opts defaultSimplSwitches core_td stg_td
 582
 583           "-ffloat-inwards"  -> CORE_TD(CoreDoFloatInwards)
 584           "-ffloat-outwards"      -> CORE_TD(CoreDoFloatOutwards False)
 585           "-ffloat-outwards-full" -> CORE_TD(CoreDoFloatOutwards True)
 586           "-fliberate-case"  -> CORE_TD(CoreLiberateCase)
 587           "-fcse"            -> CORE_TD(CoreCSE)
 588           "-fglom-binds"     -> CORE_TD(CoreDoGlomBinds)
 589           "-fprint-core"     -> CORE_TD(CoreDoPrintCore)
 590           "-fstatic-args"    -> CORE_TD(CoreDoStaticArgs)
 591           "-fstrictness"     -> CORE_TD(CoreDoStrictness)
 592           "-fworker-wrapper" -> CORE_TD(CoreDoWorkerWrapper)
 593           "-fspecialise"     -> CORE_TD(CoreDoSpecialising)
 594           "-fusagesp"        -> CORE_TD(CoreDoUSPInf)
 595           "-fcpr-analyse"    -> CORE_TD(CoreDoCPResult)
 596
 597           "-fstg-static-args" -> STG_TD(StgDoStaticArgs)
 598           "-dstg-stats"       -> STG_TD(D_stg_stats)
 599           "-flambda-lift"     -> STG_TD(StgDoLambdaLift)
 600           "-fmassage-stg-for-profiling" -> STG_TD(StgDoMassageForProfiling)
 601
 602           _ -> -- NB: the driver is really supposed to handle bad options
 603                sep opts core_td stg_td
 604
 605     ----------------
 606
 607     simpl_sep :: [FAST_STRING]            -- cmd-line opts (input)
 608               -> [SimplifierSwitch]       -- simplifier-switch accumulator
 609               -> [CoreToDo] -> [StgToDo]  -- to_do accumulators
 610               -> ([CoreToDo], [StgToDo])  -- result
 611
 612         -- "simpl_sep" tailcalls "sep" once it's seen one set
 613         -- of SimplifierSwitches for a CoreDoSimplify.
 614
 615 #ifdef DEBUG
 616     simpl_sep input@[] simpl_sw core_td stg_td
 617       = panic "simpl_sep []"
 618 #endif
 619
 620         -- The SimplifierSwitches should be delimited by "[" and "]".
 621
 622     simpl_sep (opt1:opts) simpl_sw core_td stg_td
 623       = case (_UNPK_ opt1) of
 624           "[" -> simpl_sep opts simpl_sw core_td stg_td
 625           "]" -> let
 626                     this_simpl = CoreDoSimplify (isAmongSimpl simpl_sw)
 627                  in
 628                  sep opts (this_simpl : core_td) stg_td
 629
 630           opt -> case matchSimplSw opt of
 631                         Just sw -> simpl_sep opts (sw:simpl_sw) core_td stg_td
 632                         Nothing -> simpl_sep opts simpl_sw      core_td stg_td
 633
 634 matchSimplSw opt
 635   = firstJust   [ matchSwInt  opt "-fmax-simplifier-iterations"         MaxSimplifierIterations
 636                 , matchSwInt  opt "-finline-phase"                      SimplInlinePhase
 637                 , matchSwBool opt "-fno-rules"                          DontApplyRules
 638                 , matchSwBool opt "-fno-case-of-case"                   NoCaseOfCase
 639                 , matchSwBool opt "-flet-to-case"                       SimplLetToCase
 640                 ]
 641
 642 matchSwBool :: String -> String -> a -> Maybe a
 643 matchSwBool opt str sw | opt == str = Just sw
 644                        | otherwise  = Nothing
 645
 646 matchSwInt :: String -> String -> (Int -> a) -> Maybe a
 647 matchSwInt opt str sw = case startsWith str opt of
 648                             Just opt_left -> Just (sw (read opt_left))
 649                             Nothing       -> Nothing
 650 \end{code}
 651
 652 %************************************************************************
 653 %*                                                                      *
 654 \subsection{Switch ordering}
 655 %*                                                                      *
 656 %************************************************************************
 657
 658 In spite of the @Produce*@ constructor, these things behave just like
 659 enumeration types.
 660
 661 \begin{code}
 662 instance Eq SimplifierSwitch where
 663     a == b = tagOf_SimplSwitch a _EQ_ tagOf_SimplSwitch b
 664
 665 instance Ord SimplifierSwitch where
 666     a <  b  = tagOf_SimplSwitch a _LT_ tagOf_SimplSwitch b
 667     a <= b  = tagOf_SimplSwitch a _LE_ tagOf_SimplSwitch b
 668
 669
 670 tagOf_SimplSwitch (SimplInlinePhase _)          = ILIT(1)
 671 tagOf_SimplSwitch (MaxSimplifierIterations _)   = ILIT(2)
 672 tagOf_SimplSwitch DontApplyRules                = ILIT(3)
 673 tagOf_SimplSwitch SimplLetToCase                = ILIT(4)
 674 tagOf_SimplSwitch NoCaseOfCase                  = ILIT(5)
 675
 676 -- If you add anything here, be sure to change lAST_SIMPL_SWITCH_TAG, too!
 677
 678 lAST_SIMPL_SWITCH_TAG = 5
 679 \end{code}
 680
 681 %************************************************************************
 682 %*                                                                      *
 683 \subsection{Switch lookup}
 684 %*                                                                      *
 685 %************************************************************************
 686
 687 \begin{code}
 688 isAmongSimpl :: [SimplifierSwitch] -> SimplifierSwitch -> SwitchResult
 689
 690 isAmongSimpl on_switches                -- Switches mentioned later occur *earlier*
 691                                         -- in the list; defaults right at the end.
 692   = let
 693         tidied_on_switches = foldl rm_dups [] on_switches
 694                 -- The fold*l* ensures that we keep the latest switches;
 695                 -- ie the ones that occur earliest in the list.
 696
 697         sw_tbl :: Array Int SwitchResult
 698         sw_tbl = (array (0, lAST_SIMPL_SWITCH_TAG) -- bounds...
 699                         all_undefined)
 700                  // defined_elems
 701
 702         all_undefined = [ (i, SwBool False) | i <- [0 .. lAST_SIMPL_SWITCH_TAG ] ]
 703
 704         defined_elems = map mk_assoc_elem tidied_on_switches
 705     in
 706     -- (avoid some unboxing, bounds checking, and other horrible things:)
 707 #if __GLASGOW_HASKELL__ < 405
 708     case sw_tbl of { Array bounds_who_needs_'em stuff ->
 709 #else
 710     case sw_tbl of { Array _ _ stuff ->
 711 #endif
 712     \ switch ->
 713         case (indexArray# stuff (tagOf_SimplSwitch switch)) of
 714 #if __GLASGOW_HASKELL__ < 400
 715           Lift v -> v
 716 #elif __GLASGOW_HASKELL__ < 403
 717           (# _, v #) -> v
 718 #else
 719           (# v #) -> v
 720 #endif
 721     }
 722   where
 723     mk_assoc_elem k@(MaxSimplifierIterations lvl) = (IBOX(tagOf_SimplSwitch k), SwInt lvl)
 724     mk_assoc_elem k@(SimplInlinePhase n)          = (IBOX(tagOf_SimplSwitch k), SwInt n)
 725     mk_assoc_elem k                               = (IBOX(tagOf_SimplSwitch k), SwBool True) -- I'm here, Mom!
 726
 727     -- cannot have duplicates if we are going to use the array thing
 728     rm_dups switches_so_far switch
 729       = if switch `is_elem` switches_so_far
 730         then switches_so_far
 731         else switch : switches_so_far
 732       where
 733         sw `is_elem` []     = False
 734         sw `is_elem` (s:ss) = (tagOf_SimplSwitch sw) _EQ_ (tagOf_SimplSwitch s)
 735                             || sw `is_elem` ss
 736 \end{code}
 737
 738 Default settings for simplifier switches
 739
 740 \begin{code}
 741 defaultSimplSwitches = [MaxSimplifierIterations 1]
 742 \end{code}
 743
 744 %************************************************************************
 745 %*                                                                      *
 746 \subsection{Misc functions for command-line options}
 747 %*                                                                      *
 748 %************************************************************************
 749
 750
 751 \begin{code}
 752 switchIsOn :: (switch -> SwitchResult) -> switch -> Bool
 753
 754 switchIsOn lookup_fn switch
 755   = case (lookup_fn switch) of
 756       SwBool False -> False
 757       _            -> True
 758
 759 intSwitchSet :: (switch -> SwitchResult)
 760              -> (Int -> switch)
 761              -> Maybe Int
 762
 763 intSwitchSet lookup_fn switch
 764   = case (lookup_fn (switch (panic "intSwitchSet"))) of
 765       SwInt int -> Just int
 766       _         -> Nothing
 767 \end{code}
 768
 769 \begin{code}
 770 startsWith :: String -> String -> Maybe String
 771 -- startsWith pfx (pfx++rest) = Just rest
 772
 773 startsWith []     str = Just str
 774 startsWith (c:cs) (s:ss)
 775   = if c /= s then Nothing else startsWith cs ss
 776 startsWith  _     []  = Nothing
 777
 778 endsWith  :: String -> String -> Maybe String
 779 endsWith cs ss
 780   = case (startsWith (reverse cs) (reverse ss)) of
 781       Nothing -> Nothing
 782       Just rs -> Just (reverse rs)
 783 \end{code}