ghc/compiler/main/CmdLineOpts.lhs

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