ghc/compiler/main/DriverState.hs

   1 -----------------------------------------------------------------------------
   2 -- $Id: DriverState.hs,v 1.52 2001/08/02 16:30:41 simonmar 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 3
 247                 -- No -finline-phase: allow all Ids to be inlined now
 248                 -- This gets foldr inlined before strictness analysis
 249                 --
 250                 -- At least 3 iterations because otherwise we land up with
 251                 -- huge dead expressions because of an infelicity in the
 252                 -- simpifier.
 253                 --      let k = BIG in foldr k z xs
 254                 -- ==>  let k = BIG in letrec go = \xs -> ...(k x).... in go xs
 255                 -- ==>  let k = BIG in letrec go = \xs -> ...(BIG x).... in go xs
 256                 -- Don't stop now!
 257         ]),
 258
 259         if cpr        then CoreDoCPResult   else CoreDoNothing,
 260         if strictness then CoreDoStrictness else CoreDoNothing,
 261         CoreDoWorkerWrapper,
 262         CoreDoGlomBinds,
 263
 264         CoreDoSimplify (isAmongSimpl [
 265            MaxSimplifierIterations max_iter
 266                 -- No -finline-phase: allow all Ids to be inlined now
 267         ]),
 268
 269         CoreDoFloatOutwards False{-not full-},
 270                 -- nofib/spectral/hartel/wang doubles in speed if you
 271                 -- do full laziness late in the day.  It only happens
 272                 -- after fusion and other stuff, so the early pass doesn't
 273                 -- catch it.  For the record, the redex is
 274                 --        f_el22 (f_el21 r_midblock)
 275
 276
 277 -- Leave out lambda lifting for now
 278 --        "-fsimplify", -- Tidy up results of full laziness
 279 --          "[",
 280 --                "-fmax-simplifier-iterations2",
 281 --          "]",
 282 --        "-ffloat-outwards-full",
 283
 284         -- We want CSE to follow the final full-laziness pass, because it may
 285         -- succeed in commoning up things floated out by full laziness.
 286         -- CSE used to rely on the no-shadowing invariant, but it doesn't any more
 287
 288         if cse then CoreCSE else CoreDoNothing,
 289
 290         CoreDoFloatInwards,
 291
 292 -- Case-liberation for -O2.  This should be after
 293 -- strictness analysis and the simplification which follows it.
 294
 295         if opt_level >= 2 then
 296            CoreLiberateCase
 297         else
 298            CoreDoNothing,
 299         if opt_level >= 2 then
 300            CoreDoSpecConstr
 301         else
 302            CoreDoNothing,
 303
 304         -- Final clean-up simplification:
 305         CoreDoSimplify (isAmongSimpl [
 306           MaxSimplifierIterations max_iter
 307                 -- No -finline-phase: allow all Ids to be inlined now
 308         ])
 309      ]
 310
 311 buildStgToDo :: IO [ StgToDo ]
 312 buildStgToDo = do
 313   stg_stats <- readIORef v_StgStats
 314   let flags1 | stg_stats = [ D_stg_stats ]
 315              | otherwise = [ ]
 316
 317         -- STG passes
 318   ways_ <- readIORef v_Ways
 319   let flags2 | WayProf `elem` ways_ = StgDoMassageForProfiling : flags1
 320              | otherwise            = flags1
 321
 322   return flags2
 323
 324 -----------------------------------------------------------------------------
 325 -- Paths & Libraries
 326
 327 split_marker = ':'   -- not configurable (ToDo)
 328
 329 v_Import_paths, v_Include_paths, v_Library_paths :: IORef [String]
 330 GLOBAL_VAR(v_Import_paths,  ["."], [String])
 331 GLOBAL_VAR(v_Include_paths, ["."], [String])
 332 GLOBAL_VAR(v_Library_paths, [],  [String])
 333
 334 GLOBAL_VAR(v_Cmdline_libraries,   [], [String])
 335
 336 addToDirList :: IORef [String] -> String -> IO ()
 337 addToDirList ref path
 338   = do paths           <- readIORef ref
 339        shiny_new_ones  <- splitUp path
 340        writeIORef ref (paths ++ shiny_new_ones)
 341
 342   where
 343     splitUp ::String -> IO [String]
 344 #ifdef mingw32_TARGET_OS
 345      -- 'hybrid' support for DOS-style paths in directory lists.
 346      --
 347      -- That is, if "foo:bar:baz" is used, this interpreted as
 348      -- consisting of three entries, 'foo', 'bar', 'baz'.
 349      -- However, with "c:/foo:c:\\foo;x:/bar", this is interpreted
 350      -- as four elts, "c:/foo", "c:\\foo", "x", and "/bar" --
 351      -- *provided* c:/foo exists and x:/bar doesn't.
 352      --
 353      -- Notice that no attempt is made to fully replace the 'standard'
 354      -- split marker ':' with the Windows / DOS one, ';'. The reason being
 355      -- that this will cause too much breakage for users & ':' will
 356      -- work fine even with DOS paths, if you're not insisting on being silly.
 357      -- So, use either.
 358     splitUp []         = return []
 359     splitUp (x:':':div:xs)
 360       | div `elem` dir_markers = do
 361           let (p,rs) = findNextPath xs
 362           ps  <- splitUp rs
 363            {-
 364              Consult the file system to check the interpretation
 365              of (x:':':div:p) -- this is arguably excessive, we
 366              could skip this test & just say that it is a valid
 367              dir path.
 368            -}
 369           flg <- doesDirectoryExist (x:':':div:p)
 370           if flg then
 371              return ((x:':':div:p):ps)
 372            else
 373              return ([x]:(div:p):ps)
 374     splitUp xs = do
 375       let (p,rs) = findNextPath xs
 376       ps <- splitUp rs
 377       return (cons p ps)
 378
 379     cons "" xs = xs
 380     cons x  xs = x:xs
 381
 382     -- will be called either when we've consumed nought or the "<Drive>:/" part of
 383     -- a DOS path, so splitting is just a Q of finding the next split marker.
 384     findNextPath xs =
 385         case break (`elem` split_markers) xs of
 386            (p, d:ds) -> (p, ds)
 387            (p, xs)   -> (p, xs)
 388
 389     split_markers :: [Char]
 390     split_markers = [':', ';']
 391
 392     dir_markers :: [Char]
 393     dir_markers = ['/', '\\']
 394
 395 #else
 396     splitUp xs = return (split split_marker xs)
 397 #endif
 398
 399 GLOBAL_VAR(v_HCHeader, "", String)
 400
 401 -----------------------------------------------------------------------------
 402 -- Packages
 403
 404 -- package list is maintained in dependency order
 405 GLOBAL_VAR(v_Packages, ("std":"rts":"gmp":[]), [String])
 406
 407 addPackage :: String -> IO ()
 408 addPackage package
 409   = do pkg_details <- readIORef v_Package_details
 410        case lookupPkg package pkg_details of
 411           Nothing -> throwDyn (CmdLineError ("unknown package name: " ++ package))
 412           Just details -> do
 413             ps <- readIORef v_Packages
 414             unless (package `elem` ps) $ do
 415                 mapM_ addPackage (package_deps details)
 416                 ps <- readIORef v_Packages
 417                 writeIORef v_Packages (package:ps)
 418
 419 getPackageImportPath   :: IO [String]
 420 getPackageImportPath = do
 421   ps <- getPackageInfo
 422   return (nub (filter (not.null) (concatMap import_dirs ps)))
 423
 424 getPackageIncludePath   :: IO [String]
 425 getPackageIncludePath = do
 426   ps <- getPackageInfo
 427   return (nub (filter (not.null) (concatMap include_dirs ps)))
 428
 429         -- includes are in reverse dependency order (i.e. rts first)
 430 getPackageCIncludes   :: IO [String]
 431 getPackageCIncludes = do
 432   ps <- getPackageInfo
 433   return (reverse (nub (filter (not.null) (concatMap c_includes ps))))
 434
 435 getPackageLibraryPath  :: IO [String]
 436 getPackageLibraryPath = do
 437   ps <- getPackageInfo
 438   return (nub (filter (not.null) (concatMap library_dirs ps)))
 439
 440 getPackageLibraries    :: IO [String]
 441 getPackageLibraries = do
 442   ps <- getPackageInfo
 443   tag <- readIORef v_Build_tag
 444   let suffix = if null tag then "" else '_':tag
 445   return (concat (
 446         map (\p -> map (++suffix) (hACK (hs_libraries p)) ++ extra_libraries p) ps
 447      ))
 448   where
 449      -- This is a totally horrible (temporary) hack, for Win32.  Problem is
 450      -- that package.conf for Win32 says that the main prelude lib is
 451      -- split into HSstd1 and HSstd2, which is needed due to limitations in
 452      -- the PEi386 file format, to make GHCi work.  However, we still only
 453      -- have HSstd.a for static linking, not HSstd1.a and HSstd2.a.
 454      -- getPackageLibraries is called to find the .a's to add to the static
 455      -- link line.  On Win32, this hACK detects HSstd1 and HSstd2 and
 456      -- replaces them with HSstd, so static linking still works.
 457      -- Libraries needed for dynamic (GHCi) linking are discovered via
 458      -- different route (in InteractiveUI.linkPackage).
 459      -- See driver/PackageSrc.hs for the HSstd1/HSstd2 split definition.
 460      -- THIS IS A STRICTLY TEMPORARY HACK (famous last words ...)
 461      hACK libs
 462 #      ifndef mingw32_TARGET_OS
 463        = libs
 464 #      else
 465        = if   "HSstd1" `elem` libs && "HSstd2" `elem` libs
 466          then "HSstd" : filter ((/= "HSstd").(take 5)) libs
 467          else libs
 468 #      endif
 469
 470 getPackageExtraGhcOpts :: IO [String]
 471 getPackageExtraGhcOpts = do
 472   ps <- getPackageInfo
 473   return (concatMap extra_ghc_opts ps)
 474
 475 getPackageExtraCcOpts  :: IO [String]
 476 getPackageExtraCcOpts = do
 477   ps <- getPackageInfo
 478   return (concatMap extra_cc_opts ps)
 479
 480 getPackageExtraLdOpts  :: IO [String]
 481 getPackageExtraLdOpts = do
 482   ps <- getPackageInfo
 483   return (concatMap extra_ld_opts ps)
 484
 485 getPackageInfo :: IO [PackageConfig]
 486 getPackageInfo = do
 487   ps <- readIORef v_Packages
 488   getPackageDetails ps
 489
 490 getPackageDetails :: [String] -> IO [PackageConfig]
 491 getPackageDetails ps = do
 492   pkg_details <- readIORef v_Package_details
 493   return [ pkg | p <- ps, Just pkg <- [ lookupPkg p pkg_details ] ]
 494
 495 GLOBAL_VAR(v_Package_details, (error "package_details"), [PackageConfig])
 496
 497 lookupPkg :: String -> [PackageConfig] -> Maybe PackageConfig
 498 lookupPkg nm ps
 499    = case [p | p <- ps, name p == nm] of
 500         []    -> Nothing
 501         (p:_) -> Just p
 502
 503 -----------------------------------------------------------------------------
 504 -- Ways
 505
 506 -- The central concept of a "way" is that all objects in a given
 507 -- program must be compiled in the same "way".  Certain options change
 508 -- parameters of the virtual machine, eg. profiling adds an extra word
 509 -- to the object header, so profiling objects cannot be linked with
 510 -- non-profiling objects.
 511
 512 -- After parsing the command-line options, we determine which "way" we
 513 -- are building - this might be a combination way, eg. profiling+ticky-ticky.
 514
 515 -- We then find the "build-tag" associated with this way, and this
 516 -- becomes the suffix used to find .hi files and libraries used in
 517 -- this compilation.
 518
 519 GLOBAL_VAR(v_Build_tag, "", String)
 520
 521 data WayName
 522   = WayProf
 523   | WayUnreg
 524   | WayTicky
 525   | WayPar
 526   | WayGran
 527   | WaySMP
 528   | WayDebug
 529   | WayUser_a
 530   | WayUser_b
 531   | WayUser_c
 532   | WayUser_d
 533   | WayUser_e
 534   | WayUser_f
 535   | WayUser_g
 536   | WayUser_h
 537   | WayUser_i
 538   | WayUser_j
 539   | WayUser_k
 540   | WayUser_l
 541   | WayUser_m
 542   | WayUser_n
 543   | WayUser_o
 544   | WayUser_A
 545   | WayUser_B
 546   deriving (Eq,Ord)
 547
 548 GLOBAL_VAR(v_Ways, [] ,[WayName])
 549
 550 allowed_combination way = way `elem` combs
 551   where  -- the sub-lists must be ordered according to WayName,
 552          -- because findBuildTag sorts them
 553     combs                = [ [WayProf,WayUnreg], [WayProf,WaySMP] ]
 554
 555 findBuildTag :: IO [String]  -- new options
 556 findBuildTag = do
 557   way_names <- readIORef v_Ways
 558   case sort way_names of
 559      []  -> do  -- writeIORef v_Build_tag ""
 560                 return []
 561
 562      [w] -> do let details = lkupWay w
 563                writeIORef v_Build_tag (wayTag details)
 564                return (wayOpts details)
 565
 566      ws  -> if not (allowed_combination ws)
 567                 then throwDyn (CmdLineError $
 568                                 "combination not supported: "  ++
 569                                 foldr1 (\a b -> a ++ '/':b)
 570                                 (map (wayName . lkupWay) ws))
 571                 else let stuff = map lkupWay ws
 572                          tag   = concat (map wayTag stuff)
 573                          flags = map wayOpts stuff
 574                      in do
 575                      writeIORef v_Build_tag tag
 576                      return (concat flags)
 577
 578 lkupWay w =
 579    case lookup w way_details of
 580         Nothing -> error "findBuildTag"
 581         Just details -> details
 582
 583 data Way = Way {
 584   wayTag   :: String,
 585   wayName  :: String,
 586   wayOpts  :: [String]
 587   }
 588
 589 way_details :: [ (WayName, Way) ]
 590 way_details =
 591   [ (WayProf, Way  "p" "Profiling"
 592         [ "-fscc-profiling"
 593         , "-DPROFILING"
 594         , "-optc-DPROFILING"
 595         , "-fvia-C" ]),
 596
 597     (WayTicky, Way  "t" "Ticky-ticky Profiling"
 598         [ "-fticky-ticky"
 599         , "-DTICKY_TICKY"
 600         , "-optc-DTICKY_TICKY"
 601         , "-fvia-C" ]),
 602
 603     (WayUnreg, Way  "u" "Unregisterised"
 604         unregFlags ),
 605
 606     -- optl's below to tell linker where to find the PVM library -- HWL
 607     (WayPar, Way  "mp" "Parallel"
 608         [ "-fparallel"
 609         , "-D__PARALLEL_HASKELL__"
 610         , "-optc-DPAR"
 611         , "-package concurrent"
 612         , "-optc-w"
 613         , "-optl-L${PVM_ROOT}/lib/${PVM_ARCH}"
 614         , "-optl-lpvm3"
 615         , "-optl-lgpvm3"
 616         , "-fvia-C" ]),
 617
 618     -- at the moment we only change the RTS and could share compiler and libs!
 619     (WayPar, Way  "mt" "Parallel ticky profiling"
 620         [ "-fparallel"
 621         , "-D__PARALLEL_HASKELL__"
 622         , "-optc-DPAR"
 623         , "-optc-DPAR_TICKY"
 624         , "-package concurrent"
 625         , "-optc-w"
 626         , "-optl-L${PVM_ROOT}/lib/${PVM_ARCH}"
 627         , "-optl-lpvm3"
 628         , "-optl-lgpvm3"
 629         , "-fvia-C" ]),
 630
 631     (WayPar, Way  "md" "Distributed"
 632         [ "-fparallel"
 633         , "-D__PARALLEL_HASKELL__"
 634         , "-D__DISTRIBUTED_HASKELL__"
 635         , "-optc-DPAR"
 636         , "-optc-DDIST"
 637         , "-package concurrent"
 638         , "-optc-w"
 639         , "-optl-L${PVM_ROOT}/lib/${PVM_ARCH}"
 640         , "-optl-lpvm3"
 641         , "-optl-lgpvm3"
 642         , "-fvia-C" ]),
 643
 644     (WayGran, Way  "mg" "GranSim"
 645         [ "-fgransim"
 646         , "-D__GRANSIM__"
 647         , "-optc-DGRAN"
 648         , "-package concurrent"
 649         , "-fvia-C" ]),
 650
 651     (WaySMP, Way  "s" "SMP"
 652         [ "-fsmp"
 653         , "-optc-pthread"
 654         , "-optl-pthread"
 655         , "-optc-DSMP"
 656         , "-fvia-C" ]),
 657
 658     (WayUser_a,  Way  "a"  "User way 'a'"  ["$WAY_a_REAL_OPTS"]),
 659     (WayUser_b,  Way  "b"  "User way 'b'"  ["$WAY_b_REAL_OPTS"]),
 660     (WayUser_c,  Way  "c"  "User way 'c'"  ["$WAY_c_REAL_OPTS"]),
 661     (WayUser_d,  Way  "d"  "User way 'd'"  ["$WAY_d_REAL_OPTS"]),
 662     (WayUser_e,  Way  "e"  "User way 'e'"  ["$WAY_e_REAL_OPTS"]),
 663     (WayUser_f,  Way  "f"  "User way 'f'"  ["$WAY_f_REAL_OPTS"]),
 664     (WayUser_g,  Way  "g"  "User way 'g'"  ["$WAY_g_REAL_OPTS"]),
 665     (WayUser_h,  Way  "h"  "User way 'h'"  ["$WAY_h_REAL_OPTS"]),
 666     (WayUser_i,  Way  "i"  "User way 'i'"  ["$WAY_i_REAL_OPTS"]),
 667     (WayUser_j,  Way  "j"  "User way 'j'"  ["$WAY_j_REAL_OPTS"]),
 668     (WayUser_k,  Way  "k"  "User way 'k'"  ["$WAY_k_REAL_OPTS"]),
 669     (WayUser_l,  Way  "l"  "User way 'l'"  ["$WAY_l_REAL_OPTS"]),
 670     (WayUser_m,  Way  "m"  "User way 'm'"  ["$WAY_m_REAL_OPTS"]),
 671     (WayUser_n,  Way  "n"  "User way 'n'"  ["$WAY_n_REAL_OPTS"]),
 672     (WayUser_o,  Way  "o"  "User way 'o'"  ["$WAY_o_REAL_OPTS"]),
 673     (WayUser_A,  Way  "A"  "User way 'A'"  ["$WAY_A_REAL_OPTS"]),
 674     (WayUser_B,  Way  "B"  "User way 'B'"  ["$WAY_B_REAL_OPTS"])
 675   ]
 676
 677 unregFlags =
 678    [ "-optc-DNO_REGS"
 679    , "-optc-DUSE_MINIINTERPRETER"
 680    , "-fno-asm-mangling"
 681    , "-funregisterised"
 682    , "-fvia-C" ]
 683
 684 -----------------------------------------------------------------------------
 685 -- Programs for particular phases
 686
 687 GLOBAL_VAR(v_Opt_dep,    [], [String])
 688 GLOBAL_VAR(v_Anti_opt_C, [], [String])
 689 GLOBAL_VAR(v_Opt_C,      [], [String])
 690 GLOBAL_VAR(v_Opt_l,      [], [String])
 691 GLOBAL_VAR(v_Opt_dll,    [], [String])
 692
 693 getStaticOpts :: IORef [String] -> IO [String]
 694 getStaticOpts ref = readIORef ref >>= return . reverse