[project @ 2004-11-26 16:19:45 by simonmar]
[ghc-hetmet.git] / ghc / compiler / main / DriverState.hs
index 21cb1bc..23c7cbb 100644 (file)
@@ -1,29 +1,31 @@
 -----------------------------------------------------------------------------
--- $Id: DriverState.hs,v 1.45 2001/06/15 08:29:58 simonpj Exp $
 --
 -- Settings for the driver
 --
--- (c) The University of Glasgow 2000
+-- (c) The University of Glasgow 2002
 --
 -----------------------------------------------------------------------------
 
 module DriverState where
 
-#include "../includes/config.h"
+#include "../includes/ghcconfig.h"
 #include "HsVersions.h"
 
-import Packages                ( PackageConfig(..) )
 import CmdLineOpts
+import DriverPhases
 import DriverUtil
 import Util
 import Config
-import Exception
-import IOExts
 import Panic
 
+import DATA_IOREF      ( IORef, readIORef, writeIORef )
+import EXCEPTION
+
 import List
 import Char  
 import Monad
+import Maybe           ( fromJust, isJust )
+import Directory       ( doesDirectoryExist )
 
 -----------------------------------------------------------------------------
 -- non-configured things
@@ -31,16 +33,47 @@ import Monad
 cHaskell1Version = "5" -- i.e., Haskell 98
 
 -----------------------------------------------------------------------------
+-- GHC modes of operation
+
+data GhcMode
+  = DoMkDependHS                       -- ghc -M
+  | DoMkDLL                            -- ghc --mk-dll
+  | StopBefore Phase                   -- ghc -E | -C | -S | -c
+  | DoMake                             -- ghc --make
+  | DoInteractive                      -- ghc --interactive
+  | DoLink                             -- [ the default ]
+  | DoEval String                      -- ghc -e
+  deriving (Eq,Show)
+
+GLOBAL_VAR(v_GhcMode,     DoLink, GhcMode)
+GLOBAL_VAR(v_GhcModeFlag, "",     String)
+
+setMode :: GhcMode -> String -> IO ()
+setMode m flag = do
+  old_mode <- readIORef v_GhcMode
+  old_flag <- readIORef v_GhcModeFlag
+  when (notNull old_flag && flag /= old_flag) $
+      throwDyn (UsageError 
+          ("cannot use `" ++ old_flag ++ "' with `" ++ flag ++ "'"))
+  writeIORef v_GhcMode m
+  writeIORef v_GhcModeFlag flag
+
+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
 GLOBAL_VAR(v_Keep_hi_diffs,            False,          Bool)
@@ -48,15 +81,26 @@ GLOBAL_VAR(v_Keep_hc_files,         False,          Bool)
 GLOBAL_VAR(v_Keep_s_files,             False,          Bool)
 GLOBAL_VAR(v_Keep_raw_s_files,         False,          Bool)
 GLOBAL_VAR(v_Keep_tmp_files,           False,          Bool)
+#ifdef ILX
+GLOBAL_VAR(v_Keep_il_files,            False,          Bool)
+GLOBAL_VAR(v_Keep_ilx_files,           False,          Bool)
+#endif
 
 -- Misc
 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_MainModIs,                        Nothing,        Maybe String)
+GLOBAL_VAR(v_MainFunIs,                        Nothing,        Maybe String)
 GLOBAL_VAR(v_Recomp,                   True,           Bool)
 GLOBAL_VAR(v_Collect_ghc_timing,       False,          Bool)
 GLOBAL_VAR(v_Do_asm_mangling,          True,           Bool)
 GLOBAL_VAR(v_Excess_precision,         False,          Bool)
+GLOBAL_VAR(v_Read_DotGHCi,             True,           Bool)
+
+-- Preprocessor flags
+GLOBAL_VAR(v_Hs_source_pp_opts, [], [String])
 
 -----------------------------------------------------------------------------
 -- Splitting object files (for libraries)
@@ -79,17 +123,41 @@ can_split =  prefixMatch "i386"    cTARGETPLATFORM
 -----------------------------------------------------------------------------
 -- Compiler output options
 
-defaultHscLang
-  | cGhcWithNativeCodeGen == "YES" && 
-       (prefixMatch "i386" cTARGETPLATFORM ||
-        prefixMatch "sparc" cTARGETPLATFORM)   =  HscAsm
-  | otherwise                                  =  HscC
-
 GLOBAL_VAR(v_Output_dir,  Nothing, Maybe String)
 GLOBAL_VAR(v_Output_file, Nothing, Maybe String)
 GLOBAL_VAR(v_Output_hi,   Nothing, Maybe String)
 
-GLOBAL_VAR(v_Object_suf,  Nothing, Maybe String)
+-- called to verify that the output files & directories
+-- point somewhere valid. 
+--
+-- The assumption is that the directory portion of these output
+-- options will have to exist by the time 'verifyOutputFiles'
+-- is invoked.
+-- 
+verifyOutputFiles :: IO ()
+verifyOutputFiles = do
+  odir <- readIORef v_Output_dir
+  when (isJust odir) $ do
+     let dir = fromJust odir
+     flg <- doesDirectoryExist dir
+     when (not flg) (nonExistentDir "-odir" dir)
+  ofile <- readIORef v_Output_file
+  when (isJust ofile) $ do
+     let fn = fromJust ofile
+     flg <- doesDirNameExist fn
+     when (not flg) (nonExistentDir "-o" fn)
+  ohi <- readIORef v_Output_hi
+  when (isJust ohi) $ do
+     let hi = fromJust ohi
+     flg <- doesDirNameExist hi
+     when (not flg) (nonExistentDir "-ohi" hi)
+ where
+   nonExistentDir flg dir = 
+     throwDyn (CmdLineError ("error: directory portion of " ++ 
+                             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_Hi_dir,      Nothing, Maybe String)
 GLOBAL_VAR(v_Hi_suf,      "hi",           String)
@@ -101,188 +169,14 @@ odir_ify f = do
   odir_opt <- readIORef v_Output_dir
   case odir_opt of
        Nothing -> return f
-       Just d  -> return (newdir d f)
+       Just d  -> return (replaceFilenameDirectory f d)
 
 osuf_ify :: String -> IO String
 osuf_ify f = do
-  osuf_opt <- readIORef v_Object_suf
-  case osuf_opt of
-       Nothing -> return f
-       Just s  -> return (newsuf s f)
-
------------------------------------------------------------------------------
--- Compiler optimisation options
+  osuf <- readIORef v_Object_suf
+  return (replaceFilenameSuffix f osuf)
 
-GLOBAL_VAR(v_OptLevel, 0, Int)
-
-setOptLevel :: String -> IO ()
-setOptLevel ""             = do { writeIORef v_OptLevel 1 }
-setOptLevel "not"          = writeIORef v_OptLevel 0
-setOptLevel [c] | isDigit c = do
-   let level = ord c - ord '0'
-   writeIORef v_OptLevel level
-setOptLevel s = unknownFlagErr ("-O"++s)
-
-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_CPR,                      True,  Bool)
-GLOBAL_VAR(v_CSE,                      True,  Bool)
-
--- 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
-   cpr        <- readIORef v_CPR
-   cse        <- readIORef v_CSE
-
-   if opt_level == 0 then return
-      [
-       CoreDoSimplify (isAmongSimpl [
-           MaxSimplifierIterations max_iter
-       ])
-      ]
-
-    else {- opt_level >= 1 -} return [ 
-
-       -- initial simplify: mk specialiser happy: minimum effort please
-       CoreDoSimplify (isAmongSimpl [
-           SimplInlinePhase 0,
-                       -- 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
-           DontApplyRules,
-                       -- 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 False{-not full-},
-       CoreDoFloatInwards,
-
-       CoreDoSimplify (isAmongSimpl [
-          SimplInlinePhase 1,
-               -- Want to run with inline phase 1 after the specialiser to give
-               -- maximum chance for fusion to work before we inline build/augment
-               -- in phase 2.  This made a difference in 'ansi' where an 
-               -- overloaded function wasn't inlined till too late.
-          MaxSimplifierIterations max_iter
-       ]),
-
-       -- 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 (isAmongSimpl [
-               -- 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
-          SimplInlinePhase 2,
-          MaxSimplifierIterations max_iter
-       ]),
-
-       CoreDoSimplify (isAmongSimpl [
-          MaxSimplifierIterations 2
-               -- No -finline-phase: allow all Ids to be inlined now
-               -- This gets foldr inlined before strictness analysis
-       ]),
-
-       if strictness then CoreDoStrictness else CoreDoNothing,
-       if cpr        then CoreDoCPResult   else CoreDoNothing,
-       CoreDoWorkerWrapper,
-       CoreDoGlomBinds,
-
-       CoreDoSimplify (isAmongSimpl [
-          MaxSimplifierIterations max_iter
-               -- No -finline-phase: allow all Ids to be inlined now
-       ]),
-
-       CoreDoFloatOutwards False{-not full-},
-               -- 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)
-
-
--- Leave out lambda lifting for now
---       "-fsimplify", -- Tidy up results of full laziness
---         "[", 
---               "-fmax-simplifier-iterations2",
---         "]",
---       "-ffloat-outwards-full",      
-
-       -- 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.
-
-       if opt_level >= 2 then
-          CoreLiberateCase
-       else
-          CoreDoNothing,
-       if opt_level >= 2 then
-          CoreDoSpecConstr
-       else
-          CoreDoNothing,
-
-       -- Final clean-up simplification:
-       CoreDoSimplify (isAmongSimpl [
-         MaxSimplifierIterations max_iter
-               -- No -finline-phase: allow all Ids to be inlined now
-       ])
-     ]
 
 buildStgToDo :: IO [ StgToDo ]
 buildStgToDo = do
@@ -302,100 +196,84 @@ 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])
 
-GLOBAL_VAR(v_Cmdline_libraries,   [], [String])
+#ifdef darwin_TARGET_OS
+GLOBAL_VAR(v_Framework_paths, [], [String])
+GLOBAL_VAR(v_Cmdline_frameworks, [], [String])
+#endif
+
+addToOrDeleteDirList :: IORef [String] -> String -> IO ()
+addToOrDeleteDirList ref ""   = writeIORef ref []
+addToOrDeleteDirList ref path = addToDirList ref path
 
 addToDirList :: IORef [String] -> String -> IO ()
 addToDirList ref path
-  = do paths <- readIORef ref
-       writeIORef ref (paths ++ split split_marker path)
-
-GLOBAL_VAR(v_HCHeader, "", String)
-
------------------------------------------------------------------------------
--- Packages
-
--- package list is maintained in dependency order
-GLOBAL_VAR(v_Packages, ("std":"rts":"gmp":[]), [String])
-
-addPackage :: String -> IO ()
-addPackage package
-  = do pkg_details <- readIORef v_Package_details
-       case lookupPkg package pkg_details of
-         Nothing -> throwDyn (CmdLineError ("unknown package name: " ++ package))
-         Just details -> do
-           ps <- readIORef v_Packages
-           unless (package `elem` ps) $ do
-               mapM_ addPackage (package_deps details)
-               ps <- readIORef v_Packages
-               writeIORef v_Packages (package:ps)
-
-getPackageImportPath   :: IO [String]
-getPackageImportPath = do
-  ps <- getPackageInfo
-  return (nub (filter (not.null) (concatMap import_dirs ps)))
-
-getPackageIncludePath   :: IO [String]
-getPackageIncludePath = do
-  ps <- getPackageInfo
-  return (nub (filter (not.null) (concatMap include_dirs ps)))
-
-       -- includes are in reverse dependency order (i.e. rts first)
-getPackageCIncludes   :: IO [String]
-getPackageCIncludes = do
-  ps <- getPackageInfo
-  return (reverse (nub (filter (not.null) (concatMap c_includes ps))))
-
-getPackageLibraryPath  :: IO [String]
-getPackageLibraryPath = do
-  ps <- getPackageInfo
-  return (nub (filter (not.null) (concatMap library_dirs ps)))
-
-getPackageLibraries    :: IO [String]
-getPackageLibraries = do
-  ps <- getPackageInfo
-  tag <- readIORef v_Build_tag
-  let suffix = if null tag then "" else '_':tag
-  return (concat (
-       map (\p -> map (++suffix) (hs_libraries p) ++ extra_libraries p) ps
-     ))
-
-getPackageExtraGhcOpts :: IO [String]
-getPackageExtraGhcOpts = do
-  ps <- getPackageInfo
-  return (concatMap extra_ghc_opts ps)
-
-getPackageExtraCcOpts  :: IO [String]
-getPackageExtraCcOpts = do
-  ps <- getPackageInfo
-  return (concatMap extra_cc_opts ps)
-
-getPackageExtraLdOpts  :: IO [String]
-getPackageExtraLdOpts = do
-  ps <- getPackageInfo
-  return (concatMap extra_ld_opts ps)
-
-getPackageInfo :: IO [PackageConfig]
-getPackageInfo = do
-  ps <- readIORef v_Packages
-  getPackageDetails ps
-
-getPackageDetails :: [String] -> IO [PackageConfig]
-getPackageDetails ps = do
-  pkg_details <- readIORef v_Package_details
-  return [ pkg | p <- ps, Just pkg <- [ lookupPkg p pkg_details ] ]
-
-GLOBAL_VAR(v_Package_details, (error "package_details"), [PackageConfig])
-
-lookupPkg :: String -> [PackageConfig] -> Maybe PackageConfig
-lookupPkg nm ps
-   = case [p | p <- ps, name p == nm] of
-        []    -> Nothing
-        (p:_) -> Just p
+  = do paths           <- readIORef ref
+       shiny_new_ones  <- splitUp path
+       writeIORef ref (paths ++ filter notNull shiny_new_ones)
+               -- 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.
+     -- 
+     -- That is, if "foo:bar:baz" is used, this interpreted as
+     -- consisting of three entries, 'foo', 'bar', 'baz'.
+     -- However, with "c:/foo:c:\\foo;x:/bar", this is interpreted
+     -- as four elts, "c:/foo", "c:\\foo", "x", and "/bar" --
+     -- *provided* c:/foo exists and x:/bar doesn't.
+     --
+     -- Notice that no attempt is made to fully replace the 'standard'
+     -- split marker ':' with the Windows / DOS one, ';'. The reason being
+     -- that this will cause too much breakage for users & ':' will
+     -- work fine even with DOS paths, if you're not insisting on being silly.
+     -- So, use either.
+    splitUp []         = return []
+    splitUp (x:':':div:xs) 
+      | div `elem` dir_markers = do
+          let (p,rs) = findNextPath xs
+          ps  <- splitUp rs
+           {-
+             Consult the file system to check the interpretation
+             of (x:':':div:p) -- this is arguably excessive, we
+             could skip this test & just say that it is a valid
+             dir path.
+           -}
+          flg <- doesDirectoryExist (x:':':div:p)
+          if flg then
+             return ((x:':':div:p):ps)
+           else
+             return ([x]:(div:p):ps)
+    splitUp xs = do
+      let (p,rs) = findNextPath xs
+      ps <- splitUp rs
+      return (cons p ps)
+    
+    cons "" xs = xs
+    cons x  xs = x:xs
+
+    -- will be called either when we've consumed nought or the "<Drive>:/" part of
+    -- a DOS path, so splitting is just a Q of finding the next split marker.
+    findNextPath xs = 
+        case break (`elem` split_markers) xs of
+          (p, d:ds) -> (p, ds)
+          (p, xs)   -> (p, xs)
+
+    split_markers :: [Char]
+    split_markers = [':', ';']
+
+    dir_markers :: [Char]
+    dir_markers = ['/', '\\']
+
+#else
+    splitUp xs = return (split split_marker xs)
+#endif
 
 -----------------------------------------------------------------------------
 -- Ways
@@ -415,14 +293,20 @@ lookupPkg nm ps
 
 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
-  | WayDebug
+  | WayNDP
   | WayUser_a
   | WayUser_b
   | WayUser_c
@@ -444,33 +328,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] ]
+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
@@ -478,30 +373,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"
@@ -513,7 +418,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"
@@ -525,7 +430,7 @@ way_details =
         , "-optl-lgpvm3"
        , "-fvia-C" ]),
 
-    (WayPar, Way  "md" "Distributed" 
+    (WayPar, Way  "md" False "Distributed" 
        [ "-fparallel"
        , "-D__PARALLEL_HASKELL__"
        , "-D__DISTRIBUTED_HASKELL__"
@@ -538,37 +443,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" ]),
 
-    (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"]) 
+    (WayNDP, Way  "ndp" False "Nested data parallelism"
+       [ "-fparr"
+       , "-fflatten"]),
+
+    (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 = 
@@ -579,7 +490,7 @@ unregFlags =
    , "-fvia-C" ]
 
 -----------------------------------------------------------------------------
--- Programs for particular phases
+-- Options for particular phases
 
 GLOBAL_VAR(v_Opt_dep,    [], [String])
 GLOBAL_VAR(v_Anti_opt_C, [], [String])