Enable shared libs on OpenBSD
[ghc-hetmet.git] / compiler / main / StaticFlags.hs
index f9312a2..52a8694 100644 (file)
@@ -1,3 +1,6 @@
+{-# OPTIONS -fno-cse #-}
+-- -fno-cse is needed for GLOBAL_VAR's to behave properly
+
 -----------------------------------------------------------------------------
 --
 -- Static flags
 -----------------------------------------------------------------------------
 
 module StaticFlags (
-       parseStaticFlags,
        staticFlags,
         initStaticOpts,
 
        -- Ways
-       WayName(..), v_Ways, v_Build_tag, v_RTS_Build_tag, isRTSWay,
+       WayName(..), Way(..), v_Ways, isRTSWay, mkBuildTag,
 
        -- Output style options
        opt_PprUserLength,
-       opt_PprStyle_Debug,
+       opt_SuppressUniques,
+        opt_SuppressCoercions,
+       opt_SuppressModulePrefixes,
+       opt_PprStyle_Debug, opt_TraceLevel,
+        opt_NoDebugOutput,
 
        -- profiling opts
-       opt_AutoSccsOnAllToplevs,
-       opt_AutoSccsOnExportedToplevs,
-       opt_AutoSccsOnIndividualCafs,
        opt_SccProfilingOn,
-       opt_DoTickyProfiling,
 
         -- Hpc opts
        opt_Hpc,
@@ -35,12 +37,11 @@ module StaticFlags (
        opt_DictsStrict,
        opt_IrrefutableTuples,
        opt_Parallel,
-       opt_RuntimeTypes,
-       opt_Flatten,
 
        -- optimisation opts
-       opt_NoMethodSharing, 
+       opt_DsMultiTyVar,
        opt_NoStateHack,
+        opt_SimpleListLiterals,
        opt_CprOff,
        opt_SimplNoPreInlining,
        opt_SimplExcessPrecision,
@@ -50,14 +51,16 @@ module StaticFlags (
        opt_UF_CreationThreshold,
        opt_UF_UseThreshold,
        opt_UF_FunAppDiscount,
+       opt_UF_DictDiscount,
        opt_UF_KeenessFactor,
-       opt_UF_UpdateInPlace,
        opt_UF_DearOp,
 
+       -- Optimization fuel controls
+       opt_Fuel,
+
        -- Related to linking
        opt_PIC,
        opt_Static,
-       opt_HardwireLibPaths,
 
        -- misc opts
        opt_IgnoreDotGhci,
@@ -67,141 +70,41 @@ module StaticFlags (
        opt_HistorySize,
        opt_OmitBlackHoling,
        opt_Unregisterised,
-       opt_EmitExternalCore,
        v_Ld_inputs,
-       tablesNextToCode
+       tablesNextToCode,
+        opt_StubDeadValues,
+        opt_Ticky,
+
+    -- For the parser
+    addOpt, removeOpt, addWay, getWayFlags, v_opt_C_ready
   ) where
 
 #include "HsVersions.h"
 
-import CmdLineParser
 import Config
-import FastString      ( FastString, mkFastString )
+import FastString
 import Util
 import Maybes          ( firstJust )
 import Panic
 
-import Control.Exception ( throwDyn )
+import Data.Maybe       ( listToMaybe )
 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 args = do
-  ready <- readIORef v_opt_C_ready
-  when ready $ throwDyn (ProgramError "Too late for parseStaticFlags: call it before newSession")
-
-  (leftover, errs) <- processArgs static_flags args
-  when (not (null errs)) $ throwDyn (UsageError (unlines errs))
-
-    -- deal with the way flags: the way (eg. prof) gives rise to
-    -- 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)
-
-    -- 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 (excess_prec++cg_flags++more_leftover++leftover)
-
 initStaticOpts :: IO ()
 initStaticOpts = writeIORef v_opt_C_ready True
 
-static_flags :: [(String, OptKind 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 = [
-       ------- 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-debug",       PassFlag addOpt )
-  ,  ( "dppr-user-length", AnySuffix addOpt )
-      -- 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") )
-         -- "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") )
-
-       ------- Miscellaneous -----------------------------------------------
-  ,  ( "no-link-chk"    , NoArg (return ()) ) -- ignored for backwards compat
-
-       ----- 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) )
-
-        ------ 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 )
-  ]
-
+addOpt :: String -> IO ()
 addOpt = consIORef v_opt_C
 
-addWay = consIORef v_Ways
+addWay :: WayName -> IO ()
+addWay = consIORef v_Ways . lkupWay
 
+removeOpt :: String -> IO ()
 removeOpt f = do
   fs <- readIORef v_opt_C
   writeIORef v_opt_C $! filter (/= f) fs    
@@ -215,15 +118,19 @@ lookup_str       :: String -> Maybe String
 -- being unsafely read by unpacked_static_opts below.
 GLOBAL_VAR(v_opt_C, defaultStaticOpts, [String])
 GLOBAL_VAR(v_opt_C_ready, False, Bool)
+
+staticFlags :: [String]
 staticFlags = unsafePerformIO $ do
   ready <- readIORef v_opt_C_ready
   if (not ready)
-        then panic "a static opt was looked at too early!"
+        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
@@ -231,7 +138,7 @@ lookUp     sw = sw `elem` packed_static_opts
 -- (lookup_str "foo") looks for the flag -foo=X or -fooX, 
 -- and returns the string X
 lookup_str sw 
-   = case firstJust (map (startsWith sw) staticFlags) of
+   = case firstJust (map (stripPrefix sw) staticFlags) of
        Just ('=' : str) -> Just str
        Just str         -> Just str
        Nothing          -> Nothing     
@@ -272,156 +179,143 @@ 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_SuppressCoercions :: Bool
+opt_SuppressCoercions           = lookUp  (fsLit "-dsuppress-coercions")
+
+opt_SuppressModulePrefixes :: Bool
+opt_SuppressModulePrefixes     = lookUp  (fsLit "-dsuppress-module-prefixes")
+
+opt_PprStyle_Debug  :: Bool
+opt_PprStyle_Debug              = lookUp  (fsLit "-dppr-debug")
+
+opt_TraceLevel :: Int
+opt_TraceLevel = lookup_def_int "-dtrace-level" 1      -- Standard level is 1
+                                                       -- Less verbose is 0
+
+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            = WayTicky `elem` (unsafePerformIO $ readIORef v_Ways)
+opt_SccProfilingOn :: Bool
+opt_SccProfilingOn             = lookUp  (fsLit "-fscc-profiling")
 
 -- Hpc opts
-opt_Hpc                                = lookUp FSLIT("-fhpc")  
+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_DsMultiTyVar :: Bool
+opt_DsMultiTyVar               = not (lookUp (fsLit "-fno-ds-multi-tyvar"))
+       -- On by default
+
+opt_SimpleListLiterals :: Bool
+opt_SimpleListLiterals         = lookUp  (fsLit "-fsimple-list-literals")
+
+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_MaxWorkerArgs :: Int
 opt_MaxWorkerArgs              = lookup_def_int "-fmax-worker-args" (10::Int)
 
-opt_GranMacros                 = lookUp  FSLIT("-fgransim")
+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")
+
+opt_StubDeadValues  :: Bool
+opt_StubDeadValues             = lookUp  (fsLit "-dstub-dead-values")
 
 -- 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       = lookup_def_int "-funfolding-creation-threshold"  (45::Int)
-opt_UF_UseThreshold            = lookup_def_int "-funfolding-use-threshold"       (8::Int)     -- Discounts can be big
-opt_UF_FunAppDiscount          = lookup_def_int "-funfolding-fun-discount"        (6::Int)     -- It's great to inline a fn
-opt_UF_KeenessFactor           = lookup_def_float "-funfolding-keeness-factor"    (1.5::Float)
-opt_UF_UpdateInPlace           = lookUp  FSLIT("-funfolding-update-in-place")
-
-opt_UF_DearOp   = ( 4 :: Int)
-                       
+-- See Note [Discounts and thresholds] in CoreUnfold
+
+opt_UF_CreationThreshold, opt_UF_UseThreshold :: Int
+opt_UF_DearOp, opt_UF_FunAppDiscount, opt_UF_DictDiscount :: Int
+opt_UF_KeenessFactor :: Float
+
+opt_UF_CreationThreshold = lookup_def_int "-funfolding-creation-threshold" (45::Int)
+opt_UF_UseThreshold     = lookup_def_int "-funfolding-use-threshold"      (6::Int)
+opt_UF_FunAppDiscount   = lookup_def_int "-funfolding-fun-discount"       (6::Int)
+opt_UF_DictDiscount     = lookup_def_int "-funfolding-dict-discount"      (1::Int)
+opt_UF_KeenessFactor    = lookup_def_float "-funfolding-keeness-factor"   (1.5::Float)
+opt_UF_DearOp            = ( 4 :: Int)
+
+
+-- Related to linking
+opt_PIC :: Bool
 #if darwin_TARGET_OS && x86_64_TARGET_ARCH
 opt_PIC                         = True
+#elif darwin_TARGET_OS
+opt_PIC                         = lookUp (fsLit "-fPIC") || not opt_Static
 #else
-opt_PIC                         = lookUp FSLIT("-fPIC")
+opt_PIC                         = lookUp (fsLit "-fPIC")
 #endif
-opt_Static                     = lookUp  FSLIT("-static")
-opt_HardwireLibPaths           = lookUp  FSLIT("-fhardwire-lib-paths")
-opt_Unregisterised             = lookUp  FSLIT("-funregisterised")
+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.
+-- includes/rts/storage/InfoTables.h.
+tablesNextToCode :: Bool
 tablesNextToCode               = not opt_Unregisterised
                                  && cGhcEnableTablesNextToCode == "YES"
 
-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_Ticky :: Bool
+opt_Ticky                       = lookUp (fsLit "-ticky")
 
 -- 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 f =
-  f `elem` [
-       "fauto-sccs-on-all-toplevs",
-       "fauto-sccs-on-exported-toplevs",
-       "fauto-sccs-on-individual-cafs",
-       "fscc-profiling",
-       "fdicts-strict",
-       "firrefutable-tuples",
-       "fparallel",
-       "fflatten",
-       "fgransim",
-       "fno-hi-version-check",
-       "dno-black-holing",
-       "fno-method-sharing",
-       "fno-state-hack",
-       "fruntime-types",
-       "fno-pre-inlining",
-       "fexcess-precision",
-       "funfolding-update-in-place",
-       "static",
-       "fhardwire-lib-paths",
-       "funregisterised",
-       "fext-core",
-       "fcpr-off",
-       "ferror-spans",
-       "fPIC",
-       "fhpc"
-       ]
-  || any (`isPrefixOf` f) [
-       "fliberate-case-threshold",
-       "fmax-worker-args",
-       "fhistory-size",
-       "funfolding-creation-threshold",
-       "funfolding-use-threshold",
-       "funfolding-fun-discount",
-       "funfolding-keeness-factor"
-     ]
-
-
-
--- Misc functions for command-line options
-
-startsWith :: String -> String -> Maybe String
--- startsWith pfx (pfx++rest) = Just rest
-
-startsWith []     str = Just str
-startsWith (c:cs) (s:ss)
-  = if c /= s then Nothing else startsWith cs ss
-startsWith  _    []  = Nothing
-
-
------------------------------------------------------------------------------
--- convert sizes like "3.5M" into integers
-
-decodeSize :: String -> Integer
-decodeSize str
-  | c == ""             = truncate n
-  | c == "K" || c == "k" = truncate (n * 1000)
-  | c == "M" || c == "m" = truncate (n * 1000 * 1000)
-  | c == "G" || c == "g" = truncate (n * 1000 * 1000 * 1000)
-  | otherwise            = throwDyn (CmdLineError ("can't decode size: " ++ str))
-  where (m, c) = span pred str
-        n      = readRational m
-       pred c = isDigit c || c == '.'
-
-
------------------------------------------------------------------------------
--- RTS Hooks
-
-foreign import ccall unsafe "setHeapSize"       setHeapSize       :: Int -> IO ()
-foreign import ccall unsafe "enableTimingStats" enableTimingStats :: IO ()
-
 -----------------------------------------------------------------------------
 -- Ways
 
@@ -432,48 +326,26 @@ foreign import ccall unsafe "enableTimingStats" enableTimingStats :: IO ()
 -- non-profiling objects.
 
 -- After parsing the command-line options, we determine which "way" we
--- are building - this might be a combination way, eg. profiling+ticky-ticky.
+-- are building - this might be a combination way, eg. profiling+threaded.
 
 -- We then find the "build-tag" associated with this way, and this
 -- becomes the suffix used to find .hi files and libraries used in
 -- this compilation.
 
-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
   = WayThreaded
   | WayDebug
   | WayProf
-  | WayUnreg
-  | WayTicky
+  | WayEventLog
   | WayPar
   | WayGran
   | WayNDP
-  | WayUser_a
-  | WayUser_b
-  | WayUser_c
-  | WayUser_d
-  | WayUser_e
-  | WayUser_f
-  | WayUser_g
-  | WayUser_h
-  | WayUser_i
-  | WayUser_j
-  | WayUser_k
-  | WayUser_l
-  | WayUser_m
-  | WayUser_n
-  | WayUser_o
-  | WayUser_A
-  | WayUser_B
+  | WayDyn
   deriving (Eq,Ord)
 
-GLOBAL_VAR(v_Ways, [] ,[WayName])
+GLOBAL_VAR(v_Ways, [] ,[Way])
 
+allowed_combination :: [WayName] -> Bool
 allowed_combination way = and [ x `allowedWith` y 
                              | x <- way, y <- way, x < y ]
   where
@@ -481,56 +353,58 @@ allowed_combination way = and [ x `allowedWith` y
        -- <= the right argument, according to the Ord instance
        -- on Way above.
 
+       -- dyn is allowed with everything
+       _ `allowedWith` WayDyn                  = True
+       WayDyn `allowedWith` _                  = True
+
        -- debug is allowed with everything
        _ `allowedWith` WayDebug                = True
        WayDebug `allowedWith` _                = True
 
-       WayProf `allowedWith` WayUnreg          = True
        WayProf `allowedWith` WayNDP            = True
+       WayThreaded `allowedWith` WayProf       = True
+       WayThreaded `allowedWith` WayEventLog   = True
        _ `allowedWith` _                       = False
 
 
-findBuildTag :: IO [String]  -- new options
-findBuildTag = do
-  way_names <- readIORef v_Ways
-  let ws = sort (nub way_names)
+getWayFlags :: IO [String]  -- new options
+getWayFlags = do
+  unsorted <- readIORef v_Ways
+  let ways = sortBy (compare `on` wayName) $
+             nubBy  ((==) `on` wayName) $ unsorted
+  writeIORef v_Ways ways
 
-  if not (allowed_combination ws)
-      then throwDyn (CmdLineError $
+  if not (allowed_combination (map wayName ways))
+      then ghcError (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)
-
-
+                   (map wayDesc ways))
+      else
+          return (concatMap wayOpts ways)
 
 mkBuildTag :: [Way] -> String
 mkBuildTag ways = concat (intersperse "_" (map wayTag ways))
 
+lkupWay :: WayName -> Way
 lkupWay w = 
-   case lookup w way_details of
+   case listToMaybe (filter ((==) w . wayName) way_details) of
        Nothing -> error "findBuildTag"
        Just details -> details
 
+isRTSWay :: WayName -> Bool
 isRTSWay = wayRTSOnly . lkupWay 
 
 data Way = Way {
+  wayName    :: WayName,
   wayTag     :: String,
   wayRTSOnly :: Bool,
-  wayName    :: String,
+  wayDesc    :: String,
   wayOpts    :: [String]
   }
 
-way_details :: [ (WayName, Way) ]
+way_details :: [ Way ]
 way_details =
-  [ (WayThreaded, Way "thr" True "Threaded" [
+  [ Way WayThreaded "thr" True "Threaded" [
 #if defined(freebsd_TARGET_OS)
 --       "-optc-pthread"
 --      , "-optl-pthread"
@@ -539,27 +413,41 @@ way_details =
        -- the problems are our fault or theirs, but it seems that using the
        -- alternative 1:1 threading library libthr works around it:
          "-optl-lthr"
+#elif defined(openbsd_TARGET_OS)
+         "-optc-pthread"
+       , "-optl-pthread"
 #elif defined(solaris2_TARGET_OS)
           "-optl-lrt"
 #endif
-       ] ),
-
-    (WayDebug, Way "debug" True "Debug" [] ),
+       ],
+
+    Way WayDebug "debug" True "Debug" [],
+
+    Way WayDyn "dyn" False "Dynamic"
+       [ "-DDYNAMIC"
+       , "-optc-DDYNAMIC" 
+#if defined(mingw32_TARGET_OS)
+       -- On Windows, code that is to be linked into a dynamic library must be compiled
+       --      with -fPIC. Labels not in the current package are assumed to be in a DLL 
+       --      different from the current one.
+       , "-fPIC"
+#elif defined(openbsd_TARGET_OS)
+       -- Without this, linking the shared libHSffi fails because
+       -- it uses pthread mutexes.
+       , "-optl-pthread"
+#endif
+       ],
 
-    (WayProf, Way  "p" False "Profiling"
+    Way WayProf "p" False "Profiling"
        [ "-fscc-profiling"
        , "-DPROFILING"
-       , "-optc-DPROFILING" ]),
+       , "-optc-DPROFILING" ],
 
-    (WayTicky, Way  "t" True "Ticky-ticky Profiling"  
-       [ "-DTICKY_TICKY"
-       , "-optc-DTICKY_TICKY" ]),
+    Way WayEventLog "l" True "RTS Event Logging"
+       [ "-DTRACING"
+       , "-optc-DTRACING" ],
 
-    (WayUnreg, Way  "u" False "Unregisterised" 
-       unregFlags ),
-
-    -- optl's below to tell linker where to find the PVM library -- HWL
-    (WayPar, Way  "mp" False "Parallel" 
+    Way WayPar "mp" False "Parallel" 
        [ "-fparallel"
        , "-D__PARALLEL_HASKELL__"
        , "-optc-DPAR"
@@ -567,10 +455,10 @@ way_details =
         , "-optc-w"
         , "-optl-L${PVM_ROOT}/lib/${PVM_ARCH}"
         , "-optl-lpvm3"
-        , "-optl-lgpvm3" ]),
+        , "-optl-lgpvm3" ],
 
     -- at the moment we only change the RTS and could share compiler and libs!
-    (WayPar, Way  "mt" False "Parallel ticky profiling" 
+    Way WayPar "mt" False "Parallel ticky profiling" 
        [ "-fparallel"
        , "-D__PARALLEL_HASKELL__"
        , "-optc-DPAR"
@@ -579,9 +467,9 @@ way_details =
         , "-optc-w"
         , "-optl-L${PVM_ROOT}/lib/${PVM_ARCH}"
         , "-optl-lpvm3"
-        , "-optl-lgpvm3" ]),
+        , "-optl-lgpvm3" ],
 
-    (WayPar, Way  "md" False "Distributed" 
+    Way WayPar "md" False "Distributed" 
        [ "-fparallel"
        , "-D__PARALLEL_HASKELL__"
        , "-D__DISTRIBUTED_HASKELL__"
@@ -591,40 +479,15 @@ way_details =
         , "-optc-w"
         , "-optl-L${PVM_ROOT}/lib/${PVM_ARCH}"
         , "-optl-lpvm3"
-        , "-optl-lgpvm3" ]),
+        , "-optl-lgpvm3" ],
 
-    (WayGran, Way  "mg" False "GranSim"
+    Way WayGran "mg" False "GranSim"
        [ "-fgransim"
        , "-D__GRANSIM__"
        , "-optc-DGRAN"
-       , "-package concurrent" ]),
-
-    (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"]) 
-  ]
+       , "-package concurrent" ],
 
-unregFlags = 
-   [ "-optc-DNO_REGS"
-   , "-optc-DUSE_MINIINTERPRETER"
-   , "-fno-asm-mangling"
-   , "-funregisterised"
-   , "-fvia-C" ]
+    Way WayNDP "ndp" False "Nested data parallelism"
+       [ "-XParr"
+       , "-fvectorise"]
+  ]