[project @ 2005-01-28 12:55:17 by simonmar]
[ghc-hetmet.git] / ghc / compiler / main / DriverState.hs
index acd5e49..4f953eb 100644 (file)
@@ -1,5 +1,4 @@
 -----------------------------------------------------------------------------
--- $Id: DriverState.hs,v 1.88 2002/12/18 16:29:28 simonmar Exp $
 --
 -- Settings for the driver
 --
@@ -9,16 +8,11 @@
 
 module DriverState where
 
-#include "../includes/config.h"
 #include "HsVersions.h"
 
-import ParsePkgConf    ( loadPackageConfig )
-import SysTools                ( getTopDir )
-import Packages
 import CmdLineOpts
 import DriverPhases
 import DriverUtil
-import UniqFM          ( eltsUFM )
 import Util
 import Config
 import Panic
@@ -47,7 +41,8 @@ data GhcMode
   | DoMake                             -- ghc --make
   | DoInteractive                      -- ghc --interactive
   | DoLink                             -- [ the default ]
-  deriving (Eq,Show)
+  | DoEval String                      -- ghc -e
+  deriving (Show)
 
 GLOBAL_VAR(v_GhcMode,     DoLink, GhcMode)
 GLOBAL_VAR(v_GhcModeFlag, "",     String)
@@ -62,21 +57,39 @@ setMode m flag = do
   writeIORef v_GhcMode m
   writeIORef v_GhcModeFlag flag
 
+isInteractiveMode, isInterpretiveMode     :: GhcMode -> Bool
+isMakeMode, isLinkMode, isCompManagerMode :: GhcMode -> Bool
+
+isInteractiveMode DoInteractive = True
+isInteractiveMode _            = False
+
+-- isInterpretiveMode: byte-code compiler involved
+isInterpretiveMode DoInteractive = True
+isInterpretiveMode (DoEval _)    = True
+isInterpretiveMode _             = False
+
+isMakeMode DoMake = True
+isMakeMode _      = False
+
+isLinkMode DoLink  = True
+isLinkMode DoMkDLL = True
+isLinkMode _       = False
+
 isCompManagerMode DoMake        = True
 isCompManagerMode DoInteractive = True
+isCompManagerMode (DoEval _)    = True
 isCompManagerMode _             = False
 
 -----------------------------------------------------------------------------
 -- Global compilation flags
 
--- Cpp-related flags
-v_Hs_source_cpp_opts = global
+-- Default CPP defines in Haskell source
+hsSourceCppOpts =
        [ "-D__HASKELL1__="++cHaskell1Version
        , "-D__GLASGOW_HASKELL__="++cProjectVersionInt                          
        , "-D__HASKELL98__"
        , "-D__CONCURRENT_HASKELL__"
        ]
-{-# NOINLINE v_Hs_source_cpp_opts #-}
 
 
 -- Keep output from intermediate phases
@@ -95,7 +108,8 @@ GLOBAL_VAR(v_Scale_sizes_by,         1.0,            Double)
 GLOBAL_VAR(v_Static,                   True,           Bool)
 GLOBAL_VAR(v_NoLink,                   False,          Bool)
 GLOBAL_VAR(v_NoHsMain,                         False,          Bool)
-GLOBAL_VAR(v_Recomp,                   True,           Bool)
+GLOBAL_VAR(v_MainModIs,                        Nothing,        Maybe String)
+GLOBAL_VAR(v_MainFunIs,                        Nothing,        Maybe String)
 GLOBAL_VAR(v_Collect_ghc_timing,       False,          Bool)
 GLOBAL_VAR(v_Do_asm_mangling,          True,           Bool)
 GLOBAL_VAR(v_Excess_precision,         False,          Bool)
@@ -113,14 +127,19 @@ GLOBAL_VAR(v_Split_info,          ("",0),         (String,Int))
 
        
 can_split :: Bool
-can_split =  prefixMatch "i386"    cTARGETPLATFORM
-         || prefixMatch "alpha"   cTARGETPLATFORM
-         || prefixMatch "hppa"    cTARGETPLATFORM
-         || prefixMatch "m68k"    cTARGETPLATFORM
-         || prefixMatch "mips"    cTARGETPLATFORM
-         || prefixMatch "powerpc" cTARGETPLATFORM
-         || prefixMatch "rs6000"  cTARGETPLATFORM
-         || prefixMatch "sparc"   cTARGETPLATFORM
+can_split =  
+#if    defined(i386_TARGET_ARCH)     \
+    || defined(alpha_TARGET_ARCH)    \
+    || defined(hppa_TARGET_ARCH)     \
+    || defined(m68k_TARGET_ARCH)     \
+    || defined(mips_TARGET_ARCH)     \
+    || defined(powerpc_TARGET_ARCH)  \
+    || defined(rs6000_TARGET_ARCH)   \
+    || defined(sparc_TARGET_ARCH) 
+   True
+#else
+   False
+#endif
 
 -----------------------------------------------------------------------------
 -- Compiler output options
@@ -159,8 +178,8 @@ verifyOutputFiles = do
                              show dir ++ " does not exist (used with " ++ 
                             show flg ++ " option.)"))
 
-GLOBAL_VAR(v_Object_suf,  phaseInputExt Ln, String)
-GLOBAL_VAR(v_HC_suf,     Nothing, Maybe String)
+GLOBAL_VAR(v_Object_suf,  phaseInputExt StopLn, String)
+GLOBAL_VAR(v_HC_suf,     phaseInputExt HCc,    String)
 GLOBAL_VAR(v_Hi_dir,      Nothing, Maybe String)
 GLOBAL_VAR(v_Hi_suf,      "hi",           String)
 
@@ -178,182 +197,7 @@ osuf_ify f = do
   osuf <- readIORef v_Object_suf
   return (replaceFilenameSuffix f osuf)
 
------------------------------------------------------------------------------
--- Compiler optimisation options
-
-GLOBAL_VAR(v_OptLevel, 0, Int)
-
-setOptLevel :: Int -> IO ()
-setOptLevel n = do
-  when (n >= 1) $ setLang HscC         -- turn on -fvia-C with -O
-  writeIORef v_OptLevel n
-
-GLOBAL_VAR(v_minus_o2_for_C,            False, Bool)
-GLOBAL_VAR(v_MaxSimplifierIterations,   4,     Int)
 GLOBAL_VAR(v_StgStats,                  False, Bool)
-GLOBAL_VAR(v_UsageSPInf,               False, Bool)  -- Off by default
-GLOBAL_VAR(v_Strictness,               True,  Bool)
-GLOBAL_VAR(v_CSE,                      True,  Bool)
-GLOBAL_VAR(v_RuleCheck,                Nothing,  Maybe String)
-
--- these are the static flags you get without -O.
-hsc_minusNoO_flags =
-       [ 
-       "-fignore-interface-pragmas",
-       "-fomit-interface-pragmas",
-       "-fdo-lambda-eta-expansion",    -- This one is important for a tiresome reason:
-                                       -- we want to make sure that the bindings for data 
-                                       -- constructors are eta-expanded.  This is probably
-                                       -- a good thing anyway, but it seems fragile.
-       "-flet-no-escape"
-       ]
-
--- these are the static flags you get when -O is on.
-hsc_minusO_flags =
-  [ 
-       "-fignore-asserts",
-       "-ffoldr-build-on",
-        "-fdo-eta-reduction",
-       "-fdo-lambda-eta-expansion",
-       "-fcase-merge",
-       "-flet-to-case",
-       "-flet-no-escape"
-   ]
-
-hsc_minusO2_flags = hsc_minusO_flags   -- for now
-
-getStaticOptimisationFlags 0 = hsc_minusNoO_flags
-getStaticOptimisationFlags 1 = hsc_minusO_flags
-getStaticOptimisationFlags n = hsc_minusO2_flags
-
-buildCoreToDo :: IO [CoreToDo]
-buildCoreToDo = do
-   opt_level  <- readIORef v_OptLevel
-   max_iter   <- readIORef v_MaxSimplifierIterations
-   usageSP    <- readIORef v_UsageSPInf
-   strictness <- readIORef v_Strictness
-   cse        <- readIORef v_CSE
-   rule_check <- readIORef v_RuleCheck
-
-   if opt_level == 0 then return
-      [
-       CoreDoSimplify (SimplPhase 0) [
-           MaxSimplifierIterations max_iter
-       ]
-      ]
-
-    else {- opt_level >= 1 -} return [ 
-
-       -- initial simplify: mk specialiser happy: minimum effort please
-       CoreDoSimplify SimplGently [
-                       --      Simplify "gently"
-                       -- Don't inline anything till full laziness has bitten
-                       -- In particular, inlining wrappers inhibits floating
-                       -- e.g. ...(case f x of ...)...
-                       --  ==> ...(case (case x of I# x# -> fw x#) of ...)...
-                       --  ==> ...(case x of I# x# -> case fw x# of ...)...
-                       -- and now the redex (f x) isn't floatable any more
-                       -- Similarly, don't apply any rules until after full 
-                       -- laziness.  Notably, list fusion can prevent floating.
-
-            NoCaseOfCase,
-                       -- Don't do case-of-case transformations.
-                       -- This makes full laziness work better
-           MaxSimplifierIterations max_iter
-       ],
-
-       -- Specialisation is best done before full laziness
-       -- so that overloaded functions have all their dictionary lambdas manifest
-       CoreDoSpecialising,
-
-       CoreDoFloatOutwards (FloatOutSw False False),
-       CoreDoFloatInwards,
-
-       CoreDoSimplify (SimplPhase 2) [
-               -- Want to run with inline phase 2 after the specialiser to give
-               -- maximum chance for fusion to work before we inline build/augment
-               -- in phase 1.  This made a difference in 'ansi' where an 
-               -- overloaded function wasn't inlined till too late.
-          MaxSimplifierIterations max_iter
-       ],
-       case rule_check of { Just pat -> CoreDoRuleCheck 2 pat; Nothing -> CoreDoNothing },
-
-       -- infer usage information here in case we need it later.
-        -- (add more of these where you need them --KSW 1999-04)
-        if usageSP then CoreDoUSPInf else CoreDoNothing,
-
-       CoreDoSimplify (SimplPhase 1) [
-               -- Need inline-phase2 here so that build/augment get 
-               -- inlined.  I found that spectral/hartel/genfft lost some useful
-               -- strictness in the function sumcode' if augment is not inlined
-               -- before strictness analysis runs
-          MaxSimplifierIterations max_iter
-       ],
-       case rule_check of { Just pat -> CoreDoRuleCheck 1 pat; Nothing -> CoreDoNothing },
-
-       CoreDoSimplify (SimplPhase 0) [
-               -- Phase 0: allow all Ids to be inlined now
-               -- This gets foldr inlined before strictness analysis
-
-          MaxSimplifierIterations 3
-               -- At least 3 iterations because otherwise we land up with
-               -- huge dead expressions because of an infelicity in the 
-               -- simpifier.   
-               --      let k = BIG in foldr k z xs
-               -- ==>  let k = BIG in letrec go = \xs -> ...(k x).... in go xs
-               -- ==>  let k = BIG in letrec go = \xs -> ...(BIG x).... in go xs
-               -- Don't stop now!
-
-       ],
-       case rule_check of { Just pat -> CoreDoRuleCheck 0 pat; Nothing -> CoreDoNothing },
-
-#ifdef OLD_STRICTNESS
-       CoreDoOldStrictness
-#endif
-       if strictness then CoreDoStrictness else CoreDoNothing,
-       CoreDoWorkerWrapper,
-       CoreDoGlomBinds,
-
-       CoreDoSimplify (SimplPhase 0) [
-          MaxSimplifierIterations max_iter
-       ],
-
-       CoreDoFloatOutwards (FloatOutSw False   -- Not lambdas
-                                       True),  -- Float constants
-               -- nofib/spectral/hartel/wang doubles in speed if you
-               -- do full laziness late in the day.  It only happens
-               -- after fusion and other stuff, so the early pass doesn't
-               -- catch it.  For the record, the redex is 
-               --        f_el22 (f_el21 r_midblock)
-
-
-       -- We want CSE to follow the final full-laziness pass, because it may
-       -- succeed in commoning up things floated out by full laziness.
-       -- CSE used to rely on the no-shadowing invariant, but it doesn't any more
-
-       if cse then CoreCSE else CoreDoNothing,
-
-       CoreDoFloatInwards,
-
--- Case-liberation for -O2.  This should be after
--- strictness analysis and the simplification which follows it.
-
-       case rule_check of { Just pat -> CoreDoRuleCheck 0 pat; Nothing -> CoreDoNothing },
-
-       if opt_level >= 2 then
-          CoreLiberateCase
-       else
-          CoreDoNothing,
-       if opt_level >= 2 then
-          CoreDoSpecConstr
-       else
-          CoreDoNothing,
-
-       -- Final clean-up simplification:
-       CoreDoSimplify (SimplPhase 0) [
-         MaxSimplifierIterations max_iter
-       ]
-     ]
 
 buildStgToDo :: IO [ StgToDo ]
 buildStgToDo = do
@@ -373,9 +217,8 @@ buildStgToDo = do
 
 split_marker = ':'   -- not configurable (ToDo)
 
-v_Import_paths, v_Include_paths, v_Library_paths :: IORef [String]
-GLOBAL_VAR(v_Import_paths,  ["."], [String])
-GLOBAL_VAR(v_Include_paths, ["."], [String])
+v_Include_paths, v_Library_paths :: IORef [String]
+GLOBAL_VAR(v_Include_paths, [], [String])
 GLOBAL_VAR(v_Library_paths, [],         [String])
 
 #ifdef darwin_TARGET_OS
@@ -386,14 +229,17 @@ GLOBAL_VAR(v_Cmdline_frameworks, [], [String])
 addToDirList :: IORef [String] -> String -> IO ()
 addToDirList ref path
   = do paths           <- readIORef ref
-       shiny_new_ones  <- splitUp path
-       writeIORef ref (paths ++ filter notNull shiny_new_ones)
+       shiny_new_ones  <- splitPathList path
+       writeIORef ref (paths ++ shiny_new_ones)
+
+
+splitPathList :: String -> IO [String]
+splitPathList s = do ps <- splitUp s; return (filter notNull ps)
                -- empty paths are ignored: there might be a trailing
                -- ':' in the initial list, for example.  Empty paths can
                -- cause confusion when they are translated into -I options
                -- for passing to gcc.
   where
-    splitUp ::String -> IO [String]
 #ifdef mingw32_TARGET_OS
      -- 'hybrid' support for DOS-style paths in directory lists.
      -- 
@@ -449,182 +295,6 @@ addToDirList ref path
     splitUp xs = return (split split_marker xs)
 #endif
 
--- ----------------------------------------------------------------------------
--- Loading the package config file
-
-readPackageConf :: String -> IO ()
-readPackageConf conf_file = do
-  proto_pkg_configs <- loadPackageConfig conf_file
-  top_dir          <- getTopDir
-  let pkg_configs = mungePackagePaths top_dir proto_pkg_configs
-  extendPackageConfigMap pkg_configs
-
-mungePackagePaths :: String -> [PackageConfig] -> [PackageConfig]
--- Replace the string "$libdir" at the beginning of a path
--- with the current libdir (obtained from the -B option).
-mungePackagePaths top_dir ps = map munge_pkg ps
- where 
-  munge_pkg p = p{ import_dirs  = munge_paths (import_dirs p),
-                  include_dirs = munge_paths (include_dirs p),
-                  library_dirs = munge_paths (library_dirs p),
-                  framework_dirs = munge_paths (framework_dirs p) }
-
-  munge_paths = map munge_path
-
-  munge_path p 
-         | Just p' <- my_prefix_match "$libdir" p = top_dir ++ p'
-         | otherwise                              = p
-
-
--- -----------------------------------------------------------------------------
--- The list of packages requested on the command line
-
--- The package list reflects what packages were given as command-line options,
--- plus their dependent packages.  It is maintained in dependency order;
--- earlier packages may depend on later ones, but not vice versa
-GLOBAL_VAR(v_ExplicitPackages, initPackageList, [PackageName])
-
-initPackageList = [rtsPackage]
-
--- add a package requested from the command-line
-addPackage :: String -> IO ()
-addPackage package = do
-  pkg_details <- getPackageConfigMap
-  ps  <- readIORef v_ExplicitPackages
-  ps' <- add_package pkg_details ps (mkPackageName package)
-               -- Throws an exception if it fails
-  writeIORef v_ExplicitPackages ps'
-
--- internal helper
-add_package :: PackageConfigMap -> [PackageName]
-           -> PackageName -> IO [PackageName]
-add_package pkg_details ps p   
-  | p `elem` ps        -- Check if we've already added this package
-  = return ps
-  | Just details <- lookupPkg pkg_details p
-  -- Add the package's dependents also
-  = do ps' <- foldM (add_package pkg_details) ps (packageDependents details)
-       return (p : ps')
-  | otherwise
-  = throwDyn (CmdLineError ("unknown package name: " ++ packageNameString p))
-
-
--- -----------------------------------------------------------------------------
--- Extracting information from the packages in scope
-
--- Many of these functions take a list of packages: in those cases,
--- the list is expected to contain the "dependent packages",
--- i.e. those packages that were found to be depended on by the
--- current module/program.  These can be auto or non-auto packages, it
--- doesn't really matter.  The list is always combined with the list
--- of explicit (command-line) packages to determine which packages to
--- use.
-
-getPackageImportPath :: IO [String]
-getPackageImportPath = do
-  ps <- getExplicitAndAutoPackageConfigs
-                 -- import dirs are always derived from the 'auto' 
-                 -- packages as well as the explicit ones
-  return (nub (filter notNull (concatMap import_dirs ps)))
-
-getPackageIncludePath :: [PackageName] -> IO [String]
-getPackageIncludePath pkgs = do
-  ps <- getExplicitPackagesAnd pkgs
-  return (nub (filter notNull (concatMap include_dirs ps)))
-
-       -- includes are in reverse dependency order (i.e. rts first)
-getPackageCIncludes :: [PackageConfig] -> IO [String]
-getPackageCIncludes pkg_configs = do
-  return (reverse (nub (filter notNull (concatMap c_includes pkg_configs))))
-
-getPackageLibraryPath :: [PackageName] -> IO [String]
-getPackageLibraryPath pkgs = do 
-  ps <- getExplicitPackagesAnd pkgs
-  return (nub (filter notNull (concatMap library_dirs ps)))
-
-getPackageLinkOpts :: [PackageName] -> IO [String]
-getPackageLinkOpts pkgs = do
-  ps <- getExplicitPackagesAnd pkgs
-  tag <- readIORef v_Build_tag
-  static <- readIORef v_Static
-  let 
-       imp        = if static then "" else "_imp"
-       suffix     = if null tag then "" else '_':tag
-       libs p     = map (++suffix) (hACK (hs_libraries p)) ++ extra_libraries p
-       imp_libs p = map (++imp) (libs p)
-       all_opts p = map ("-l" ++) (imp_libs p) ++ extra_ld_opts p
-
-  return (concat (map all_opts ps))
-  where
-     -- This is a totally horrible (temporary) hack, for Win32.  Problem is
-     -- that package.conf for Win32 says that the main prelude lib is 
-     -- split into HSbase1, HSbase2 and HSbase3, which is needed due to a bug
-     -- in the GNU linker (PEi386 backend). However, we still only
-     -- have HSbase.a for static linking, not HSbase{1,2,3}.a
-     -- getPackageLibraries is called to find the .a's to add to the static
-     -- link line.  On Win32, this hACK detects HSbase{1,2,3} and 
-     -- replaces them with HSbase, so static linking still works.
-     -- Libraries needed for dynamic (GHCi) linking are discovered via
-     -- different route (in InteractiveUI.linkPackage).
-     -- See driver/PackageSrc.hs for the HSbase1/HSbase2 split definition.
-     -- THIS IS A STRICTLY TEMPORARY HACK (famous last words ...)
-     -- JRS 04 Sept 01: Same appalling hack for HSwin32[1,2]
-     -- KAA 29 Mar  02: Same appalling hack for HSobjectio[1,2,3,4]
-     hACK libs
-#      if !defined(mingw32_TARGET_OS) && !defined(cygwin32_TARGET_OS)
-       = libs
-#      else
-       = if   "HSbase1" `elem` libs && "HSbase2" `elem` libs && "HSbase3" `elem` libs
-         then "HSbase" : filter (not.(isPrefixOf "HSbase")) libs
-         else
-         if   "HSwin321" `elem` libs && "HSwin322" `elem` libs
-         then "HSwin32" : filter (not.(isPrefixOf "HSwin32")) libs
-         else 
-         if   "HSobjectio1" `elem` libs && "HSobjectio2" `elem` libs && "HSobjectio3" `elem` libs && "HSobjectio4" `elem` libs
-        then "HSobjectio" : filter (not.(isPrefixOf "HSobjectio")) libs
-         else 
-         libs
-#      endif
-
-getPackageExtraGhcOpts :: IO [String]
-getPackageExtraGhcOpts = do
-  ps <- getExplicitAndAutoPackageConfigs
-  return (concatMap extra_ghc_opts ps)
-
-getPackageExtraCcOpts :: [PackageName] -> IO [String]
-getPackageExtraCcOpts pkgs = do
-  ps <- getExplicitPackagesAnd pkgs
-  return (concatMap extra_cc_opts ps)
-
-#ifdef darwin_TARGET_OS
-getPackageFrameworkPath  :: [PackageName] -> IO [String]
-getPackageFrameworkPath = do
-  ps <- getExplicitPackagesAnd pkgs
-  return (nub (filter notNull (concatMap framework_dirs ps)))
-
-getPackageFrameworks  :: [PackageName] -> IO [String]
-getPackageFrameworks pkgs = do
-  ps <- getExplicitPackagesAnd pkgs
-  return (concatMap extra_frameworks ps)
-#endif
-
--- -----------------------------------------------------------------------------
--- Package Utils
-
-getExplicitPackagesAnd :: [PackageName] -> IO [PackageConfig]
-getExplicitPackagesAnd pkg_names = do
-  pkg_map <- getPackageConfigMap
-  expl <- readIORef v_ExplicitPackages
-  all_pkgs <- foldM (add_package pkg_map) expl pkg_names
-  getPackageDetails all_pkgs
-
--- return all packages, including both the auto packages and the explicit ones
-getExplicitAndAutoPackageConfigs :: IO [PackageConfig]
-getExplicitAndAutoPackageConfigs = do
-  pkg_map <- getPackageConfigMap
-  let auto_packages = [ mkPackageName (name p) | p <- eltsUFM pkg_map, auto p ]
-  getExplicitPackagesAnd auto_packages
-
 -----------------------------------------------------------------------------
 -- Ways
 
@@ -643,15 +313,20 @@ getExplicitAndAutoPackageConfigs = do
 
 GLOBAL_VAR(v_Build_tag, "", String)
 
+-- The RTS has its own build tag, because there are some ways that
+-- affect the RTS only.
+GLOBAL_VAR(v_RTS_Build_tag, "", String)
+
 data WayName
-  = WayProf
+  = WayThreaded
+  | WayDebug
+  | WayProf
   | WayUnreg
   | WayTicky
   | WayPar
   | WayGran
   | WaySMP
   | WayNDP
-  | WayDebug
   | WayUser_a
   | WayUser_b
   | WayUser_c
@@ -673,35 +348,44 @@ data WayName
 
 GLOBAL_VAR(v_Ways, [] ,[WayName])
 
-allowed_combination way = way `elem` combs
-  where  -- the sub-lists must be ordered according to WayName, 
-         -- because findBuildTag sorts them
-    combs                = [ [WayProf, WayUnreg], 
-                            [WayProf, WaySMP]  ,
-                            [WayProf, WayNDP]  ]
+allowed_combination way = and [ x `allowedWith` y 
+                             | x <- way, y <- way, x < y ]
+  where
+       -- Note ordering in these tests: the left argument is
+       -- <= the right argument, according to the Ord instance
+       -- on Way above.
+
+       -- debug is allowed with everything
+       _ `allowedWith` WayDebug                = True
+       WayDebug `allowedWith` _                = True
+
+       WayThreaded `allowedWith` WayProf       = True
+       WayProf `allowedWith` WayUnreg          = True
+       WayProf `allowedWith` WaySMP            = True
+       WayProf `allowedWith` WayNDP            = True
+       _ `allowedWith` _                       = False
+
 
 findBuildTag :: IO [String]  -- new options
 findBuildTag = do
   way_names <- readIORef v_Ways
-  case sort way_names of
-     []  -> do  -- writeIORef v_Build_tag ""
-               return []
-
-     [w] -> do let details = lkupWay w
-              writeIORef v_Build_tag (wayTag details)
-              return (wayOpts details)
-
-     ws  -> if not (allowed_combination ws)
-               then throwDyn (CmdLineError $
-                               "combination not supported: "  ++
-                               foldr1 (\a b -> a ++ '/':b) 
-                               (map (wayName . lkupWay) ws))
-               else let stuff = map lkupWay ws
-                        tag   = concat (map wayTag stuff)
-                        flags = map wayOpts stuff
-                    in do
-                    writeIORef v_Build_tag tag
-                    return (concat flags)
+  let ws = sort way_names
+  if not (allowed_combination ws)
+      then throwDyn (CmdLineError $
+                   "combination not supported: "  ++
+                   foldr1 (\a b -> a ++ '/':b) 
+                   (map (wayName . lkupWay) ws))
+      else let ways    = map lkupWay ws
+              tag     = mkBuildTag (filter (not.wayRTSOnly) ways)
+              rts_tag = mkBuildTag ways
+              flags   = map wayOpts ways
+          in do
+          writeIORef v_Build_tag tag
+          writeIORef v_RTS_Build_tag rts_tag
+          return (concat flags)
+
+mkBuildTag :: [Way] -> String
+mkBuildTag ways = concat (intersperse "_" (map wayTag ways))
 
 lkupWay w = 
    case lookup w way_details of
@@ -709,30 +393,40 @@ lkupWay w =
        Just details -> details
 
 data Way = Way {
-  wayTag   :: String,
-  wayName  :: String,
-  wayOpts  :: [String]
+  wayTag     :: String,
+  wayRTSOnly :: Bool,
+  wayName    :: String,
+  wayOpts    :: [String]
   }
 
 way_details :: [ (WayName, Way) ]
 way_details =
-  [ (WayProf, Way  "p" "Profiling"  
+  [ (WayThreaded, Way "thr" True "Threaded" [
+#if defined(freebsd_TARGET_OS)
+         "-optc-pthread"
+        , "-optl-pthread"
+#endif
+       ] ),
+
+    (WayDebug, Way "debug" True "Debug" [] ),
+
+    (WayProf, Way  "p" False "Profiling"
        [ "-fscc-profiling"
        , "-DPROFILING"
        , "-optc-DPROFILING"
        , "-fvia-C" ]),
 
-    (WayTicky, Way  "t" "Ticky-ticky Profiling"  
+    (WayTicky, Way  "t" False "Ticky-ticky Profiling"  
        [ "-fticky-ticky"
        , "-DTICKY_TICKY"
        , "-optc-DTICKY_TICKY"
        , "-fvia-C" ]),
 
-    (WayUnreg, Way  "u" "Unregisterised" 
+    (WayUnreg, Way  "u" False "Unregisterised" 
        unregFlags ),
 
     -- optl's below to tell linker where to find the PVM library -- HWL
-    (WayPar, Way  "mp" "Parallel" 
+    (WayPar, Way  "mp" False "Parallel" 
        [ "-fparallel"
        , "-D__PARALLEL_HASKELL__"
        , "-optc-DPAR"
@@ -744,7 +438,7 @@ way_details =
        , "-fvia-C" ]),
 
     -- at the moment we only change the RTS and could share compiler and libs!
-    (WayPar, Way  "mt" "Parallel ticky profiling" 
+    (WayPar, Way  "mt" False "Parallel ticky profiling" 
        [ "-fparallel"
        , "-D__PARALLEL_HASKELL__"
        , "-optc-DPAR"
@@ -756,7 +450,7 @@ way_details =
         , "-optl-lgpvm3"
        , "-fvia-C" ]),
 
-    (WayPar, Way  "md" "Distributed" 
+    (WayPar, Way  "md" False "Distributed" 
        [ "-fparallel"
        , "-D__PARALLEL_HASKELL__"
        , "-D__DISTRIBUTED_HASKELL__"
@@ -769,41 +463,43 @@ way_details =
         , "-optl-lgpvm3"
        , "-fvia-C" ]),
 
-    (WayGran, Way  "mg" "GranSim" 
+    (WayGran, Way  "mg" False "GranSim"
        [ "-fgransim"
        , "-D__GRANSIM__"
        , "-optc-DGRAN"
        , "-package concurrent"
        , "-fvia-C" ]),
 
-    (WaySMP, Way  "s" "SMP"
+    (WaySMP, Way  "s" False "SMP"
        [ "-fsmp"
        , "-optc-pthread"
+#ifndef freebsd_TARGET_OS
        , "-optl-pthread"
+#endif
        , "-optc-DSMP"
        , "-fvia-C" ]),
 
-    (WayNDP, Way  "ndp" "Nested data parallelism"
+    (WayNDP, Way  "ndp" False "Nested data parallelism"
        [ "-fparr"
        , "-fflatten"]),
 
-    (WayUser_a,  Way  "a"  "User way 'a'"  ["$WAY_a_REAL_OPTS"]),      
-    (WayUser_b,  Way  "b"  "User way 'b'"  ["$WAY_b_REAL_OPTS"]),      
-    (WayUser_c,  Way  "c"  "User way 'c'"  ["$WAY_c_REAL_OPTS"]),      
-    (WayUser_d,  Way  "d"  "User way 'd'"  ["$WAY_d_REAL_OPTS"]),      
-    (WayUser_e,  Way  "e"  "User way 'e'"  ["$WAY_e_REAL_OPTS"]),      
-    (WayUser_f,  Way  "f"  "User way 'f'"  ["$WAY_f_REAL_OPTS"]),      
-    (WayUser_g,  Way  "g"  "User way 'g'"  ["$WAY_g_REAL_OPTS"]),      
-    (WayUser_h,  Way  "h"  "User way 'h'"  ["$WAY_h_REAL_OPTS"]),      
-    (WayUser_i,  Way  "i"  "User way 'i'"  ["$WAY_i_REAL_OPTS"]),      
-    (WayUser_j,  Way  "j"  "User way 'j'"  ["$WAY_j_REAL_OPTS"]),      
-    (WayUser_k,  Way  "k"  "User way 'k'"  ["$WAY_k_REAL_OPTS"]),      
-    (WayUser_l,  Way  "l"  "User way 'l'"  ["$WAY_l_REAL_OPTS"]),      
-    (WayUser_m,  Way  "m"  "User way 'm'"  ["$WAY_m_REAL_OPTS"]),      
-    (WayUser_n,  Way  "n"  "User way 'n'"  ["$WAY_n_REAL_OPTS"]),      
-    (WayUser_o,  Way  "o"  "User way 'o'"  ["$WAY_o_REAL_OPTS"]),      
-    (WayUser_A,  Way  "A"  "User way 'A'"  ["$WAY_A_REAL_OPTS"]),      
-    (WayUser_B,  Way  "B"  "User way 'B'"  ["$WAY_B_REAL_OPTS"]) 
+    (WayUser_a,  Way  "a"  False "User way 'a'"  ["$WAY_a_REAL_OPTS"]),        
+    (WayUser_b,  Way  "b"  False "User way 'b'"  ["$WAY_b_REAL_OPTS"]),        
+    (WayUser_c,  Way  "c"  False "User way 'c'"  ["$WAY_c_REAL_OPTS"]),        
+    (WayUser_d,  Way  "d"  False "User way 'd'"  ["$WAY_d_REAL_OPTS"]),        
+    (WayUser_e,  Way  "e"  False "User way 'e'"  ["$WAY_e_REAL_OPTS"]),        
+    (WayUser_f,  Way  "f"  False "User way 'f'"  ["$WAY_f_REAL_OPTS"]),        
+    (WayUser_g,  Way  "g"  False "User way 'g'"  ["$WAY_g_REAL_OPTS"]),        
+    (WayUser_h,  Way  "h"  False "User way 'h'"  ["$WAY_h_REAL_OPTS"]),        
+    (WayUser_i,  Way  "i"  False "User way 'i'"  ["$WAY_i_REAL_OPTS"]),        
+    (WayUser_j,  Way  "j"  False "User way 'j'"  ["$WAY_j_REAL_OPTS"]),        
+    (WayUser_k,  Way  "k"  False "User way 'k'"  ["$WAY_k_REAL_OPTS"]),        
+    (WayUser_l,  Way  "l"  False "User way 'l'"  ["$WAY_l_REAL_OPTS"]),        
+    (WayUser_m,  Way  "m"  False "User way 'm'"  ["$WAY_m_REAL_OPTS"]),        
+    (WayUser_n,  Way  "n"  False "User way 'n'"  ["$WAY_n_REAL_OPTS"]),        
+    (WayUser_o,  Way  "o"  False "User way 'o'"  ["$WAY_o_REAL_OPTS"]),        
+    (WayUser_A,  Way  "A"  False "User way 'A'"  ["$WAY_A_REAL_OPTS"]),        
+    (WayUser_B,  Way  "B"  False "User way 'B'"  ["$WAY_B_REAL_OPTS"]) 
   ]
 
 unregFlags =