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 import FastTypes
 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 an abstract type, DynFlags, which is
 192 passed into hsc by the compilation manager for every compilation.
 193 Dynamic flags are those that change on a per-compilation basis,
 194 perhaps because they may be present in the OPTIONS pragma at the top
 195 of a module.
 196
 197 Other flag-related blurb:
 198
 199 A list of {\em ToDo}s is things to be done in a particular part of
 200 processing.  A (fictitious) example for the Core-to-Core simplifier
 201 might be: run the simplifier, then run the strictness analyser, then
 202 run the simplifier again (three ``todos'').
 203
 204 There are three ``to-do processing centers'' at the moment.  In the
 205 main loop (\tr{main/Main.lhs}), in the Core-to-Core processing loop
 206 (\tr{simplCore/SimplCore.lhs), and in the STG-to-STG processing loop
 207 (\tr{simplStg/SimplStg.lhs}).
 208
 209 %************************************************************************
 210 %*                                                                      *
 211 \subsection{Datatypes associated with command-line options}
 212 %*                                                                      *
 213 %************************************************************************
 214
 215 \begin{code}
 216 data SwitchResult
 217   = SwBool      Bool            -- on/off
 218   | SwString    FAST_STRING     -- nothing or a String
 219   | SwInt       Int             -- nothing or an Int
 220 \end{code}
 221
 222 \begin{code}
 223 data CoreToDo           -- These are diff core-to-core passes,
 224                         -- which may be invoked in any order,
 225                         -- as many times as you like.
 226
 227   = CoreDoSimplify      -- The core-to-core simplifier.
 228         (SimplifierSwitch -> SwitchResult)
 229                         -- Each run of the simplifier can take a different
 230                         -- set of simplifier-specific flags.
 231   | CoreDoFloatInwards
 232   | CoreDoFloatOutwards Bool    -- True <=> float lambdas to top level
 233   | CoreLiberateCase
 234   | CoreDoPrintCore
 235   | CoreDoStaticArgs
 236   | CoreDoStrictness
 237   | CoreDoWorkerWrapper
 238   | CoreDoSpecialising
 239   | CoreDoUSPInf
 240   | CoreDoCPResult
 241   | CoreDoGlomBinds
 242   | CoreCSE
 243
 244   | CoreDoNothing        -- useful when building up lists of these things
 245 \end{code}
 246
 247 \begin{code}
 248 data StgToDo
 249   = StgDoStaticArgs
 250   | StgDoLambdaLift
 251   | StgDoMassageForProfiling  -- should be (next to) last
 252   -- There's also setStgVarInfo, but its absolute "lastness"
 253   -- is so critical that it is hardwired in (no flag).
 254   | D_stg_stats
 255 \end{code}
 256
 257 \begin{code}
 258 data SimplifierSwitch
 259   = MaxSimplifierIterations Int
 260   | SimplInlinePhase Int
 261   | DontApplyRules
 262   | NoCaseOfCase
 263   | SimplLetToCase
 264 \end{code}
 265
 266 %************************************************************************
 267 %*                                                                      *
 268 \subsection{Dynamic command-line options}
 269 %*                                                                      *
 270 %************************************************************************
 271
 272 \begin{code}
 273 data DynFlag
 274
 275    -- debugging flags
 276    = Opt_D_dump_all
 277    | Opt_D_dump_most
 278    | Opt_D_dump_absC
 279    | Opt_D_dump_asm
 280    | Opt_D_dump_cpranal
 281    | Opt_D_dump_deriv
 282    | Opt_D_dump_ds
 283    | Opt_D_dump_flatC
 284    | Opt_D_dump_foreign
 285    | Opt_D_dump_inlinings
 286    | Opt_D_dump_occur_anal
 287    | Opt_D_dump_parsed
 288    | Opt_D_dump_realC
 289    | Opt_D_dump_rn
 290    | Opt_D_dump_simpl
 291    | Opt_D_dump_simpl_iterations
 292    | Opt_D_dump_spec
 293    | Opt_D_dump_stg
 294    | Opt_D_dump_stranal
 295    | Opt_D_dump_tc
 296    | Opt_D_dump_types
 297    | Opt_D_dump_rules
 298    | Opt_D_dump_usagesp
 299    | Opt_D_dump_cse
 300    | Opt_D_dump_worker_wrapper
 301    | Opt_D_show_passes
 302    | Opt_D_dump_rn_trace
 303    | Opt_D_dump_rn_stats
 304    | Opt_D_dump_stix
 305    | Opt_D_dump_simpl_stats
 306    | Opt_D_source_stats
 307    | Opt_D_verbose_core2core
 308    | Opt_D_verbose_stg2stg
 309    | Opt_D_dump_hi_diffs
 310    | Opt_D_dump_minimal_imports
 311    | Opt_DoCoreLinting
 312    | Opt_DoStgLinting
 313    | Opt_DoUSPLinting
 314
 315    -- language opts
 316    | Opt_AllowOverlappingInstances
 317    | Opt_AllowUndecidableInstances
 318    | Opt_GlasgowExts
 319    deriving (Eq)
 320
 321 data DynFlags = DynFlags {
 322   coreToDo :: CoreToDo,
 323   stgToDo  :: StgToDo,
 324   hscLang  :: HscLang,
 325   flags    :: [DynFlag]
 326  }
 327
 328 boolOpt :: DynFlag -> DynFlags -> Bool
 329 boolOpt f dflags  = f `elem` (flags dflags)
 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 = coreToDo
 376
 377 dopt_StgToDo :: DynFlags -> StgToDo
 378 dopt_StgToDo = stgToDo
 379
 380 data HscLang
 381   = HscC
 382   | HscAsm
 383   | HscJava
 384   deriving Eq
 385
 386 dopt_HscLang :: DynFlags -> HscLang
 387 dopt_HscLang = hscLang
 388 \end{code}
 389
 390 %************************************************************************
 391 %*                                                                      *
 392 \subsection{Classifying command-line options}
 393 %*                                                                      *
 394 %************************************************************************
 395
 396 \begin{code}
 397 lookUp           :: FAST_STRING -> Bool
 398 lookup_int       :: String -> Maybe Int
 399 lookup_def_int   :: String -> Int -> Int
 400 lookup_def_float :: String -> Float -> Float
 401 lookup_str       :: String -> Maybe String
 402
 403 lookUp     sw = sw `elem` argv
 404
 405 lookup_str sw = firstJust (map (startsWith sw) unpacked_opts)
 406
 407 lookup_int sw = case (lookup_str sw) of
 408                   Nothing -> Nothing
 409                   Just xx -> Just (read xx)
 410
 411 lookup_def_int sw def = case (lookup_str sw) of
 412                             Nothing -> def              -- Use default
 413                             Just xx -> read xx
 414
 415 lookup_def_char sw def = case (lookup_str sw) of
 416                             Just (xx:_) -> xx
 417                             _           -> def          -- Use default
 418
 419 lookup_def_float sw def = case (lookup_str sw) of
 420                             Nothing -> def              -- Use default
 421                             Just xx -> read xx
 422
 423 unpacked_opts = map _UNPK_ argv
 424
 425 {-
 426  Putting the compiler options into temporary at-files
 427  may turn out to be necessary later on if we turn hsc into
 428  a pure Win32 application where I think there's a command-line
 429  length limit of 255. unpacked_opts understands the @ option.
 430
 431 unpacked_opts :: [String]
 432 unpacked_opts =
 433   concat $
 434   map (expandAts) $
 435   map _UNPK_ argv
 436   where
 437    expandAts ('@':fname) = words (unsafePerformIO (readFile fname))
 438    expandAts l = [l]
 439 -}
 440 \end{code}
 441
 442 %************************************************************************
 443 %*                                                                      *
 444 \subsection{Static options}
 445 %*                                                                      *
 446 %************************************************************************
 447
 448 \begin{code}
 449 -- debugging opts
 450 opt_PprStyle_NoPrags            = lookUp  SLIT("-dppr-noprags")
 451 opt_PprStyle_Debug              = lookUp  SLIT("-dppr-debug")
 452 opt_PprUserLength               = lookup_def_int "-dppr-user-length" 5 --ToDo: give this a name
 453
 454 -- warning opts
 455 opt_WarnDuplicateExports        = lookUp  SLIT("-fwarn-duplicate-exports")
 456 opt_WarnHiShadows               = lookUp  SLIT("-fwarn-hi-shadowing")
 457 opt_WarnIncompletePatterns      = lookUp  SLIT("-fwarn-incomplete-patterns")
 458 opt_WarnMissingFields           = lookUp  SLIT("-fwarn-missing-fields")
 459 opt_WarnMissingMethods          = lookUp  SLIT("-fwarn-missing-methods")
 460 opt_WarnMissingSigs             = lookUp  SLIT("-fwarn-missing-signatures")
 461 opt_WarnNameShadowing           = lookUp  SLIT("-fwarn-name-shadowing")
 462 opt_WarnOverlappingPatterns     = lookUp  SLIT("-fwarn-overlapping-patterns")
 463 opt_WarnSimplePatterns          = lookUp  SLIT("-fwarn-simple-patterns")
 464 opt_WarnTypeDefaults            = lookUp  SLIT("-fwarn-type-defaults")
 465 opt_WarnUnusedBinds             = lookUp  SLIT("-fwarn-unused-binds")
 466 opt_WarnUnusedImports           = lookUp  SLIT("-fwarn-unused-imports")
 467 opt_WarnUnusedMatches           = lookUp  SLIT("-fwarn-unused-matches")
 468 opt_WarnDeprecations            = lookUp  SLIT("-fwarn-deprecations")
 469
 470 -- profiling opts
 471 opt_AutoSccsOnAllToplevs        = lookUp  SLIT("-fauto-sccs-on-all-toplevs")
 472 opt_AutoSccsOnExportedToplevs   = lookUp  SLIT("-fauto-sccs-on-exported-toplevs")
 473 opt_AutoSccsOnIndividualCafs    = lookUp  SLIT("-fauto-sccs-on-individual-cafs")
 474 opt_AutoSccsOnDicts             = lookUp  SLIT("-fauto-sccs-on-dicts")
 475 opt_SccProfilingOn              = lookUp  SLIT("-fscc-profiling")
 476 opt_DoTickyProfiling            = lookUp  SLIT("-fticky-ticky")
 477
 478 -- language opts
 479 opt_AllStrict                   = lookUp  SLIT("-fall-strict")
 480 opt_DictsStrict                 = lookUp  SLIT("-fdicts-strict")
 481 opt_Generics                    = lookUp  SLIT("-fgenerics")
 482 opt_IrrefutableTuples           = lookUp  SLIT("-firrefutable-tuples")
 483 opt_MaxContextReductionDepth    = lookup_def_int "-fcontext-stack" mAX_CONTEXT_REDUCTION_DEPTH
 484 opt_NumbersStrict               = lookUp  SLIT("-fnumbers-strict")
 485 opt_Parallel                    = lookUp  SLIT("-fparallel")
 486 opt_SMP                         = lookUp  SLIT("-fsmp")
 487
 488 -- optimisation opts
 489 opt_DoSemiTagging               = lookUp  SLIT("-fsemi-tagging")
 490 opt_FoldrBuildOn                = lookUp  SLIT("-ffoldr-build-on")
 491 opt_LiberateCaseThreshold       = lookup_def_int "-fliberate-case-threshold" (10::Int)
 492 opt_StgDoLetNoEscapes           = lookUp  SLIT("-flet-no-escape")
 493 opt_UnfoldCasms                 = lookUp SLIT("-funfold-casms-in-hi-file")
 494 opt_UsageSPOn                   = lookUp  SLIT("-fusagesp-on")
 495 opt_UnboxStrictFields           = lookUp  SLIT("-funbox-strict-fields")
 496
 497 {-
 498    The optional '-inpackage=P' flag tells what package
 499    we are compiling this module for.
 500    The Prelude, for example is compiled with '-package prelude'
 501 -}
 502 opt_InPackage                   = case lookup_str "-inpackage=" of
 503                                     Just p  -> _PK_ p
 504                                     Nothing -> SLIT("Main")     -- The package name if none is specified
 505
 506 opt_EmitCExternDecls            = lookUp  SLIT("-femit-extern-decls")
 507 opt_EnsureSplittableC           = lookUp  SLIT("-fglobalise-toplev-names")
 508 opt_GranMacros                  = lookUp  SLIT("-fgransim")
 509 opt_HiVersion                   = lookup_def_int "-fhi-version=" 0 -- what version we're compiling.
 510 opt_HistorySize                 = lookup_def_int "-fhistory-size" 20
 511 opt_IgnoreAsserts               = lookUp  SLIT("-fignore-asserts")
 512 opt_IgnoreIfacePragmas          = lookUp  SLIT("-fignore-interface-pragmas")
 513 opt_NoHiCheck                   = lookUp  SLIT("-fno-hi-version-check")
 514 opt_NoImplicitPrelude           = lookUp  SLIT("-fno-implicit-prelude")
 515 opt_OmitBlackHoling             = lookUp  SLIT("-dno-black-holing")
 516 opt_OmitInterfacePragmas        = lookUp  SLIT("-fomit-interface-pragmas")
 517
 518 -- Simplifier switches
 519 opt_SimplNoPreInlining          = lookUp SLIT("-fno-pre-inlining")
 520         -- NoPreInlining is there just to see how bad things
 521         -- get if you don't do it!
 522 opt_SimplDoEtaReduction         = lookUp SLIT("-fdo-eta-reduction")
 523 opt_SimplDoLambdaEtaExpansion   = lookUp SLIT("-fdo-lambda-eta-expansion")
 524 opt_SimplCaseOfCase             = lookUp SLIT("-fcase-of-case")
 525 opt_SimplCaseMerge              = lookUp SLIT("-fcase-merge")
 526 opt_SimplPedanticBottoms        = lookUp SLIT("-fpedantic-bottoms")
 527 opt_SimplExcessPrecision        = lookUp SLIT("-fexcess-precision")
 528
 529 -- Unfolding control
 530 opt_UF_HiFileThreshold          = lookup_def_int "-funfolding-interface-threshold" (45::Int)
 531 opt_UF_CreationThreshold        = lookup_def_int "-funfolding-creation-threshold"  (45::Int)
 532 opt_UF_UseThreshold             = lookup_def_int "-funfolding-use-threshold"       (8::Int)     -- Discounts can be big
 533 opt_UF_FunAppDiscount           = lookup_def_int "-funfolding-fun-discount"        (6::Int)     -- It's great to inline a fn
 534 opt_UF_KeenessFactor            = lookup_def_float "-funfolding-keeness-factor"    (1.5::Float)
 535 opt_UF_UpdateInPlace            = lookUp  SLIT("-funfolding-update-in-place")
 536
 537 opt_UF_CheapOp  = ( 1 :: Int)   -- Only one instruction; and the args are charged for
 538 opt_UF_DearOp   = ( 4 :: Int)
 539
 540 opt_ReportCompile               = lookUp SLIT("-freport-compile")
 541 opt_NoPruneDecls                = lookUp SLIT("-fno-prune-decls")
 542 opt_NoPruneTyDecls              = lookUp SLIT("-fno-prune-tydecls")
 543 opt_Static                      = lookUp SLIT("-static")
 544 opt_Unregisterised              = lookUp SLIT("-funregisterised")
 545 opt_Verbose                     = lookUp SLIT("-v")
 546
 547 opt_UseVanillaRegs | opt_Unregisterised = 0
 548                    | otherwise          = mAX_Real_Vanilla_REG
 549 opt_UseFloatRegs   | opt_Unregisterised = 0
 550                    | otherwise          = mAX_Real_Float_REG
 551 opt_UseDoubleRegs  | opt_Unregisterised = 0
 552                    | otherwise          = mAX_Real_Double_REG
 553 opt_UseLongRegs    | opt_Unregisterised = 0
 554                    | otherwise          = mAX_Real_Long_REG
 555 \end{code}
 556
 557 %************************************************************************
 558 %*                                                                      *
 559 \subsection{List of static hsc flags}
 560 %*                                                                      *
 561 %************************************************************************
 562
 563 \begin{code}
 564 isStaticHscFlag f =
 565   f `elem` [
 566         "-fwarn-duplicate-exports",
 567         "-fwarn-hi-shadowing",
 568         "-fwarn-incomplete-patterns",
 569         "-fwarn-missing-fields",
 570         "-fwarn-missing-methods",
 571         "-fwarn-missing-signatures",
 572         "-fwarn-name-shadowing",
 573         "-fwarn-overlapping-patterns",
 574         "-fwarn-simple-patterns",
 575         "-fwarn-type-defaults",
 576         "-fwarn-unused-binds",
 577         "-fwarn-unused-imports",
 578         "-fwarn-unused-matches",
 579         "-fwarn-deprecations",
 580         "-fauto-sccs-on-all-toplevs",
 581         "-fauto-sccs-on-exported-toplevs",
 582         "-fauto-sccs-on-individual-cafs",
 583         "-fauto-sccs-on-dicts",
 584         "-fscc-profiling",
 585         "-fticky-ticky",
 586         "-fall-strict",
 587         "-fdicts-strict",
 588         "-fgenerics",
 589         "-firrefutable-tuples",
 590         "-fnumbers-strict",
 591         "-fparallel",
 592         "-fsmp",
 593         "-fsemi-tagging",
 594         "-ffoldr-build-on",
 595         "-flet-no-escape",
 596         "-funfold-casms-in-hi-file",
 597         "-fusagesp-on",
 598         "-funbox-strict-fields",
 599         "-femit-extern-decls",
 600         "-fglobalise-toplev-names",
 601         "-fgransim",
 602         "-fignore-asserts",
 603         "-fignore-interface-pragmas",
 604         "-fno-hi-version-check",
 605         "-fno-implicit-prelude",
 606         "-dno-black-holing",
 607         "-fomit-interface-pragmas",
 608         "-fno-pre-inlining",
 609         "-fdo-eta-reduction",
 610         "-fdo-lambda-eta-expansion",
 611         "-fcase-of-case",
 612         "-fcase-merge",
 613         "-fpedantic-bottoms",
 614         "-fexcess-precision",
 615         "-funfolding-update-in-place",
 616         "-freport-compile",
 617         "-fno-prune-decls",
 618         "-fno-prune-tydecls",
 619         "-static",
 620         "-funregisterised",
 621         "-v" ]
 622   || any (flip prefixMatch f) [
 623         "-fcontext-stack",
 624         "-fliberate-case-threshold",
 625         "-fhi-version=",
 626         "-fhistory-size",
 627         "-funfolding-interface-threshold",
 628         "-funfolding-creation-threshold",
 629         "-funfolding-use-threshold",
 630         "-funfolding-fun-discount",
 631         "-funfolding-keeness-factor"
 632      ]
 633 \end{code}
 634
 635 %************************************************************************
 636 %*                                                                      *
 637 \subsection{Switch ordering}
 638 %*                                                                      *
 639 %************************************************************************
 640
 641 These things behave just like enumeration types.
 642
 643 \begin{code}
 644 instance Eq SimplifierSwitch where
 645     a == b = tagOf_SimplSwitch a ==# tagOf_SimplSwitch b
 646
 647 instance Ord SimplifierSwitch where
 648     a <  b  = tagOf_SimplSwitch a <# tagOf_SimplSwitch b
 649     a <= b  = tagOf_SimplSwitch a <=# tagOf_SimplSwitch b
 650
 651
 652 tagOf_SimplSwitch (SimplInlinePhase _)          = _ILIT(1)
 653 tagOf_SimplSwitch (MaxSimplifierIterations _)   = _ILIT(2)
 654 tagOf_SimplSwitch DontApplyRules                = _ILIT(3)
 655 tagOf_SimplSwitch SimplLetToCase                = _ILIT(4)
 656 tagOf_SimplSwitch NoCaseOfCase                  = _ILIT(5)
 657
 658 -- If you add anything here, be sure to change lAST_SIMPL_SWITCH_TAG, too!
 659
 660 lAST_SIMPL_SWITCH_TAG = 5
 661 \end{code}
 662
 663 %************************************************************************
 664 %*                                                                      *
 665 \subsection{Switch lookup}
 666 %*                                                                      *
 667 %************************************************************************
 668
 669 \begin{code}
 670 isAmongSimpl :: [SimplifierSwitch] -> SimplifierSwitch -> SwitchResult
 671 isAmongSimpl on_switches                -- Switches mentioned later occur *earlier*
 672                                         -- in the list; defaults right at the end.
 673   = let
 674         tidied_on_switches = foldl rm_dups [] on_switches
 675                 -- The fold*l* ensures that we keep the latest switches;
 676                 -- ie the ones that occur earliest in the list.
 677
 678         sw_tbl :: Array Int SwitchResult
 679         sw_tbl = (array (0, lAST_SIMPL_SWITCH_TAG) -- bounds...
 680                         all_undefined)
 681                  // defined_elems
 682
 683         all_undefined = [ (i, SwBool False) | i <- [0 .. lAST_SIMPL_SWITCH_TAG ] ]
 684
 685         defined_elems = map mk_assoc_elem tidied_on_switches
 686     in
 687     -- (avoid some unboxing, bounds checking, and other horrible things:)
 688 #if __GLASGOW_HASKELL__ < 405
 689     case sw_tbl of { Array bounds_who_needs_'em stuff ->
 690 #else
 691     case sw_tbl of { Array _ _ stuff ->
 692 #endif
 693     \ switch ->
 694         case (indexArray# stuff (tagOf_SimplSwitch switch)) of
 695 #if __GLASGOW_HASKELL__ < 400
 696           Lift v -> v
 697 #elif __GLASGOW_HASKELL__ < 403
 698           (# _, v #) -> v
 699 #else
 700           (# v #) -> v
 701 #endif
 702     }
 703   where
 704     mk_assoc_elem k@(MaxSimplifierIterations lvl) = (_IBOX(tagOf_SimplSwitch k), SwInt lvl)
 705     mk_assoc_elem k@(SimplInlinePhase n)          = (_IBOX(tagOf_SimplSwitch k), SwInt n)
 706     mk_assoc_elem k                               = (_IBOX(tagOf_SimplSwitch k), SwBool True) -- I'm here, Mom!
 707
 708     -- cannot have duplicates if we are going to use the array thing
 709     rm_dups switches_so_far switch
 710       = if switch `is_elem` switches_so_far
 711         then switches_so_far
 712         else switch : switches_so_far
 713       where
 714         sw `is_elem` []     = False
 715         sw `is_elem` (s:ss) = (tagOf_SimplSwitch sw) ==# (tagOf_SimplSwitch s)
 716                             || sw `is_elem` ss
 717 \end{code}
 718
 719 Default settings for simplifier switches
 720
 721 \begin{code}
 722 defaultSimplSwitches = [MaxSimplifierIterations 1]
 723 \end{code}
 724
 725 %************************************************************************
 726 %*                                                                      *
 727 \subsection{Misc functions for command-line options}
 728 %*                                                                      *
 729 %************************************************************************
 730
 731
 732 \begin{code}
 733 switchIsOn :: (switch -> SwitchResult) -> switch -> Bool
 734
 735 switchIsOn lookup_fn switch
 736   = case (lookup_fn switch) of
 737       SwBool False -> False
 738       _            -> True
 739
 740 intSwitchSet :: (switch -> SwitchResult)
 741              -> (Int -> switch)
 742              -> Maybe Int
 743
 744 intSwitchSet lookup_fn switch
 745   = case (lookup_fn (switch (panic "intSwitchSet"))) of
 746       SwInt int -> Just int
 747       _         -> Nothing
 748 \end{code}
 749
 750 \begin{code}
 751 startsWith :: String -> String -> Maybe String
 752 -- startsWith pfx (pfx++rest) = Just rest
 753
 754 startsWith []     str = Just str
 755 startsWith (c:cs) (s:ss)
 756   = if c /= s then Nothing else startsWith cs ss
 757 startsWith  _     []  = Nothing
 758
 759 endsWith  :: String -> String -> Maybe String
 760 endsWith cs ss
 761   = case (startsWith (reverse cs) (reverse ss)) of
 762       Nothing -> Nothing
 763       Just rs -> Just (reverse rs)
 764 \end{code}