ghc/compiler/main/DriverState.hs

   1 -----------------------------------------------------------------------------
   2 -- $Id: DriverState.hs,v 1.48 2001/07/09 17:44:08 sof Exp $
   3 --
   4 -- Settings for the driver
   5 --
   6 -- (c) The University of Glasgow 2000
   7 --
   8 -----------------------------------------------------------------------------
   9
  10 module DriverState where
  11
  12 #include "../includes/config.h"
  13 #include "HsVersions.h"
  14
  15 import Packages         ( PackageConfig(..) )
  16 import CmdLineOpts
  17 import DriverPhases
  18 import DriverUtil
  19 import Util
  20 import Config
  21 import Exception
  22 import IOExts
  23 import Panic
  24
  25 import List
  26 import Char
  27 import Monad
  28 import Directory ( doesDirectoryExist )
  29
  30 -----------------------------------------------------------------------------
  31 -- non-configured things
  32
  33 cHaskell1Version = "5" -- i.e., Haskell 98
  34
  35 -----------------------------------------------------------------------------
  36 -- GHC modes of operation
  37
  38 data GhcMode
  39   = DoMkDependHS                        -- ghc -M
  40   | DoMkDLL                             -- ghc --mk-dll
  41   | StopBefore Phase                    -- ghc -E | -C | -S | -c
  42   | DoMake                              -- ghc --make
  43   | DoInteractive                       -- ghc --interactive
  44   | DoLink                              -- [ the default ]
  45   deriving (Eq)
  46
  47 GLOBAL_VAR(v_GhcMode, error "mode not set", GhcMode)
  48
  49 -----------------------------------------------------------------------------
  50 -- Global compilation flags
  51
  52 -- Cpp-related flags
  53 v_Hs_source_cpp_opts = global
  54         [ "-D__HASKELL1__="++cHaskell1Version
  55         , "-D__GLASGOW_HASKELL__="++cProjectVersionInt
  56         , "-D__HASKELL98__"
  57         , "-D__CONCURRENT_HASKELL__"
  58         ]
  59 {-# NOINLINE v_Hs_source_cpp_opts #-}
  60
  61 -- Keep output from intermediate phases
  62 GLOBAL_VAR(v_Keep_hi_diffs,             False,          Bool)
  63 GLOBAL_VAR(v_Keep_hc_files,             False,          Bool)
  64 GLOBAL_VAR(v_Keep_s_files,              False,          Bool)
  65 GLOBAL_VAR(v_Keep_raw_s_files,          False,          Bool)
  66 GLOBAL_VAR(v_Keep_tmp_files,            False,          Bool)
  67
  68 -- Misc
  69 GLOBAL_VAR(v_Scale_sizes_by,            1.0,            Double)
  70 GLOBAL_VAR(v_Static,                    True,           Bool)
  71 GLOBAL_VAR(v_NoHsMain,                  False,          Bool)
  72 GLOBAL_VAR(v_Recomp,                    True,           Bool)
  73 GLOBAL_VAR(v_Collect_ghc_timing,        False,          Bool)
  74 GLOBAL_VAR(v_Do_asm_mangling,           True,           Bool)
  75 GLOBAL_VAR(v_Excess_precision,          False,          Bool)
  76
  77 -----------------------------------------------------------------------------
  78 -- Splitting object files (for libraries)
  79
  80 GLOBAL_VAR(v_Split_object_files,        False,          Bool)
  81 GLOBAL_VAR(v_Split_info,                ("",0),         (String,Int))
  82         -- The split prefix and number of files
  83
  84
  85 can_split :: Bool
  86 can_split =  prefixMatch "i386"    cTARGETPLATFORM
  87           || prefixMatch "alpha"   cTARGETPLATFORM
  88           || prefixMatch "hppa"    cTARGETPLATFORM
  89           || prefixMatch "m68k"    cTARGETPLATFORM
  90           || prefixMatch "mips"    cTARGETPLATFORM
  91           || prefixMatch "powerpc" cTARGETPLATFORM
  92           || prefixMatch "rs6000"  cTARGETPLATFORM
  93           || prefixMatch "sparc"   cTARGETPLATFORM
  94
  95 -----------------------------------------------------------------------------
  96 -- Compiler output options
  97
  98 defaultHscLang
  99   | cGhcWithNativeCodeGen == "YES" &&
 100         (prefixMatch "i386" cTARGETPLATFORM ||
 101          prefixMatch "sparc" cTARGETPLATFORM)   =  HscAsm
 102   | otherwise                                   =  HscC
 103
 104 GLOBAL_VAR(v_Output_dir,  Nothing, Maybe String)
 105 GLOBAL_VAR(v_Output_file, Nothing, Maybe String)
 106 GLOBAL_VAR(v_Output_hi,   Nothing, Maybe String)
 107
 108 GLOBAL_VAR(v_Object_suf,  Nothing, Maybe String)
 109 GLOBAL_VAR(v_HC_suf,      Nothing, Maybe String)
 110 GLOBAL_VAR(v_Hi_dir,      Nothing, Maybe String)
 111 GLOBAL_VAR(v_Hi_suf,      "hi",    String)
 112
 113 GLOBAL_VAR(v_Ld_inputs, [],      [String])
 114
 115 odir_ify :: String -> IO String
 116 odir_ify f = do
 117   odir_opt <- readIORef v_Output_dir
 118   case odir_opt of
 119         Nothing -> return f
 120         Just d  -> return (newdir d f)
 121
 122 osuf_ify :: String -> IO String
 123 osuf_ify f = do
 124   osuf_opt <- readIORef v_Object_suf
 125   case osuf_opt of
 126         Nothing -> return f
 127         Just s  -> return (newsuf s f)
 128
 129 -----------------------------------------------------------------------------
 130 -- Compiler optimisation options
 131
 132 GLOBAL_VAR(v_OptLevel, 0, Int)
 133
 134 setOptLevel :: String -> IO ()
 135 setOptLevel ""              = do { writeIORef v_OptLevel 1 }
 136 setOptLevel "not"           = writeIORef v_OptLevel 0
 137 setOptLevel [c] | isDigit c = do
 138    let level = ord c - ord '0'
 139    writeIORef v_OptLevel level
 140 setOptLevel s = unknownFlagErr ("-O"++s)
 141
 142 GLOBAL_VAR(v_minus_o2_for_C,            False, Bool)
 143 GLOBAL_VAR(v_MaxSimplifierIterations,   4,     Int)
 144 GLOBAL_VAR(v_StgStats,                  False, Bool)
 145 GLOBAL_VAR(v_UsageSPInf,                False, Bool)  -- Off by default
 146 GLOBAL_VAR(v_Strictness,                True,  Bool)
 147 GLOBAL_VAR(v_CPR,                       True,  Bool)
 148 GLOBAL_VAR(v_CSE,                       True,  Bool)
 149
 150 -- these are the static flags you get without -O.
 151 hsc_minusNoO_flags =
 152        [
 153         "-fignore-interface-pragmas",
 154         "-fomit-interface-pragmas",
 155         "-fdo-lambda-eta-expansion",    -- This one is important for a tiresome reason:
 156                                         -- we want to make sure that the bindings for data
 157                                         -- constructors are eta-expanded.  This is probably
 158                                         -- a good thing anyway, but it seems fragile.
 159         "-flet-no-escape"
 160         ]
 161
 162 -- these are the static flags you get when -O is on.
 163 hsc_minusO_flags =
 164   [
 165         "-fignore-asserts",
 166         "-ffoldr-build-on",
 167         "-fdo-eta-reduction",
 168         "-fdo-lambda-eta-expansion",
 169         "-fcase-merge",
 170         "-flet-to-case",
 171         "-flet-no-escape"
 172    ]
 173
 174 hsc_minusO2_flags = hsc_minusO_flags    -- for now
 175
 176 getStaticOptimisationFlags 0 = hsc_minusNoO_flags
 177 getStaticOptimisationFlags 1 = hsc_minusO_flags
 178 getStaticOptimisationFlags n = hsc_minusO2_flags
 179
 180 buildCoreToDo :: IO [CoreToDo]
 181 buildCoreToDo = do
 182    opt_level  <- readIORef v_OptLevel
 183    max_iter   <- readIORef v_MaxSimplifierIterations
 184    usageSP    <- readIORef v_UsageSPInf
 185    strictness <- readIORef v_Strictness
 186    cpr        <- readIORef v_CPR
 187    cse        <- readIORef v_CSE
 188
 189    if opt_level == 0 then return
 190       [
 191         CoreDoSimplify (isAmongSimpl [
 192             MaxSimplifierIterations max_iter
 193         ])
 194       ]
 195
 196     else {- opt_level >= 1 -} return [
 197
 198         -- initial simplify: mk specialiser happy: minimum effort please
 199         CoreDoSimplify (isAmongSimpl [
 200             SimplInlinePhase 0,
 201                         -- Don't inline anything till full laziness has bitten
 202                         -- In particular, inlining wrappers inhibits floating
 203                         -- e.g. ...(case f x of ...)...
 204                         --  ==> ...(case (case x of I# x# -> fw x#) of ...)...
 205                         --  ==> ...(case x of I# x# -> case fw x# of ...)...
 206                         -- and now the redex (f x) isn't floatable any more
 207             DontApplyRules,
 208                         -- Similarly, don't apply any rules until after full
 209                         -- laziness.  Notably, list fusion can prevent floating.
 210             NoCaseOfCase,
 211                         -- Don't do case-of-case transformations.
 212                         -- This makes full laziness work better
 213             MaxSimplifierIterations max_iter
 214         ]),
 215
 216         -- Specialisation is best done before full laziness
 217         -- so that overloaded functions have all their dictionary lambdas manifest
 218         CoreDoSpecialising,
 219
 220         CoreDoFloatOutwards False{-not full-},
 221         CoreDoFloatInwards,
 222
 223         CoreDoSimplify (isAmongSimpl [
 224            SimplInlinePhase 1,
 225                 -- Want to run with inline phase 1 after the specialiser to give
 226                 -- maximum chance for fusion to work before we inline build/augment
 227                 -- in phase 2.  This made a difference in 'ansi' where an
 228                 -- overloaded function wasn't inlined till too late.
 229            MaxSimplifierIterations max_iter
 230         ]),
 231
 232         -- infer usage information here in case we need it later.
 233         -- (add more of these where you need them --KSW 1999-04)
 234         if usageSP then CoreDoUSPInf else CoreDoNothing,
 235
 236         CoreDoSimplify (isAmongSimpl [
 237                 -- Need inline-phase2 here so that build/augment get
 238                 -- inlined.  I found that spectral/hartel/genfft lost some useful
 239                 -- strictness in the function sumcode' if augment is not inlined
 240                 -- before strictness analysis runs
 241            SimplInlinePhase 2,
 242            MaxSimplifierIterations max_iter
 243         ]),
 244
 245         CoreDoSimplify (isAmongSimpl [
 246            MaxSimplifierIterations 2
 247                 -- No -finline-phase: allow all Ids to be inlined now
 248                 -- This gets foldr inlined before strictness analysis
 249         ]),
 250
 251         if strictness then CoreDoStrictness else CoreDoNothing,
 252         if cpr        then CoreDoCPResult   else CoreDoNothing,
 253         CoreDoWorkerWrapper,
 254         CoreDoGlomBinds,
 255
 256         CoreDoSimplify (isAmongSimpl [
 257            MaxSimplifierIterations max_iter
 258                 -- No -finline-phase: allow all Ids to be inlined now
 259         ]),
 260
 261         CoreDoFloatOutwards False{-not full-},
 262                 -- nofib/spectral/hartel/wang doubles in speed if you
 263                 -- do full laziness late in the day.  It only happens
 264                 -- after fusion and other stuff, so the early pass doesn't
 265                 -- catch it.  For the record, the redex is
 266                 --        f_el22 (f_el21 r_midblock)
 267
 268
 269 -- Leave out lambda lifting for now
 270 --        "-fsimplify", -- Tidy up results of full laziness
 271 --          "[",
 272 --                "-fmax-simplifier-iterations2",
 273 --          "]",
 274 --        "-ffloat-outwards-full",
 275
 276         -- We want CSE to follow the final full-laziness pass, because it may
 277         -- succeed in commoning up things floated out by full laziness.
 278         -- CSE used to rely on the no-shadowing invariant, but it doesn't any more
 279
 280         if cse then CoreCSE else CoreDoNothing,
 281
 282         CoreDoFloatInwards,
 283
 284 -- Case-liberation for -O2.  This should be after
 285 -- strictness analysis and the simplification which follows it.
 286
 287         if opt_level >= 2 then
 288            CoreLiberateCase
 289         else
 290            CoreDoNothing,
 291         if opt_level >= 2 then
 292            CoreDoSpecConstr
 293         else
 294            CoreDoNothing,
 295
 296         -- Final clean-up simplification:
 297         CoreDoSimplify (isAmongSimpl [
 298           MaxSimplifierIterations max_iter
 299                 -- No -finline-phase: allow all Ids to be inlined now
 300         ])
 301      ]
 302
 303 buildStgToDo :: IO [ StgToDo ]
 304 buildStgToDo = do
 305   stg_stats <- readIORef v_StgStats
 306   let flags1 | stg_stats = [ D_stg_stats ]
 307              | otherwise = [ ]
 308
 309         -- STG passes
 310   ways_ <- readIORef v_Ways
 311   let flags2 | WayProf `elem` ways_ = StgDoMassageForProfiling : flags1
 312              | otherwise            = flags1
 313
 314   return flags2
 315
 316 -----------------------------------------------------------------------------
 317 -- Paths & Libraries
 318
 319 split_marker = ':'   -- not configurable (ToDo)
 320
 321 v_Import_paths, v_Include_paths, v_Library_paths :: IORef [String]
 322 GLOBAL_VAR(v_Import_paths,  ["."], [String])
 323 GLOBAL_VAR(v_Include_paths, ["."], [String])
 324 GLOBAL_VAR(v_Library_paths, [],  [String])
 325
 326 GLOBAL_VAR(v_Cmdline_libraries,   [], [String])
 327
 328 addToDirList :: IORef [String] -> String -> IO ()
 329 addToDirList ref path
 330   = do paths           <- readIORef ref
 331        shiny_new_ones  <- splitUp path
 332        writeIORef ref (paths ++ shiny_new_ones)
 333
 334   where
 335     splitUp ::String -> IO [String]
 336 #ifdef mingw32_TARGET_OS
 337      -- 'hybrid' support for DOS-style paths in directory lists.
 338      --
 339      -- That is, if "foo:bar:baz" is used, this interpreted as
 340      -- consisting of three entries, 'foo', 'bar', 'baz'.
 341      -- However, with "c:/foo:c:\\foo;x:/bar", this is interpreted
 342      -- as four elts, "c:/foo", "c:\\foo", "x", and "/bar" --
 343      -- *provided* c:/foo exists and x:/bar doesn't.
 344      --
 345      -- Notice that no attempt is made to fully replace the 'standard'
 346      -- split marker ':' with the Windows / DOS one, ';'. The reason being
 347      -- that this will cause too much breakage for users & ':' will
 348      -- work fine even with DOS paths, if you're not insisting on being silly.
 349      -- So, use either.
 350     splitUp []         = return []
 351     splitUp (x:':':div:xs)
 352       | div `elem` dir_markers = do
 353           let (p,rs) = findNextPath xs
 354           ps  <- splitUp rs
 355            {-
 356              Consult the file system to check the interpretation
 357              of (x:':':div:p) -- this is arguably excessive, we
 358              could skip this test & just say that it is a valid
 359              dir path.
 360            -}
 361           flg <- doesDirectoryExist (x:':':div:p)
 362           if flg then
 363              return ((x:':':div:p):ps)
 364            else
 365              return ([x]:(div:p):ps)
 366     splitUp xs = do
 367       let (p,rs) = findNextPath xs
 368       ps <- splitUp rs
 369       return (cons p ps)
 370
 371     cons "" xs = xs
 372     cons x  xs = x:xs
 373
 374     -- will be called either when we've consumed nought or the "<Drive>:/" part of
 375     -- a DOS path, so splitting is just a Q of finding the next split marker.
 376     findNextPath xs =
 377         case break (`elem` split_markers) xs of
 378            (p, d:ds) -> (p, ds)
 379            (p, xs)   -> (p, xs)
 380
 381     split_markers :: [Char]
 382     split_markers = [':', ';']
 383
 384     dir_markers :: [Char]
 385     dir_markers = ['/', '\\']
 386
 387 #else
 388     splitUp xs = return (split split_marker xs)
 389 #endif
 390
 391 GLOBAL_VAR(v_HCHeader, "", String)
 392
 393 -----------------------------------------------------------------------------
 394 -- Packages
 395
 396 -- package list is maintained in dependency order
 397 GLOBAL_VAR(v_Packages, ("std":"rts":"gmp":[]), [String])
 398
 399 addPackage :: String -> IO ()
 400 addPackage package
 401   = do pkg_details <- readIORef v_Package_details
 402        case lookupPkg package pkg_details of
 403           Nothing -> throwDyn (CmdLineError ("unknown package name: " ++ package))
 404           Just details -> do
 405             ps <- readIORef v_Packages
 406             unless (package `elem` ps) $ do
 407                 mapM_ addPackage (package_deps details)
 408                 ps <- readIORef v_Packages
 409                 writeIORef v_Packages (package:ps)
 410
 411 getPackageImportPath   :: IO [String]
 412 getPackageImportPath = do
 413   ps <- getPackageInfo
 414   return (nub (filter (not.null) (concatMap import_dirs ps)))
 415
 416 getPackageIncludePath   :: IO [String]
 417 getPackageIncludePath = do
 418   ps <- getPackageInfo
 419   return (nub (filter (not.null) (concatMap include_dirs ps)))
 420
 421         -- includes are in reverse dependency order (i.e. rts first)
 422 getPackageCIncludes   :: IO [String]
 423 getPackageCIncludes = do
 424   ps <- getPackageInfo
 425   return (reverse (nub (filter (not.null) (concatMap c_includes ps))))
 426
 427 getPackageLibraryPath  :: IO [String]
 428 getPackageLibraryPath = do
 429   ps <- getPackageInfo
 430   return (nub (filter (not.null) (concatMap library_dirs ps)))
 431
 432 getPackageLibraries    :: IO [String]
 433 getPackageLibraries = do
 434   ps <- getPackageInfo
 435   tag <- readIORef v_Build_tag
 436   let suffix = if null tag then "" else '_':tag
 437   return (concat (
 438         map (\p -> map (++suffix) (hACK (hs_libraries p)) ++ extra_libraries p) ps
 439      ))
 440   where
 441      -- This is a totally horrible (temporary) hack, for Win32.  Problem is
 442      -- that package.conf for Win32 says that the main prelude lib is
 443      -- split into HSstd1 and HSstd2, which is needed due to limitations in
 444      -- the PEi386 file format, to make GHCi work.  However, we still only
 445      -- have HSstd.a for static linking, not HSstd1.a and HSstd2.a.
 446      -- getPackageLibraries is called to find the .a's to add to the static
 447      -- link line.  On Win32, this hACK detects HSstd1 and HSstd2 and
 448      -- replaces them with HSstd, so static linking still works.
 449      -- Libraries needed for dynamic (GHCi) linking are discovered via
 450      -- different route (in InteractiveUI.linkPackage).
 451      -- See driver/PackageSrc.hs for the HSstd1/HSstd2 split definition.
 452      -- THIS IS A STRICTLY TEMPORARY HACK (famous last words ...)
 453      hACK libs
 454 #      ifndef mingw32_TARGET_OS
 455        = libs
 456 #      else
 457        = if   "HSstd1" `elem` libs && "HSstd2" `elem` libs
 458          then "HSstd" : filter ((/= "HSstd").(take 5)) libs
 459          else libs
 460 #      endif
 461
 462 getPackageExtraGhcOpts :: IO [String]
 463 getPackageExtraGhcOpts = do
 464   ps <- getPackageInfo
 465   return (concatMap extra_ghc_opts ps)
 466
 467 getPackageExtraCcOpts  :: IO [String]
 468 getPackageExtraCcOpts = do
 469   ps <- getPackageInfo
 470   return (concatMap extra_cc_opts ps)
 471
 472 getPackageExtraLdOpts  :: IO [String]
 473 getPackageExtraLdOpts = do
 474   ps <- getPackageInfo
 475   return (concatMap extra_ld_opts ps)
 476
 477 getPackageInfo :: IO [PackageConfig]
 478 getPackageInfo = do
 479   ps <- readIORef v_Packages
 480   getPackageDetails ps
 481
 482 getPackageDetails :: [String] -> IO [PackageConfig]
 483 getPackageDetails ps = do
 484   pkg_details <- readIORef v_Package_details
 485   return [ pkg | p <- ps, Just pkg <- [ lookupPkg p pkg_details ] ]
 486
 487 GLOBAL_VAR(v_Package_details, (error "package_details"), [PackageConfig])
 488
 489 lookupPkg :: String -> [PackageConfig] -> Maybe PackageConfig
 490 lookupPkg nm ps
 491    = case [p | p <- ps, name p == nm] of
 492         []    -> Nothing
 493         (p:_) -> Just p
 494
 495 -----------------------------------------------------------------------------
 496 -- Ways
 497
 498 -- The central concept of a "way" is that all objects in a given
 499 -- program must be compiled in the same "way".  Certain options change
 500 -- parameters of the virtual machine, eg. profiling adds an extra word
 501 -- to the object header, so profiling objects cannot be linked with
 502 -- non-profiling objects.
 503
 504 -- After parsing the command-line options, we determine which "way" we
 505 -- are building - this might be a combination way, eg. profiling+ticky-ticky.
 506
 507 -- We then find the "build-tag" associated with this way, and this
 508 -- becomes the suffix used to find .hi files and libraries used in
 509 -- this compilation.
 510
 511 GLOBAL_VAR(v_Build_tag, "", String)
 512
 513 data WayName
 514   = WayProf
 515   | WayUnreg
 516   | WayTicky
 517   | WayPar
 518   | WayGran
 519   | WaySMP
 520   | WayDebug
 521   | WayUser_a
 522   | WayUser_b
 523   | WayUser_c
 524   | WayUser_d
 525   | WayUser_e
 526   | WayUser_f
 527   | WayUser_g
 528   | WayUser_h
 529   | WayUser_i
 530   | WayUser_j
 531   | WayUser_k
 532   | WayUser_l
 533   | WayUser_m
 534   | WayUser_n
 535   | WayUser_o
 536   | WayUser_A
 537   | WayUser_B
 538   deriving (Eq,Ord)
 539
 540 GLOBAL_VAR(v_Ways, [] ,[WayName])
 541
 542 allowed_combination way = way `elem` combs
 543   where  -- the sub-lists must be ordered according to WayName,
 544          -- because findBuildTag sorts them
 545     combs                = [ [WayProf,WayUnreg], [WayProf,WaySMP] ]
 546
 547 findBuildTag :: IO [String]  -- new options
 548 findBuildTag = do
 549   way_names <- readIORef v_Ways
 550   case sort way_names of
 551      []  -> do  -- writeIORef v_Build_tag ""
 552                 return []
 553
 554      [w] -> do let details = lkupWay w
 555                writeIORef v_Build_tag (wayTag details)
 556                return (wayOpts details)
 557
 558      ws  -> if not (allowed_combination ws)
 559                 then throwDyn (CmdLineError $
 560                                 "combination not supported: "  ++
 561                                 foldr1 (\a b -> a ++ '/':b)
 562                                 (map (wayName . lkupWay) ws))
 563                 else let stuff = map lkupWay ws
 564                          tag   = concat (map wayTag stuff)
 565                          flags = map wayOpts stuff
 566                      in do
 567                      writeIORef v_Build_tag tag
 568                      return (concat flags)
 569
 570 lkupWay w =
 571    case lookup w way_details of
 572         Nothing -> error "findBuildTag"
 573         Just details -> details
 574
 575 data Way = Way {
 576   wayTag   :: String,
 577   wayName  :: String,
 578   wayOpts  :: [String]
 579   }
 580
 581 way_details :: [ (WayName, Way) ]
 582 way_details =
 583   [ (WayProf, Way  "p" "Profiling"
 584         [ "-fscc-profiling"
 585         , "-DPROFILING"
 586         , "-optc-DPROFILING"
 587         , "-fvia-C" ]),
 588
 589     (WayTicky, Way  "t" "Ticky-ticky Profiling"
 590         [ "-fticky-ticky"
 591         , "-DTICKY_TICKY"
 592         , "-optc-DTICKY_TICKY"
 593         , "-fvia-C" ]),
 594
 595     (WayUnreg, Way  "u" "Unregisterised"
 596         unregFlags ),
 597
 598     -- optl's below to tell linker where to find the PVM library -- HWL
 599     (WayPar, Way  "mp" "Parallel"
 600         [ "-fparallel"
 601         , "-D__PARALLEL_HASKELL__"
 602         , "-optc-DPAR"
 603         , "-package concurrent"
 604         , "-optc-w"
 605         , "-optl-L${PVM_ROOT}/lib/${PVM_ARCH}"
 606         , "-optl-lpvm3"
 607         , "-optl-lgpvm3"
 608         , "-fvia-C" ]),
 609
 610     -- at the moment we only change the RTS and could share compiler and libs!
 611     (WayPar, Way  "mt" "Parallel ticky profiling"
 612         [ "-fparallel"
 613         , "-D__PARALLEL_HASKELL__"
 614         , "-optc-DPAR"
 615         , "-optc-DPAR_TICKY"
 616         , "-package concurrent"
 617         , "-optc-w"
 618         , "-optl-L${PVM_ROOT}/lib/${PVM_ARCH}"
 619         , "-optl-lpvm3"
 620         , "-optl-lgpvm3"
 621         , "-fvia-C" ]),
 622
 623     (WayPar, Way  "md" "Distributed"
 624         [ "-fparallel"
 625         , "-D__PARALLEL_HASKELL__"
 626         , "-D__DISTRIBUTED_HASKELL__"
 627         , "-optc-DPAR"
 628         , "-optc-DDIST"
 629         , "-package concurrent"
 630         , "-optc-w"
 631         , "-optl-L${PVM_ROOT}/lib/${PVM_ARCH}"
 632         , "-optl-lpvm3"
 633         , "-optl-lgpvm3"
 634         , "-fvia-C" ]),
 635
 636     (WayGran, Way  "mg" "GranSim"
 637         [ "-fgransim"
 638         , "-D__GRANSIM__"
 639         , "-optc-DGRAN"
 640         , "-package concurrent"
 641         , "-fvia-C" ]),
 642
 643     (WaySMP, Way  "s" "SMP"
 644         [ "-fsmp"
 645         , "-optc-pthread"
 646         , "-optl-pthread"
 647         , "-optc-DSMP"
 648         , "-fvia-C" ]),
 649
 650     (WayUser_a,  Way  "a"  "User way 'a'"  ["$WAY_a_REAL_OPTS"]),
 651     (WayUser_b,  Way  "b"  "User way 'b'"  ["$WAY_b_REAL_OPTS"]),
 652     (WayUser_c,  Way  "c"  "User way 'c'"  ["$WAY_c_REAL_OPTS"]),
 653     (WayUser_d,  Way  "d"  "User way 'd'"  ["$WAY_d_REAL_OPTS"]),
 654     (WayUser_e,  Way  "e"  "User way 'e'"  ["$WAY_e_REAL_OPTS"]),
 655     (WayUser_f,  Way  "f"  "User way 'f'"  ["$WAY_f_REAL_OPTS"]),
 656     (WayUser_g,  Way  "g"  "User way 'g'"  ["$WAY_g_REAL_OPTS"]),
 657     (WayUser_h,  Way  "h"  "User way 'h'"  ["$WAY_h_REAL_OPTS"]),
 658     (WayUser_i,  Way  "i"  "User way 'i'"  ["$WAY_i_REAL_OPTS"]),
 659     (WayUser_j,  Way  "j"  "User way 'j'"  ["$WAY_j_REAL_OPTS"]),
 660     (WayUser_k,  Way  "k"  "User way 'k'"  ["$WAY_k_REAL_OPTS"]),
 661     (WayUser_l,  Way  "l"  "User way 'l'"  ["$WAY_l_REAL_OPTS"]),
 662     (WayUser_m,  Way  "m"  "User way 'm'"  ["$WAY_m_REAL_OPTS"]),
 663     (WayUser_n,  Way  "n"  "User way 'n'"  ["$WAY_n_REAL_OPTS"]),
 664     (WayUser_o,  Way  "o"  "User way 'o'"  ["$WAY_o_REAL_OPTS"]),
 665     (WayUser_A,  Way  "A"  "User way 'A'"  ["$WAY_A_REAL_OPTS"]),
 666     (WayUser_B,  Way  "B"  "User way 'B'"  ["$WAY_B_REAL_OPTS"])
 667   ]
 668
 669 unregFlags =
 670    [ "-optc-DNO_REGS"
 671    , "-optc-DUSE_MINIINTERPRETER"
 672    , "-fno-asm-mangling"
 673    , "-funregisterised"
 674    , "-fvia-C" ]
 675
 676 -----------------------------------------------------------------------------
 677 -- Programs for particular phases
 678
 679 GLOBAL_VAR(v_Opt_dep,    [], [String])
 680 GLOBAL_VAR(v_Anti_opt_C, [], [String])
 681 GLOBAL_VAR(v_Opt_C,      [], [String])
 682 GLOBAL_VAR(v_Opt_l,      [], [String])
 683 GLOBAL_VAR(v_Opt_dll,    [], [String])
 684
 685 getStaticOpts :: IORef [String] -> IO [String]
 686 getStaticOpts ref = readIORef ref >>= return . reverse