ghc/compiler/main/DriverState.hs

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