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         HscLang(..),
  14         classifyOpts,
  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 a function:
 188
 189         checkDynFlag :: DynFlag -> SwitchResult
 190
 191 which is passed into hsc by the compilation manager for every
 192 compilation.  Dynamic flags are those that change on a per-compilation
 193 basis, perhaps because they may be present in the OPTIONS pragma at
 194 the top 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 \end{code}
 243
 244 \begin{code}
 245 data StgToDo
 246   = StgDoStaticArgs
 247   | StgDoLambdaLift
 248   | StgDoMassageForProfiling  -- should be (next to) last
 249   -- There's also setStgVarInfo, but its absolute "lastness"
 250   -- is so critical that it is hardwired in (no flag).
 251   | D_stg_stats
 252 \end{code}
 253
 254 \begin{code}
 255 data SimplifierSwitch
 256   = MaxSimplifierIterations Int
 257   | SimplInlinePhase Int
 258   | DontApplyRules
 259   | NoCaseOfCase
 260   | SimplLetToCase
 261 \end{code}
 262
 263 %************************************************************************
 264 %*                                                                      *
 265 \subsection{Dynamic command-line options}
 266 %*                                                                      *
 267 %************************************************************************
 268
 269 \begin{code}
 270 data DynFlag
 271
 272    -- debugging flags
 273    = Opt_D_dump_all
 274    | Opt_D_dump_most
 275    | Opt_D_dump_absC
 276    | Opt_D_dump_asm
 277    | Opt_D_dump_cpranal
 278    | Opt_D_dump_deriv
 279    | Opt_D_dump_ds
 280    | Opt_D_dump_flatC
 281    | Opt_D_dump_foreign
 282    | Opt_D_dump_inlinings
 283    | Opt_D_dump_occur_anal
 284    | Opt_D_dump_parsed
 285    | Opt_D_dump_realC
 286    | Opt_D_dump_rn
 287    | Opt_D_dump_simpl
 288    | Opt_D_dump_simpl_iterations
 289    | Opt_D_dump_spec
 290    | Opt_D_dump_stg
 291    | Opt_D_dump_stranal
 292    | Opt_D_dump_tc
 293    | Opt_D_dump_types
 294    | Opt_D_dump_rules
 295    | Opt_D_dump_usagesp
 296    | Opt_D_dump_cse
 297    | Opt_D_dump_worker_wrapper
 298    | Opt_D_show_passes
 299    | Opt_D_dump_rn_trace
 300    | Opt_D_dump_rn_stats
 301    | Opt_D_dump_stix
 302    | Opt_D_dump_simpl_stats
 303    | Opt_D_source_stats
 304    | Opt_D_verbose_core2core
 305    | Opt_D_verbose_stg2stg
 306    | Opt_D_dump_hi_diffs
 307    | Opt_D_dump_minimal_imports
 308    | Opt_DoCoreLinting
 309    | Opt_DoStgLinting
 310    | Opt_DoUSPLinting
 311
 312    -- language opts
 313    | Opt_AllowOverlappingInstances
 314    | Opt_AllowUndecidableInstances
 315    | Opt_GlasgowExts
 316    deriving (Eq)
 317
 318 data DynFlags = DynFlags {
 319   coreToDo :: CoreToDo,
 320   stgToDo  :: StgToDo,
 321   hscLang  :: HscLang,
 322   flags    :: [(DynFlag, SwitchResult)]
 323  }
 324
 325 boolOpt :: DynFlag -> DynFlags -> Bool
 326 boolOpt f dflags
 327   = case lookup f (flags dflags) of
 328         Nothing -> False
 329         Just (SwBool b) -> b
 330         _ -> panic "boolOpt"
 331
 332 dopt_D_dump_all              = boolOpt Opt_D_dump_all
 333 dopt_D_dump_most             = boolOpt Opt_D_dump_most
 334 dopt_D_dump_absC             = boolOpt Opt_D_dump_absC
 335 dopt_D_dump_asm              = boolOpt Opt_D_dump_asm
 336 dopt_D_dump_cpranal          = boolOpt Opt_D_dump_cpranal
 337 dopt_D_dump_deriv            = boolOpt Opt_D_dump_deriv
 338 dopt_D_dump_ds               = boolOpt Opt_D_dump_ds
 339 dopt_D_dump_flatC            = boolOpt Opt_D_dump_flatC
 340 dopt_D_dump_foreign          = boolOpt Opt_D_dump_foreign
 341 dopt_D_dump_inlinings        = boolOpt Opt_D_dump_inlinings
 342 dopt_D_dump_occur_anal       = boolOpt Opt_D_dump_occur_anal
 343 dopt_D_dump_parsed           = boolOpt Opt_D_dump_parsed
 344 dopt_D_dump_realC            = boolOpt Opt_D_dump_realC
 345 dopt_D_dump_rn               = boolOpt Opt_D_dump_rn
 346 dopt_D_dump_simpl            = boolOpt Opt_D_dump_simpl
 347 dopt_D_dump_simpl_iterations = boolOpt Opt_D_dump_simpl_iterations
 348 dopt_D_dump_spec             = boolOpt Opt_D_dump_spec
 349 dopt_D_dump_stg              = boolOpt Opt_D_dump_stg
 350 dopt_D_dump_stranal          = boolOpt Opt_D_dump_stranal
 351 dopt_D_dump_tc               = boolOpt Opt_D_dump_tc
 352 dopt_D_dump_types            = boolOpt Opt_D_dump_types
 353 dopt_D_dump_rules            = boolOpt Opt_D_dump_rules
 354 dopt_D_dump_usagesp          = boolOpt Opt_D_dump_usagesp
 355 dopt_D_dump_cse              = boolOpt Opt_D_dump_cse
 356 dopt_D_dump_worker_wrapper   = boolOpt Opt_D_dump_worker_wrapper
 357 dopt_D_show_passes           = boolOpt Opt_D_show_passes
 358 dopt_D_dump_rn_trace         = boolOpt Opt_D_dump_rn_trace
 359 dopt_D_dump_rn_stats         = boolOpt Opt_D_dump_rn_stats
 360 dopt_D_dump_stix             = boolOpt Opt_D_dump_stix
 361 dopt_D_dump_simpl_stats      = boolOpt Opt_D_dump_simpl_stats
 362 dopt_D_source_stats          = boolOpt Opt_D_source_stats
 363 dopt_D_verbose_core2core     = boolOpt Opt_D_verbose_core2core
 364 dopt_D_verbose_stg2stg       = boolOpt Opt_D_verbose_stg2stg
 365 dopt_D_dump_hi_diffs         = boolOpt Opt_D_dump_hi_diffs
 366 dopt_D_dump_minimal_imports  = boolOpt Opt_D_dump_minimal_imports
 367 dopt_DoCoreLinting           = boolOpt Opt_DoCoreLinting
 368 dopt_DoStgLinting            = boolOpt Opt_DoStgLinting
 369 dopt_DoUSPLinting            = boolOpt Opt_DoUSPLinting
 370
 371 dopt_AllowOverlappingInstances = boolOpt Opt_AllowOverlappingInstances
 372 dopt_AllowUndecidableInstances = boolOpt Opt_AllowUndecidableInstances
 373 dopt_GlasgowExts               = boolOpt Opt_GlasgowExts
 374
 375 dopt_CoreToDo :: DynFlags -> CoreToDo
 376 dopt_CoreToDo = coreToDo
 377
 378 dopt_StgToDo :: DynFlags -> StgToDo
 379 dopt_StgToDo = stgToDo
 380
 381 data HscLang
 382   = HscC
 383   | HscAsm
 384   | HscJava
 385   deriving Eq
 386
 387 dopt_HscLang :: DynFlags -> HscLang
 388 dopt_HscLang = hscLang
 389 \end{code}
 390
 391 %************************************************************************
 392 %*                                                                      *
 393 \subsection{Classifying command-line options}
 394 %*                                                                      *
 395 %************************************************************************
 396
 397 \begin{code}
 398 lookUp           :: FAST_STRING -> Bool
 399 lookup_int       :: String -> Maybe Int
 400 lookup_def_int   :: String -> Int -> Int
 401 lookup_def_float :: String -> Float -> Float
 402 lookup_str       :: String -> Maybe String
 403
 404 lookUp     sw = sw `elem` argv
 405
 406 lookup_str sw = firstJust (map (startsWith sw) unpacked_opts)
 407
 408 lookup_int sw = case (lookup_str sw) of
 409                   Nothing -> Nothing
 410                   Just xx -> Just (read xx)
 411
 412 lookup_def_int sw def = case (lookup_str sw) of
 413                             Nothing -> def              -- Use default
 414                             Just xx -> read xx
 415
 416 lookup_def_char sw def = case (lookup_str sw) of
 417                             Just (xx:_) -> xx
 418                             _           -> def          -- Use default
 419
 420 lookup_def_float sw def = case (lookup_str sw) of
 421                             Nothing -> def              -- Use default
 422                             Just xx -> read xx
 423
 424 unpacked_opts = map _UNPK_ argv
 425
 426 {-
 427  Putting the compiler options into temporary at-files
 428  may turn out to be necessary later on if we turn hsc into
 429  a pure Win32 application where I think there's a command-line
 430  length limit of 255. unpacked_opts understands the @ option.
 431
 432 unpacked_opts :: [String]
 433 unpacked_opts =
 434   concat $
 435   map (expandAts) $
 436   map _UNPK_ argv
 437   where
 438    expandAts ('@':fname) = words (unsafePerformIO (readFile fname))
 439    expandAts l = [l]
 440 -}
 441 \end{code}
 442
 443 %************************************************************************
 444 %*                                                                      *
 445 \subsection{Static options}
 446 %*                                                                      *
 447 %************************************************************************
 448
 449 \begin{code}
 450 -- debugging opts
 451 opt_PprStyle_NoPrags            = lookUp  SLIT("-dppr-noprags")
 452 opt_PprStyle_Debug              = lookUp  SLIT("-dppr-debug")
 453 opt_PprUserLength               = lookup_def_int "-dppr-user-length" 5 --ToDo: give this a name
 454
 455 -- warning opts
 456 opt_WarnDuplicateExports        = lookUp  SLIT("-fwarn-duplicate-exports")
 457 opt_WarnHiShadows               = lookUp  SLIT("-fwarn-hi-shadowing")
 458 opt_WarnIncompletePatterns      = lookUp  SLIT("-fwarn-incomplete-patterns")
 459 opt_WarnMissingFields           = lookUp  SLIT("-fwarn-missing-fields")
 460 opt_WarnMissingMethods          = lookUp  SLIT("-fwarn-missing-methods")
 461 opt_WarnMissingSigs             = lookUp  SLIT("-fwarn-missing-signatures")
 462 opt_WarnNameShadowing           = lookUp  SLIT("-fwarn-name-shadowing")
 463 opt_WarnOverlappingPatterns     = lookUp  SLIT("-fwarn-overlapping-patterns")
 464 opt_WarnSimplePatterns          = lookUp  SLIT("-fwarn-simple-patterns")
 465 opt_WarnTypeDefaults            = lookUp  SLIT("-fwarn-type-defaults")
 466 opt_WarnUnusedBinds             = lookUp  SLIT("-fwarn-unused-binds")
 467 opt_WarnUnusedImports           = lookUp  SLIT("-fwarn-unused-imports")
 468 opt_WarnUnusedMatches           = lookUp  SLIT("-fwarn-unused-matches")
 469 opt_WarnDeprecations            = lookUp  SLIT("-fwarn-deprecations")
 470
 471 -- profiling opts
 472 opt_AutoSccsOnAllToplevs        = lookUp  SLIT("-fauto-sccs-on-all-toplevs")
 473 opt_AutoSccsOnExportedToplevs   = lookUp  SLIT("-fauto-sccs-on-exported-toplevs")
 474 opt_AutoSccsOnIndividualCafs    = lookUp  SLIT("-fauto-sccs-on-individual-cafs")
 475 opt_AutoSccsOnDicts             = lookUp  SLIT("-fauto-sccs-on-dicts")
 476 opt_SccProfilingOn              = lookUp  SLIT("-fscc-profiling")
 477 opt_DoTickyProfiling            = lookUp  SLIT("-fticky-ticky")
 478
 479 -- language opts
 480 opt_AllStrict                   = lookUp  SLIT("-fall-strict")
 481 opt_DictsStrict                 = lookUp  SLIT("-fdicts-strict")
 482 opt_Generics                    = lookUp  SLIT("-fgenerics")
 483 opt_IrrefutableTuples           = lookUp  SLIT("-firrefutable-tuples")
 484 opt_MaxContextReductionDepth    = lookup_def_int "-fcontext-stack" mAX_CONTEXT_REDUCTION_DEPTH
 485 opt_NumbersStrict               = lookUp  SLIT("-fnumbers-strict")
 486 opt_Parallel                    = lookUp  SLIT("-fparallel")
 487 opt_SMP                         = lookUp  SLIT("-fsmp")
 488
 489 -- optimisation opts
 490 opt_DoSemiTagging               = lookUp  SLIT("-fsemi-tagging")
 491 opt_FoldrBuildOn                = lookUp  SLIT("-ffoldr-build-on")
 492 opt_LiberateCaseThreshold       = lookup_def_int "-fliberate-case-threshold" (10::Int)
 493 opt_StgDoLetNoEscapes           = lookUp  SLIT("-flet-no-escape")
 494 opt_UnfoldCasms                 = lookUp SLIT("-funfold-casms-in-hi-file")
 495 opt_UsageSPOn                   = lookUp  SLIT("-fusagesp-on")
 496 opt_UnboxStrictFields           = lookUp  SLIT("-funbox-strict-fields")
 497
 498 {-
 499    The optional '-inpackage=P' flag tells what package
 500    we are compiling this module for.
 501    The Prelude, for example is compiled with '-package prelude'
 502 -}
 503 opt_InPackage                   = case lookup_str "-inpackage=" of
 504                                     Just p  -> _PK_ p
 505                                     Nothing -> SLIT("Main")     -- The package name if none is specified
 506
 507 opt_EmitCExternDecls            = lookUp  SLIT("-femit-extern-decls")
 508 opt_EnsureSplittableC           = lookUp  SLIT("-fglobalise-toplev-names")
 509 opt_GranMacros                  = lookUp  SLIT("-fgransim")
 510 opt_HiVersion                   = lookup_def_int "-fhi-version=" 0 -- what version we're compiling.
 511 opt_HistorySize                 = lookup_def_int "-fhistory-size" 20
 512 opt_IgnoreAsserts               = lookUp  SLIT("-fignore-asserts")
 513 opt_IgnoreIfacePragmas          = lookUp  SLIT("-fignore-interface-pragmas")
 514 opt_NoHiCheck                   = lookUp  SLIT("-fno-hi-version-check")
 515 opt_NoImplicitPrelude           = lookUp  SLIT("-fno-implicit-prelude")
 516 opt_OmitBlackHoling             = lookUp  SLIT("-dno-black-holing")
 517 opt_OmitInterfacePragmas        = lookUp  SLIT("-fomit-interface-pragmas")
 518
 519 -- Simplifier switches
 520 opt_SimplNoPreInlining          = lookUp SLIT("-fno-pre-inlining")
 521         -- NoPreInlining is there just to see how bad things
 522         -- get if you don't do it!
 523 opt_SimplDoEtaReduction         = lookUp SLIT("-fdo-eta-reduction")
 524 opt_SimplDoLambdaEtaExpansion   = lookUp SLIT("-fdo-lambda-eta-expansion")
 525 opt_SimplCaseOfCase             = lookUp SLIT("-fcase-of-case")
 526 opt_SimplCaseMerge              = lookUp SLIT("-fcase-merge")
 527 opt_SimplPedanticBottoms        = lookUp SLIT("-fpedantic-bottoms")
 528 opt_SimplExcessPrecision        = lookUp SLIT("-fexcess-precision")
 529
 530 -- Unfolding control
 531 opt_UF_HiFileThreshold          = lookup_def_int "-funfolding-interface-threshold" (45::Int)
 532 opt_UF_CreationThreshold        = lookup_def_int "-funfolding-creation-threshold"  (45::Int)
 533 opt_UF_UseThreshold             = lookup_def_int "-funfolding-use-threshold"       (8::Int)     -- Discounts can be big
 534 opt_UF_FunAppDiscount           = lookup_def_int "-funfolding-fun-discount"        (6::Int)     -- It's great to inline a fn
 535 opt_UF_KeenessFactor            = lookup_def_float "-funfolding-keeness-factor"    (1.5::Float)
 536 opt_UF_UpdateInPlace            = lookUp  SLIT("-funfolding-update-in-place")
 537
 538 opt_UF_CheapOp  = ( 1 :: Int)   -- Only one instruction; and the args are charged for
 539 opt_UF_DearOp   = ( 4 :: Int)
 540
 541 opt_ReportCompile               = lookUp SLIT("-freport-compile")
 542 opt_NoPruneDecls                = lookUp SLIT("-fno-prune-decls")
 543 opt_NoPruneTyDecls              = lookUp SLIT("-fno-prune-tydecls")
 544 opt_Static                      = lookUp SLIT("-static")
 545 opt_Unregisterised              = lookUp SLIT("-funregisterised")
 546 opt_Verbose                     = lookUp SLIT("-v")
 547
 548 opt_UseVanillaRegs | opt_Unregisterised = 0
 549                    | otherwise          = mAX_Real_Vanilla_REG
 550 opt_UseFloatRegs   | opt_Unregisterised = 0
 551                    | otherwise          = mAX_Real_Float_REG
 552 opt_UseDoubleRegs  | opt_Unregisterised = 0
 553                    | otherwise          = mAX_Real_Double_REG
 554 opt_UseLongRegs    | opt_Unregisterised = 0
 555                    | otherwise          = mAX_Real_Long_REG
 556 \end{code}
 557
 558 \begin{code}
 559 classifyOpts :: ([CoreToDo],    -- Core-to-Core processing spec
 560                  [StgToDo])     -- STG-to-STG   processing spec
 561
 562 classifyOpts = sep argv [] [] -- accumulators...
 563   where
 564     sep :: [FAST_STRING]                 -- cmd-line opts (input)
 565         -> [CoreToDo] -> [StgToDo]       -- to_do accumulators
 566         -> ([CoreToDo], [StgToDo])       -- result
 567
 568     sep [] core_td stg_td -- all done!
 569       = (reverse core_td, reverse stg_td)
 570
 571 #       define CORE_TD(to_do) sep opts (to_do:core_td) stg_td
 572 #       define STG_TD(to_do)  sep opts core_td (to_do:stg_td)
 573
 574     sep (opt1:opts) core_td stg_td
 575       = case (_UNPK_ opt1) of -- the non-"just match a string" options are at the end...
 576           ',' : _       -> sep opts core_td stg_td -- it is for the parser
 577
 578           "-fsimplify"  -> -- gather up SimplifierSwitches specially...
 579                            simpl_sep opts defaultSimplSwitches core_td stg_td
 580
 581           "-ffloat-inwards"  -> CORE_TD(CoreDoFloatInwards)
 582           "-ffloat-outwards"      -> CORE_TD(CoreDoFloatOutwards False)
 583           "-ffloat-outwards-full" -> CORE_TD(CoreDoFloatOutwards True)
 584           "-fliberate-case"  -> CORE_TD(CoreLiberateCase)
 585           "-fcse"            -> CORE_TD(CoreCSE)
 586           "-fglom-binds"     -> CORE_TD(CoreDoGlomBinds)
 587           "-fprint-core"     -> CORE_TD(CoreDoPrintCore)
 588           "-fstatic-args"    -> CORE_TD(CoreDoStaticArgs)
 589           "-fstrictness"     -> CORE_TD(CoreDoStrictness)
 590           "-fworker-wrapper" -> CORE_TD(CoreDoWorkerWrapper)
 591           "-fspecialise"     -> CORE_TD(CoreDoSpecialising)
 592           "-fusagesp"        -> CORE_TD(CoreDoUSPInf)
 593           "-fcpr-analyse"    -> CORE_TD(CoreDoCPResult)
 594
 595           "-fstg-static-args" -> STG_TD(StgDoStaticArgs)
 596           "-dstg-stats"       -> STG_TD(D_stg_stats)
 597           "-flambda-lift"     -> STG_TD(StgDoLambdaLift)
 598           "-fmassage-stg-for-profiling" -> STG_TD(StgDoMassageForProfiling)
 599
 600           _ -> -- NB: the driver is really supposed to handle bad options
 601                sep opts core_td stg_td
 602
 603     ----------------
 604
 605     simpl_sep :: [FAST_STRING]            -- cmd-line opts (input)
 606               -> [SimplifierSwitch]       -- simplifier-switch accumulator
 607               -> [CoreToDo] -> [StgToDo]  -- to_do accumulators
 608               -> ([CoreToDo], [StgToDo])  -- result
 609
 610         -- "simpl_sep" tailcalls "sep" once it's seen one set
 611         -- of SimplifierSwitches for a CoreDoSimplify.
 612
 613 #ifdef DEBUG
 614     simpl_sep input@[] simpl_sw core_td stg_td
 615       = panic "simpl_sep []"
 616 #endif
 617
 618         -- The SimplifierSwitches should be delimited by "[" and "]".
 619
 620     simpl_sep (opt1:opts) simpl_sw core_td stg_td
 621       = case (_UNPK_ opt1) of
 622           "[" -> simpl_sep opts simpl_sw core_td stg_td
 623           "]" -> let
 624                     this_simpl = CoreDoSimplify (isAmongSimpl simpl_sw)
 625                  in
 626                  sep opts (this_simpl : core_td) stg_td
 627
 628           opt -> case matchSimplSw opt of
 629                         Just sw -> simpl_sep opts (sw:simpl_sw) core_td stg_td
 630                         Nothing -> simpl_sep opts simpl_sw      core_td stg_td
 631
 632 matchSimplSw opt
 633   = firstJust   [ matchSwInt  opt "-fmax-simplifier-iterations"         MaxSimplifierIterations
 634                 , matchSwInt  opt "-finline-phase"                      SimplInlinePhase
 635                 , matchSwBool opt "-fno-rules"                          DontApplyRules
 636                 , matchSwBool opt "-fno-case-of-case"                   NoCaseOfCase
 637                 , matchSwBool opt "-flet-to-case"                       SimplLetToCase
 638                 ]
 639
 640 matchSwBool :: String -> String -> a -> Maybe a
 641 matchSwBool opt str sw | opt == str = Just sw
 642                        | otherwise  = Nothing
 643
 644 matchSwInt :: String -> String -> (Int -> a) -> Maybe a
 645 matchSwInt opt str sw = case startsWith str opt of
 646                             Just opt_left -> Just (sw (read opt_left))
 647                             Nothing       -> Nothing
 648 \end{code}
 649
 650 %************************************************************************
 651 %*                                                                      *
 652 \subsection{Switch ordering}
 653 %*                                                                      *
 654 %************************************************************************
 655
 656 In spite of the @Produce*@ constructor, these things behave just like
 657 enumeration types.
 658
 659 \begin{code}
 660 instance Eq SimplifierSwitch where
 661     a == b = tagOf_SimplSwitch a _EQ_ tagOf_SimplSwitch b
 662
 663 instance Ord SimplifierSwitch where
 664     a <  b  = tagOf_SimplSwitch a _LT_ tagOf_SimplSwitch b
 665     a <= b  = tagOf_SimplSwitch a _LE_ tagOf_SimplSwitch b
 666
 667
 668 tagOf_SimplSwitch (SimplInlinePhase _)          = ILIT(1)
 669 tagOf_SimplSwitch (MaxSimplifierIterations _)   = ILIT(2)
 670 tagOf_SimplSwitch DontApplyRules                = ILIT(3)
 671 tagOf_SimplSwitch SimplLetToCase                = ILIT(4)
 672 tagOf_SimplSwitch NoCaseOfCase                  = ILIT(5)
 673
 674 -- If you add anything here, be sure to change lAST_SIMPL_SWITCH_TAG, too!
 675
 676 lAST_SIMPL_SWITCH_TAG = 5
 677 \end{code}
 678
 679 %************************************************************************
 680 %*                                                                      *
 681 \subsection{Switch lookup}
 682 %*                                                                      *
 683 %************************************************************************
 684
 685 \begin{code}
 686 isAmongSimpl :: [SimplifierSwitch] -> SimplifierSwitch -> SwitchResult
 687
 688 isAmongSimpl on_switches                -- Switches mentioned later occur *earlier*
 689                                         -- in the list; defaults right at the end.
 690   = let
 691         tidied_on_switches = foldl rm_dups [] on_switches
 692                 -- The fold*l* ensures that we keep the latest switches;
 693                 -- ie the ones that occur earliest in the list.
 694
 695         sw_tbl :: Array Int SwitchResult
 696         sw_tbl = (array (0, lAST_SIMPL_SWITCH_TAG) -- bounds...
 697                         all_undefined)
 698                  // defined_elems
 699
 700         all_undefined = [ (i, SwBool False) | i <- [0 .. lAST_SIMPL_SWITCH_TAG ] ]
 701
 702         defined_elems = map mk_assoc_elem tidied_on_switches
 703     in
 704     -- (avoid some unboxing, bounds checking, and other horrible things:)
 705 #if __GLASGOW_HASKELL__ < 405
 706     case sw_tbl of { Array bounds_who_needs_'em stuff ->
 707 #else
 708     case sw_tbl of { Array _ _ stuff ->
 709 #endif
 710     \ switch ->
 711         case (indexArray# stuff (tagOf_SimplSwitch switch)) of
 712 #if __GLASGOW_HASKELL__ < 400
 713           Lift v -> v
 714 #elif __GLASGOW_HASKELL__ < 403
 715           (# _, v #) -> v
 716 #else
 717           (# v #) -> v
 718 #endif
 719     }
 720   where
 721     mk_assoc_elem k@(MaxSimplifierIterations lvl) = (IBOX(tagOf_SimplSwitch k), SwInt lvl)
 722     mk_assoc_elem k@(SimplInlinePhase n)          = (IBOX(tagOf_SimplSwitch k), SwInt n)
 723     mk_assoc_elem k                               = (IBOX(tagOf_SimplSwitch k), SwBool True) -- I'm here, Mom!
 724
 725     -- cannot have duplicates if we are going to use the array thing
 726     rm_dups switches_so_far switch
 727       = if switch `is_elem` switches_so_far
 728         then switches_so_far
 729         else switch : switches_so_far
 730       where
 731         sw `is_elem` []     = False
 732         sw `is_elem` (s:ss) = (tagOf_SimplSwitch sw) _EQ_ (tagOf_SimplSwitch s)
 733                             || sw `is_elem` ss
 734 \end{code}
 735
 736 Default settings for simplifier switches
 737
 738 \begin{code}
 739 defaultSimplSwitches = [MaxSimplifierIterations 1]
 740 \end{code}
 741
 742 %************************************************************************
 743 %*                                                                      *
 744 \subsection{Misc functions for command-line options}
 745 %*                                                                      *
 746 %************************************************************************
 747
 748
 749 \begin{code}
 750 switchIsOn :: (switch -> SwitchResult) -> switch -> Bool
 751
 752 switchIsOn lookup_fn switch
 753   = case (lookup_fn switch) of
 754       SwBool False -> False
 755       _            -> True
 756
 757 intSwitchSet :: (switch -> SwitchResult)
 758              -> (Int -> switch)
 759              -> Maybe Int
 760
 761 intSwitchSet lookup_fn switch
 762   = case (lookup_fn (switch (panic "intSwitchSet"))) of
 763       SwInt int -> Just int
 764       _         -> Nothing
 765 \end{code}
 766
 767 \begin{code}
 768 startsWith :: String -> String -> Maybe String
 769 -- startsWith pfx (pfx++rest) = Just rest
 770
 771 startsWith []     str = Just str
 772 startsWith (c:cs) (s:ss)
 773   = if c /= s then Nothing else startsWith cs ss
 774 startsWith  _     []  = Nothing
 775
 776 endsWith  :: String -> String -> Maybe String
 777 endsWith cs ss
 778   = case (startsWith (reverse cs) (reverse ss)) of
 779       Nothing -> Nothing
 780       Just rs -> Just (reverse rs)
 781 \end{code}