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