Allow flags to be marked as deprecated
[ghc-hetmet.git] / compiler / main / StaticFlags.hs
index b708ad0..534c3d2 100644 (file)
 module StaticFlags (
        parseStaticFlags,
        staticFlags,
+        initStaticOpts,
 
        -- Ways
-       WayName(..), v_Ways, v_Build_tag, v_RTS_Build_tag,
+       WayName(..), v_Ways, v_Build_tag, v_RTS_Build_tag, isRTSWay,
 
        -- Output style options
        opt_PprUserLength,
+       opt_SuppressUniques,
        opt_PprStyle_Debug,
+        opt_NoDebugOutput,
 
        -- profiling opts
        opt_AutoSccsOnAllToplevs,
@@ -27,19 +30,19 @@ module StaticFlags (
        opt_SccProfilingOn,
        opt_DoTickyProfiling,
 
+        -- Hpc opts
+       opt_Hpc,
+
        -- language opts
        opt_DictsStrict,
        opt_IrrefutableTuples,
        opt_Parallel,
-       opt_RuntimeTypes,
-       opt_Flatten,
 
        -- optimisation opts
-       opt_NoMethodSharing, 
+       opt_DsMultiTyVar,
        opt_NoStateHack,
-       opt_LiberateCaseThreshold,
+       opt_SpecInlineJoinPoints,
        opt_CprOff,
-       opt_RulesOff,
        opt_SimplNoPreInlining,
        opt_SimplExcessPrecision,
        opt_MaxWorkerArgs,
@@ -49,126 +52,172 @@ module StaticFlags (
        opt_UF_UseThreshold,
        opt_UF_FunAppDiscount,
        opt_UF_KeenessFactor,
-       opt_UF_UpdateInPlace,
        opt_UF_DearOp,
 
+       -- Optimization fuel controls
+       opt_Fuel,
+
+       -- Related to linking
+       opt_PIC,
+       opt_Static,
+
        -- misc opts
        opt_IgnoreDotGhci,
        opt_ErrorSpans,
-       opt_EmitCExternDecls,
        opt_GranMacros,
        opt_HiVersion,
        opt_HistorySize,
        opt_OmitBlackHoling,
-       opt_Static,
        opt_Unregisterised,
        opt_EmitExternalCore,
-       opt_PIC,
        v_Ld_inputs,
+       tablesNextToCode
   ) where
 
 #include "HsVersions.h"
 
-import Util            ( consIORef )
 import CmdLineParser
-import Config          ( cProjectVersionInt, cProjectPatchLevel,
-                         cGhcUnregisterised )
-import FastString      ( FastString, mkFastString )
+import Config
+import FastString
 import Util
 import Maybes          ( firstJust )
-import Panic           ( GhcException(..), ghcError )
+import Panic
 
-import EXCEPTION       ( throwDyn )
-import DATA_IOREF
-import UNSAFE_IO       ( unsafePerformIO )
-import Monad           ( when )
-import Char            ( isDigit )
-import Data.List       ( sort, intersperse, nub )
+import Control.Exception ( throwDyn )
+import Data.IORef
+import System.IO.Unsafe        ( unsafePerformIO )
+import Control.Monad   ( when )
+import Data.Char       ( isDigit )
+import Data.List
 
 -----------------------------------------------------------------------------
 -- Static flags
 
-parseStaticFlags :: [String] -> IO [String]
+parseStaticFlags :: [String] -> IO ([String], [String])
 parseStaticFlags args = do
-  (leftover, errs) <- processArgs static_flags args
+  ready <- readIORef v_opt_C_ready
+  when ready $ throwDyn (ProgramError "Too late for parseStaticFlags: call it before newSession")
+
+  (leftover, errs, warns1) <- processArgs static_flags args
   when (not (null errs)) $ throwDyn (UsageError (unlines errs))
 
     -- deal with the way flags: the way (eg. prof) gives rise to
-    -- futher flags, some of which might be static.
+    -- further flags, some of which might be static.
   way_flags <- findBuildTag
 
     -- if we're unregisterised, add some more flags
   let unreg_flags | cGhcUnregisterised == "YES" = unregFlags
                  | otherwise = []
 
-  (more_leftover, errs) <- processArgs static_flags (unreg_flags ++ way_flags)
+  (more_leftover, errs, warns2) <- processArgs static_flags (unreg_flags ++ way_flags)
+
+    -- see sanity code in staticOpts
+  writeIORef v_opt_C_ready True
+
+    -- TABLES_NEXT_TO_CODE affects the info table layout.
+    -- Be careful to do this *after* all processArgs,
+    -- because evaluating tablesNextToCode involves looking at the global
+    -- static flags.  Those pesky global variables...
+  let cg_flags | tablesNextToCode = ["-optc-DTABLES_NEXT_TO_CODE"]
+              | otherwise        = []
+
+    -- HACK: -fexcess-precision is both a static and a dynamic flag.  If
+    -- the static flag parser has slurped it, we must return it as a 
+    -- leftover too.  ToDo: make -fexcess-precision dynamic only.
+  let excess_prec | opt_SimplExcessPrecision = ["-fexcess-precision"]
+                  | otherwise                = []
+
   when (not (null errs)) $ ghcError (UsageError (unlines errs))
-  return (more_leftover++leftover)
+  return (excess_prec ++ cg_flags ++ more_leftover ++ leftover,
+          warns1 ++ warns2)
 
+initStaticOpts :: IO ()
+initStaticOpts = writeIORef v_opt_C_ready True
 
--- note that ordering is important in the following list: any flag which
+static_flags :: [Flag IO]
+-- All the static flags should appear in this list.  It describes how each
+-- static flag should be processed.  Two main purposes:
+-- (a) if a command-line flag doesn't appear in the list, GHC can complain
+-- (b) a command-line flag may remove, or add, other flags; e.g. the "-fno-X" things
+--
+-- The common (PassFlag addOpt) action puts the static flag into the bunch of
+-- things that are searched up by the top-level definitions like
+--     opt_foo = lookUp (fsLit "-dfoo")
+
+-- Note that ordering is important in the following list: any flag which
 -- is a prefix flag (i.e. HasArg, Prefix, OptPrefix, AnySuffix) will override
 -- flags further down the list with the same prefix.
 
-static_flags :: [(String, OptKind IO)]
 static_flags = [
-       ------- GHCi -------------------------------------------------------
-     ( "ignore-dot-ghci", PassFlag addOpt )
-  ,  ( "read-dot-ghci"  , NoArg (removeOpt "-ignore-dot-ghci") )
-
-       ------- ways --------------------------------------------------------
-  ,  ( "prof"          , NoArg (addWay WayProf) )
-  ,  ( "unreg"         , NoArg (addWay WayUnreg) )
-  ,  ( "ticky"         , NoArg (addWay WayTicky) )
-  ,  ( "parallel"      , NoArg (addWay WayPar) )
-  ,  ( "gransim"       , NoArg (addWay WayGran) )
-  ,  ( "smp"           , NoArg (addWay WayThreaded) ) -- backwards compat.
-  ,  ( "debug"         , NoArg (addWay WayDebug) )
-  ,  ( "ndp"           , NoArg (addWay WayNDP) )
-  ,  ( "threaded"      , NoArg (addWay WayThreaded) )
-       -- ToDo: user ways
-
-       ------ Debugging ----------------------------------------------------
-  ,  ( "dppr-noprags",     PassFlag addOpt )
-  ,  ( "dppr-debug",       PassFlag addOpt )
-  ,  ( "dppr-user-length", AnySuffix addOpt )
+        ------- GHCi -------------------------------------------------------
+    Flag "ignore-dot-ghci" (PassFlag addOpt) Supported
+  , Flag "read-dot-ghci"   (NoArg (removeOpt "-ignore-dot-ghci")) Supported
+
+        ------- ways --------------------------------------------------------
+  , Flag "prof"           (NoArg (addWay WayProf)) Supported
+  , Flag "ticky"          (NoArg (addWay WayTicky)) Supported
+  , Flag "parallel"       (NoArg (addWay WayPar)) Supported
+  , Flag "gransim"        (NoArg (addWay WayGran)) Supported
+  , Flag "smp"            (NoArg (addWay WayThreaded))
+         (Deprecated "Use -threaded instead")
+  , Flag "debug"          (NoArg (addWay WayDebug)) Supported
+  , Flag "ndp"            (NoArg (addWay WayNDP)) Supported
+  , Flag "threaded"       (NoArg (addWay WayThreaded)) Supported
+        -- ToDo: user ways
+
+        ------ Debugging ----------------------------------------------------
+  , Flag "dppr-debug"        (PassFlag addOpt) Supported
+  , Flag "dsuppress-uniques" (PassFlag addOpt) Supported
+  , Flag "dppr-user-length"  (AnySuffix addOpt) Supported
+  , Flag "dopt-fuel"         (AnySuffix addOpt) Supported
+  , Flag "dno-debug-output"  (PassFlag addOpt) Supported
       -- rest of the debugging flags are dynamic
 
-       --------- Profiling --------------------------------------------------
-  ,  ( "auto-all"      , NoArg (addOpt "-fauto-sccs-on-all-toplevs") )
-  ,  ( "auto"          , NoArg (addOpt "-fauto-sccs-on-exported-toplevs") )
-  ,  ( "caf-all"       , NoArg (addOpt "-fauto-sccs-on-individual-cafs") )
+        --------- Profiling --------------------------------------------------
+  , Flag "auto-all"       (NoArg (addOpt "-fauto-sccs-on-all-toplevs"))
+         Supported
+  , Flag "auto"           (NoArg (addOpt "-fauto-sccs-on-exported-toplevs"))
+         Supported
+  , Flag "caf-all"        (NoArg (addOpt "-fauto-sccs-on-individual-cafs"))
+         Supported
          -- "ignore-sccs"  doesn't work  (ToDo)
 
-  ,  ( "no-auto-all"   , NoArg (removeOpt "-fauto-sccs-on-all-toplevs") )
-  ,  ( "no-auto"       , NoArg (removeOpt "-fauto-sccs-on-exported-toplevs") )
-  ,  ( "no-caf-all"    , NoArg (removeOpt "-fauto-sccs-on-individual-cafs") )
+  , Flag "no-auto-all"    (NoArg (removeOpt "-fauto-sccs-on-all-toplevs"))
+         Supported
+  , Flag "no-auto"        (NoArg (removeOpt "-fauto-sccs-on-exported-toplevs"))
+         Supported
+  , Flag "no-caf-all"     (NoArg (removeOpt "-fauto-sccs-on-individual-cafs"))
+         Supported
 
-       ------- Miscellaneous -----------------------------------------------
-  ,  ( "no-link-chk"    , NoArg (return ()) ) -- ignored for backwards compat
+        ----- Linker --------------------------------------------------------
+  , Flag "static"         (PassFlag addOpt) Supported
+  , Flag "dynamic"        (NoArg (removeOpt "-static")) Supported
+    -- ignored for compat w/ gcc:
+  , Flag "rdynamic"       (NoArg (return ())) Supported
 
-       ----- Linker --------------------------------------------------------
-  ,  ( "static"        , PassFlag addOpt )
-  ,  ( "dynamic"        , NoArg (removeOpt "-static") )
-  ,  ( "rdynamic"       , NoArg (return ()) ) -- ignored for compat w/ gcc
-
-       ----- RTS opts ------------------------------------------------------
-  ,  ( "H"                 , HasArg (setHeapSize . fromIntegral . decodeSize) )
-  ,  ( "Rghc-timing"      , NoArg  (enableTimingStats) )
+        ----- RTS opts ------------------------------------------------------
+  , Flag "H"              (HasArg (setHeapSize . fromIntegral . decodeSize))
+         Supported
+  , Flag "Rghc-timing"    (NoArg  (enableTimingStats)) Supported
 
         ------ Compiler flags -----------------------------------------------
-       -- All other "-fno-<blah>" options cancel out "-f<blah>" on the hsc cmdline
-  ,  ( "fno-",                 PrefixPred (\s -> isStaticFlag ("f"++s))
-                                   (\s -> removeOpt ("-f"++s)) )
-
-       -- Pass all remaining "-f<blah>" options to hsc
-  ,  ( "f",                    AnySuffixPred (isStaticFlag) addOpt )
+        -- All other "-fno-<blah>" options cancel out "-f<blah>" on the hsc cmdline
+  , Flag "fno-"
+         (PrefixPred (\s -> isStaticFlag ("f"++s)) (\s -> removeOpt ("-f"++s)))
+         Supported
+
+        -- Pass all remaining "-f<blah>" options to hsc
+  , Flag "f"                      (AnySuffixPred (isStaticFlag) addOpt)
+         Supported
   ]
 
+addOpt :: String -> IO ()
 addOpt = consIORef v_opt_C
 
+addWay :: WayName -> IO ()
 addWay = consIORef v_Ways
 
+removeOpt :: String -> IO ()
 removeOpt f = do
   fs <- readIORef v_opt_C
   writeIORef v_opt_C $! filter (/= f) fs    
@@ -181,11 +230,20 @@ lookup_str       :: String -> Maybe String
 -- holds the static opts while they're being collected, before
 -- being unsafely read by unpacked_static_opts below.
 GLOBAL_VAR(v_opt_C, defaultStaticOpts, [String])
-staticFlags = unsafePerformIO (readIORef v_opt_C)
+GLOBAL_VAR(v_opt_C_ready, False, Bool)
+
+staticFlags :: [String]
+staticFlags = unsafePerformIO $ do
+  ready <- readIORef v_opt_C_ready
+  if (not ready)
+        then panic "Static flags have not been initialised!\n        Please call GHC.newSession or GHC.parseStaticFlags early enough."
+        else readIORef v_opt_C
 
 -- -static is the default
+defaultStaticOpts :: [String]
 defaultStaticOpts = ["-static"]
 
+packed_static_opts :: [FastString]
 packed_static_opts   = map mkFastString staticFlags
 
 lookUp     sw = sw `elem` packed_static_opts
@@ -234,105 +292,156 @@ unpacked_opts =
    expandAts l = [l]
 -}
 
-
-opt_IgnoreDotGhci              = lookUp FSLIT("-ignore-dot-ghci")
+opt_IgnoreDotGhci :: Bool
+opt_IgnoreDotGhci              = lookUp (fsLit "-ignore-dot-ghci")
 
 -- debugging opts
-opt_PprStyle_Debug             = lookUp  FSLIT("-dppr-debug")
+opt_SuppressUniques :: Bool
+opt_SuppressUniques            = lookUp  (fsLit "-dsuppress-uniques")
+opt_PprStyle_Debug  :: Bool
+opt_PprStyle_Debug             = lookUp  (fsLit "-dppr-debug")
+opt_PprUserLength   :: Int
 opt_PprUserLength              = lookup_def_int "-dppr-user-length" 5 --ToDo: give this a name
+opt_Fuel            :: Int
+opt_Fuel                        = lookup_def_int "-dopt-fuel" maxBound
+opt_NoDebugOutput   :: Bool
+opt_NoDebugOutput               = lookUp  (fsLit "-dno-debug-output")
+
 
 -- profiling opts
-opt_AutoSccsOnAllToplevs       = lookUp  FSLIT("-fauto-sccs-on-all-toplevs")
-opt_AutoSccsOnExportedToplevs  = lookUp  FSLIT("-fauto-sccs-on-exported-toplevs")
-opt_AutoSccsOnIndividualCafs   = lookUp  FSLIT("-fauto-sccs-on-individual-cafs")
-opt_SccProfilingOn             = lookUp  FSLIT("-fscc-profiling")
-opt_DoTickyProfiling           = lookUp  FSLIT("-fticky-ticky")
+opt_AutoSccsOnAllToplevs :: Bool
+opt_AutoSccsOnAllToplevs       = lookUp  (fsLit "-fauto-sccs-on-all-toplevs")
+opt_AutoSccsOnExportedToplevs :: Bool
+opt_AutoSccsOnExportedToplevs  = lookUp  (fsLit "-fauto-sccs-on-exported-toplevs")
+opt_AutoSccsOnIndividualCafs :: Bool
+opt_AutoSccsOnIndividualCafs   = lookUp  (fsLit "-fauto-sccs-on-individual-cafs")
+opt_SccProfilingOn :: Bool
+opt_SccProfilingOn             = lookUp  (fsLit "-fscc-profiling")
+opt_DoTickyProfiling :: Bool
+opt_DoTickyProfiling            = WayTicky `elem` (unsafePerformIO $ readIORef v_Ways)
+
+-- Hpc opts
+opt_Hpc :: Bool
+opt_Hpc                                = lookUp (fsLit "-fhpc")  
 
 -- language opts
-opt_DictsStrict                        = lookUp  FSLIT("-fdicts-strict")
-opt_IrrefutableTuples          = lookUp  FSLIT("-firrefutable-tuples")
-opt_Parallel                   = lookUp  FSLIT("-fparallel")
-opt_Flatten                    = lookUp  FSLIT("-fflatten")
+opt_DictsStrict :: Bool
+opt_DictsStrict                        = lookUp  (fsLit "-fdicts-strict")
+opt_IrrefutableTuples :: Bool
+opt_IrrefutableTuples          = lookUp  (fsLit "-firrefutable-tuples")
+opt_Parallel :: Bool
+opt_Parallel                   = lookUp  (fsLit "-fparallel")
 
 -- optimisation opts
-opt_NoStateHack                        = lookUp  FSLIT("-fno-state-hack")
-opt_NoMethodSharing            = lookUp  FSLIT("-fno-method-sharing")
-opt_CprOff                     = lookUp  FSLIT("-fcpr-off")
-opt_RulesOff                   = lookUp  FSLIT("-frules-off")
+opt_DsMultiTyVar :: Bool
+opt_DsMultiTyVar               = not (lookUp (fsLit "-fno-ds-multi-tyvar"))
+       -- On by default
+
+opt_SpecInlineJoinPoints :: Bool
+opt_SpecInlineJoinPoints       = lookUp  (fsLit "-fspec-inline-join-points")
+
+opt_NoStateHack :: Bool
+opt_NoStateHack                        = lookUp  (fsLit "-fno-state-hack")
+opt_CprOff :: Bool
+opt_CprOff                     = lookUp  (fsLit "-fcpr-off")
        -- Switch off CPR analysis in the new demand analyser
-opt_LiberateCaseThreshold      = lookup_def_int "-fliberate-case-threshold" (10::Int)
+opt_MaxWorkerArgs :: Int
 opt_MaxWorkerArgs              = lookup_def_int "-fmax-worker-args" (10::Int)
 
-opt_EmitCExternDecls           = lookUp  FSLIT("-femit-extern-decls")
-opt_GranMacros                 = lookUp  FSLIT("-fgransim")
-opt_HiVersion                  = read (cProjectVersionInt ++ cProjectPatchLevel) :: Int
+opt_GranMacros :: Bool
+opt_GranMacros                 = lookUp  (fsLit "-fgransim")
+opt_HiVersion :: Integer
+opt_HiVersion                  = read (cProjectVersionInt ++ cProjectPatchLevel) :: Integer
+opt_HistorySize :: Int
 opt_HistorySize                        = lookup_def_int "-fhistory-size" 20
-opt_OmitBlackHoling            = lookUp  FSLIT("-dno-black-holing")
-opt_RuntimeTypes               = lookUp  FSLIT("-fruntime-types")
+opt_OmitBlackHoling :: Bool
+opt_OmitBlackHoling            = lookUp  (fsLit "-dno-black-holing")
 
 -- Simplifier switches
-opt_SimplNoPreInlining         = lookUp  FSLIT("-fno-pre-inlining")
+opt_SimplNoPreInlining :: Bool
+opt_SimplNoPreInlining         = lookUp  (fsLit "-fno-pre-inlining")
        -- NoPreInlining is there just to see how bad things
        -- get if you don't do it!
-opt_SimplExcessPrecision       = lookUp  FSLIT("-fexcess-precision")
+opt_SimplExcessPrecision :: Bool
+opt_SimplExcessPrecision       = lookUp  (fsLit "-fexcess-precision")
 
 -- Unfolding control
+opt_UF_CreationThreshold :: Int
 opt_UF_CreationThreshold       = lookup_def_int "-funfolding-creation-threshold"  (45::Int)
+opt_UF_UseThreshold :: Int
 opt_UF_UseThreshold            = lookup_def_int "-funfolding-use-threshold"       (8::Int)     -- Discounts can be big
+opt_UF_FunAppDiscount :: Int
 opt_UF_FunAppDiscount          = lookup_def_int "-funfolding-fun-discount"        (6::Int)     -- It's great to inline a fn
+opt_UF_KeenessFactor :: Float
 opt_UF_KeenessFactor           = lookup_def_float "-funfolding-keeness-factor"    (1.5::Float)
-opt_UF_UpdateInPlace           = lookUp  FSLIT("-funfolding-update-in-place")
 
+opt_UF_DearOp :: Int
 opt_UF_DearOp   = ( 4 :: Int)
-                       
-opt_Static                     = lookUp  FSLIT("-static")
-opt_Unregisterised             = lookUp  FSLIT("-funregisterised")
-opt_EmitExternalCore           = lookUp  FSLIT("-fext-core")
+
+
+-- Related to linking
+opt_PIC :: Bool
+#if darwin_TARGET_OS && x86_64_TARGET_ARCH
+opt_PIC                         = True
+#else
+opt_PIC                         = lookUp (fsLit "-fPIC")
+#endif
+opt_Static :: Bool
+opt_Static                     = lookUp  (fsLit "-static")
+opt_Unregisterised :: Bool
+opt_Unregisterised             = lookUp  (fsLit "-funregisterised")
+
+-- Derived, not a real option.  Determines whether we will be compiling
+-- info tables that reside just before the entry code, or with an
+-- indirection to the entry code.  See TABLES_NEXT_TO_CODE in 
+-- includes/InfoTables.h.
+tablesNextToCode :: Bool
+tablesNextToCode               = not opt_Unregisterised
+                                 && cGhcEnableTablesNextToCode == "YES"
+
+opt_EmitExternalCore :: Bool
+opt_EmitExternalCore           = lookUp  (fsLit "-fext-core")
 
 -- Include full span info in error messages, instead of just the start position.
-opt_ErrorSpans                 = lookUp FSLIT("-ferror-spans")
+opt_ErrorSpans :: Bool
+opt_ErrorSpans                 = lookUp (fsLit "-ferror-spans")
 
-opt_PIC                         = lookUp FSLIT("-fPIC")
 
 -- object files and libraries to be linked in are collected here.
 -- ToDo: perhaps this could be done without a global, it wasn't obvious
 -- how to do it though --SDM.
 GLOBAL_VAR(v_Ld_inputs,        [],      [String])
 
+isStaticFlag :: String -> Bool
 isStaticFlag f =
   f `elem` [
        "fauto-sccs-on-all-toplevs",
        "fauto-sccs-on-exported-toplevs",
        "fauto-sccs-on-individual-cafs",
        "fscc-profiling",
-       "fticky-ticky",
-       "fall-strict",
        "fdicts-strict",
+       "fspec-inline-join-points",
        "firrefutable-tuples",
        "fparallel",
-       "fflatten",
-       "fsemi-tagging",
-       "flet-no-escape",
-       "femit-extern-decls",
        "fgransim",
        "fno-hi-version-check",
        "dno-black-holing",
        "fno-method-sharing",
        "fno-state-hack",
+       "fno-ds-multi-tyvar",
        "fruntime-types",
        "fno-pre-inlining",
        "fexcess-precision",
-       "funfolding-update-in-place",
        "static",
+       "fhardwire-lib-paths",
        "funregisterised",
        "fext-core",
-       "frule-check",
-       "frules-off",
        "fcpr-off",
        "ferror-spans",
-       "fPIC"
+       "fPIC",
+       "fhpc"
        ]
-  || any (flip prefixMatch f) [
+  || any (`isPrefixOf` f) [
        "fliberate-case-threshold",
        "fmax-worker-args",
        "fhistory-size",
@@ -366,20 +475,15 @@ decodeSize str
   | c == "G" || c == "g" = truncate (n * 1000 * 1000 * 1000)
   | otherwise            = throwDyn (CmdLineError ("can't decode size: " ++ str))
   where (m, c) = span pred str
-        n      = read m  :: Double
+        n      = readRational m
        pred c = isDigit c || c == '.'
 
 
 -----------------------------------------------------------------------------
 -- RTS Hooks
 
-#if __GLASGOW_HASKELL__ >= 504
 foreign import ccall unsafe "setHeapSize"       setHeapSize       :: Int -> IO ()
 foreign import ccall unsafe "enableTimingStats" enableTimingStats :: IO ()
-#else
-foreign import "setHeapSize"       unsafe setHeapSize       :: Int -> IO ()
-foreign import "enableTimingStats" unsafe enableTimingStats :: IO ()
-#endif
 
 -----------------------------------------------------------------------------
 -- Ways
@@ -407,7 +511,6 @@ data WayName
   = WayThreaded
   | WayDebug
   | WayProf
-  | WayUnreg
   | WayTicky
   | WayPar
   | WayGran
@@ -433,6 +536,7 @@ data WayName
 
 GLOBAL_VAR(v_Ways, [] ,[WayName])
 
+allowed_combination :: [WayName] -> Bool
 allowed_combination way = and [ x `allowedWith` y 
                              | x <- way, y <- way, x < y ]
   where
@@ -444,8 +548,8 @@ allowed_combination way = and [ x `allowedWith` y
        _ `allowedWith` WayDebug                = True
        WayDebug `allowedWith` _                = True
 
-       WayProf `allowedWith` WayUnreg          = True
        WayProf `allowedWith` WayNDP            = True
+       WayThreaded `allowedWith` WayProf       = True
        _ `allowedWith` _                       = False
 
 
@@ -453,6 +557,7 @@ findBuildTag :: IO [String]  -- new options
 findBuildTag = do
   way_names <- readIORef v_Ways
   let ws = sort (nub way_names)
+
   if not (allowed_combination ws)
       then throwDyn (CmdLineError $
                    "combination not supported: "  ++
@@ -467,14 +572,20 @@ findBuildTag = do
           writeIORef v_RTS_Build_tag rts_tag
           return (concat flags)
 
+
+
 mkBuildTag :: [Way] -> String
 mkBuildTag ways = concat (intersperse "_" (map wayTag ways))
 
+lkupWay :: WayName -> Way
 lkupWay w = 
    case lookup w way_details of
        Nothing -> error "findBuildTag"
        Just details -> details
 
+isRTSWay :: WayName -> Bool
+isRTSWay = wayRTSOnly . lkupWay 
+
 data Way = Way {
   wayTag     :: String,
   wayRTSOnly :: Bool,
@@ -505,14 +616,10 @@ way_details =
        , "-DPROFILING"
        , "-optc-DPROFILING" ]),
 
-    (WayTicky, Way  "t" False "Ticky-ticky Profiling"  
-       [ "-fticky-ticky"
-       , "-DTICKY_TICKY"
+    (WayTicky, Way  "t" True "Ticky-ticky Profiling"  
+       [ "-DTICKY_TICKY"
        , "-optc-DTICKY_TICKY" ]),
 
-    (WayUnreg, Way  "u" False "Unregisterised" 
-       unregFlags ),
-
     -- optl's below to tell linker where to find the PVM library -- HWL
     (WayPar, Way  "mp" False "Parallel" 
        [ "-fparallel"
@@ -556,7 +663,7 @@ way_details =
 
     (WayNDP, Way  "ndp" False "Nested data parallelism"
        [ "-fparr"
-       , "-fflatten"]),
+       , "-fvectorise"]),
 
     (WayUser_a,  Way  "a"  False "User way 'a'"  ["$WAY_a_REAL_OPTS"]),        
     (WayUser_b,  Way  "b"  False "User way 'b'"  ["$WAY_b_REAL_OPTS"]),        
@@ -577,6 +684,7 @@ way_details =
     (WayUser_B,  Way  "B"  False "User way 'B'"  ["$WAY_B_REAL_OPTS"]) 
   ]
 
+unregFlags :: [String]
 unregFlags = 
    [ "-optc-DNO_REGS"
    , "-optc-DUSE_MINIINTERPRETER"