Commit c532c16f authored by dterei's avatar dterei
Browse files

Formatting wibbles.

parent 189f6663
...@@ -53,7 +53,7 @@ data OptKind m -- Suppose the flag is -f ...@@ -53,7 +53,7 @@ data OptKind m -- Suppose the flag is -f
-------------------------------------------------------- --------------------------------------------------------
-- The EwM monad -- The EwM monad
-------------------------------------------------------- --------------------------------------------------------
type Err = Located String type Err = Located String
...@@ -84,7 +84,7 @@ addWarn msg = EwM (\(L loc _) es ws -> return (es, ws `snocBag` L loc w, ())) ...@@ -84,7 +84,7 @@ addWarn msg = EwM (\(L loc _) es ws -> return (es, ws `snocBag` L loc w, ()))
w = "Warning: " ++ msg w = "Warning: " ++ msg
deprecate :: Monad m => String -> EwM m () deprecate :: Monad m => String -> EwM m ()
deprecate s deprecate s
= do arg <- getArg = do arg <- getArg
addWarn (arg ++ " is deprecated: " ++ s) addWarn (arg ++ " is deprecated: " ++ s)
...@@ -146,9 +146,9 @@ processArgs spec args ...@@ -146,9 +146,9 @@ processArgs spec args
let b = process rest spare let b = process rest spare
in (setArg locArg $ action) >> b in (setArg locArg $ action) >> b
Nothing -> process args (locArg : spare) Nothing -> process args (locArg : spare)
process (arg : args) spare = process args (arg : spare) process (arg : args) spare = process args (arg : spare)
processOneArg :: OptKind m -> String -> String -> [Located String] processOneArg :: OptKind m -> String -> String -> [Located String]
......
...@@ -81,7 +81,7 @@ module DynFlags ( ...@@ -81,7 +81,7 @@ module DynFlags (
-- * Compiler configuration suitable for display to the user -- * Compiler configuration suitable for display to the user
compilerInfo compilerInfo
#ifdef GHCI #ifdef GHCI
-- Only in stage 2 can we be sure that the RTS -- Only in stage 2 can we be sure that the RTS
-- exposes the appropriate runtime boolean -- exposes the appropriate runtime boolean
, rtsIsProfiled , rtsIsProfiled
#endif #endif
...@@ -384,7 +384,7 @@ data ExtensionFlag ...@@ -384,7 +384,7 @@ data ExtensionFlag
| Opt_DoAndIfThenElse | Opt_DoAndIfThenElse
| Opt_RebindableSyntax | Opt_RebindableSyntax
| Opt_ConstraintKinds | Opt_ConstraintKinds
| Opt_StandaloneDeriving | Opt_StandaloneDeriving
| Opt_DeriveDataTypeable | Opt_DeriveDataTypeable
| Opt_DeriveFunctor | Opt_DeriveFunctor
...@@ -802,7 +802,7 @@ defaultDynFlags mySettings = ...@@ -802,7 +802,7 @@ defaultDynFlags mySettings =
maxSimplIterations = 4, maxSimplIterations = 4,
shouldDumpSimplPhase = Nothing, shouldDumpSimplPhase = Nothing,
ruleCheck = Nothing, ruleCheck = Nothing,
simplTickFactor = 100, simplTickFactor = 100,
specConstrThreshold = Just 2000, specConstrThreshold = Just 2000,
specConstrCount = Just 3, specConstrCount = Just 3,
liberateCaseThreshold = Just 2000, liberateCaseThreshold = Just 2000,
...@@ -1303,9 +1303,9 @@ allFlags = map ('-':) $ ...@@ -1303,9 +1303,9 @@ allFlags = map ('-':) $
dynamic_flags :: [Flag (CmdLineP DynFlags)] dynamic_flags :: [Flag (CmdLineP DynFlags)]
dynamic_flags = [ dynamic_flags = [
Flag "n" (NoArg (addWarn "The -n flag is deprecated and no longer has any effect")) Flag "n" (NoArg (addWarn "The -n flag is deprecated and no longer has any effect"))
, Flag "cpp" (NoArg (setExtensionFlag Opt_Cpp)) , Flag "cpp" (NoArg (setExtensionFlag Opt_Cpp))
, Flag "F" (NoArg (setDynFlag Opt_Pp)) , Flag "F" (NoArg (setDynFlag Opt_Pp))
, Flag "#include" , Flag "#include"
(HasArg (\s -> do addCmdlineHCInclude s (HasArg (\s -> do addCmdlineHCInclude s
addWarn "-#include and INCLUDE pragmas are deprecated: They no longer have any effect")) addWarn "-#include and INCLUDE pragmas are deprecated: They no longer have any effect"))
, Flag "v" (OptIntSuffix setVerbosity) , Flag "v" (OptIntSuffix setVerbosity)
...@@ -1338,7 +1338,7 @@ dynamic_flags = [ ...@@ -1338,7 +1338,7 @@ dynamic_flags = [
, Flag "optwindres" (hasArg (\f -> alterSettings (\s -> s { sOpt_windres = f : sOpt_windres s}))) , Flag "optwindres" (hasArg (\f -> alterSettings (\s -> s { sOpt_windres = f : sOpt_windres s})))
, Flag "split-objs" , Flag "split-objs"
(NoArg (if can_split (NoArg (if can_split
then setDynFlag Opt_SplitObjs then setDynFlag Opt_SplitObjs
else addWarn "ignoring -fsplit-objs")) else addWarn "ignoring -fsplit-objs"))
...@@ -1532,7 +1532,7 @@ dynamic_flags = [ ...@@ -1532,7 +1532,7 @@ dynamic_flags = [
------ Plugin flags ------------------------------------------------ ------ Plugin flags ------------------------------------------------
, Flag "fplugin-opt" (hasArg addPluginModuleNameOption) , Flag "fplugin-opt" (hasArg addPluginModuleNameOption)
, Flag "fplugin" (hasArg addPluginModuleName) , Flag "fplugin" (hasArg addPluginModuleName)
------ Optimisation flags ------------------------------------------ ------ Optimisation flags ------------------------------------------
, Flag "O" (noArgM (setOptLevel 1)) , Flag "O" (noArgM (setOptLevel 1))
, Flag "Onot" (noArgM (\dflags -> do deprecate "Use -O0 instead" , Flag "Onot" (noArgM (\dflags -> do deprecate "Use -O0 instead"
...@@ -1646,7 +1646,7 @@ mkFlag turn_on flagPrefix f (name, flag, extra_action) ...@@ -1646,7 +1646,7 @@ mkFlag turn_on flagPrefix f (name, flag, extra_action)
deprecatedForExtension :: String -> TurnOnFlag -> DynP () deprecatedForExtension :: String -> TurnOnFlag -> DynP ()
deprecatedForExtension lang turn_on deprecatedForExtension lang turn_on
= deprecate ("use -X" ++ flag ++ " or pragma {-# LANGUAGE " ++ flag ++ " #-} instead") = deprecate ("use -X" ++ flag ++ " or pragma {-# LANGUAGE " ++ flag ++ " #-} instead")
where where
flag | turn_on = lang flag | turn_on = lang
| otherwise = "No"++lang | otherwise = "No"++lang
...@@ -1833,11 +1833,11 @@ xFlags = [ ...@@ -1833,11 +1833,11 @@ xFlags = [
( "LiberalTypeSynonyms", Opt_LiberalTypeSynonyms, nop ), ( "LiberalTypeSynonyms", Opt_LiberalTypeSynonyms, nop ),
( "Rank2Types", Opt_Rank2Types, nop ), ( "Rank2Types", Opt_Rank2Types, nop ),
( "RankNTypes", Opt_RankNTypes, nop ), ( "RankNTypes", Opt_RankNTypes, nop ),
( "ImpredicativeTypes", Opt_ImpredicativeTypes, nop), ( "ImpredicativeTypes", Opt_ImpredicativeTypes, nop),
( "TypeOperators", Opt_TypeOperators, nop ), ( "TypeOperators", Opt_TypeOperators, nop ),
( "RecursiveDo", Opt_RecursiveDo, -- Enables 'mdo' ( "RecursiveDo", Opt_RecursiveDo, -- Enables 'mdo'
deprecatedForExtension "DoRec"), deprecatedForExtension "DoRec"),
( "DoRec", Opt_DoRec, nop ), -- Enables 'rec' keyword ( "DoRec", Opt_DoRec, nop ), -- Enables 'rec' keyword
( "Arrows", Opt_Arrows, nop ), ( "Arrows", Opt_Arrows, nop ),
( "ParallelArrays", Opt_ParallelArrays, nop ), ( "ParallelArrays", Opt_ParallelArrays, nop ),
( "TemplateHaskell", Opt_TemplateHaskell, checkTemplateHaskellOk ), ( "TemplateHaskell", Opt_TemplateHaskell, checkTemplateHaskellOk ),
...@@ -1859,7 +1859,7 @@ xFlags = [ ...@@ -1859,7 +1859,7 @@ xFlags = [
( "DoAndIfThenElse", Opt_DoAndIfThenElse, nop ), ( "DoAndIfThenElse", Opt_DoAndIfThenElse, nop ),
( "RebindableSyntax", Opt_RebindableSyntax, nop ), ( "RebindableSyntax", Opt_RebindableSyntax, nop ),
( "ConstraintKinds", Opt_ConstraintKinds, nop ), ( "ConstraintKinds", Opt_ConstraintKinds, nop ),
( "MonoPatBinds", Opt_MonoPatBinds, ( "MonoPatBinds", Opt_MonoPatBinds,
\ turn_on -> when turn_on $ deprecate "Experimental feature now removed; has no effect" ), \ turn_on -> when turn_on $ deprecate "Experimental feature now removed; has no effect" ),
( "ExplicitForAll", Opt_ExplicitForAll, nop ), ( "ExplicitForAll", Opt_ExplicitForAll, nop ),
( "AlternativeLayoutRule", Opt_AlternativeLayoutRule, nop ), ( "AlternativeLayoutRule", Opt_AlternativeLayoutRule, nop ),
...@@ -1870,15 +1870,15 @@ xFlags = [ ...@@ -1870,15 +1870,15 @@ xFlags = [
( "RelaxedLayout", Opt_RelaxedLayout, nop ), ( "RelaxedLayout", Opt_RelaxedLayout, nop ),
( "TraditionalRecordSyntax", Opt_TraditionalRecordSyntax, nop ), ( "TraditionalRecordSyntax", Opt_TraditionalRecordSyntax, nop ),
( "MonoLocalBinds", Opt_MonoLocalBinds, nop ), ( "MonoLocalBinds", Opt_MonoLocalBinds, nop ),
( "RelaxedPolyRec", Opt_RelaxedPolyRec, ( "RelaxedPolyRec", Opt_RelaxedPolyRec,
\ turn_on -> if not turn_on \ turn_on -> if not turn_on
then deprecate "You can't turn off RelaxedPolyRec any more" then deprecate "You can't turn off RelaxedPolyRec any more"
else return () ), else return () ),
( "ExtendedDefaultRules", Opt_ExtendedDefaultRules, nop ), ( "ExtendedDefaultRules", Opt_ExtendedDefaultRules, nop ),
( "ImplicitParams", Opt_ImplicitParams, nop ), ( "ImplicitParams", Opt_ImplicitParams, nop ),
( "ScopedTypeVariables", Opt_ScopedTypeVariables, nop ), ( "ScopedTypeVariables", Opt_ScopedTypeVariables, nop ),
( "PatternSignatures", Opt_ScopedTypeVariables, ( "PatternSignatures", Opt_ScopedTypeVariables,
deprecatedForExtension "ScopedTypeVariables" ), deprecatedForExtension "ScopedTypeVariables" ),
( "UnboxedTuples", Opt_UnboxedTuples, nop ), ( "UnboxedTuples", Opt_UnboxedTuples, nop ),
...@@ -1903,7 +1903,7 @@ xFlags = [ ...@@ -1903,7 +1903,7 @@ xFlags = [
] ]
defaultFlags :: [DynFlag] defaultFlags :: [DynFlag]
defaultFlags defaultFlags
= [ Opt_AutoLinkPackages, = [ Opt_AutoLinkPackages,
Opt_ReadUserPackageConf, Opt_ReadUserPackageConf,
...@@ -1951,7 +1951,7 @@ impliedFlags ...@@ -1951,7 +1951,7 @@ impliedFlags
-- stuff like " 'a' not in scope ", which is a bit silly -- stuff like " 'a' not in scope ", which is a bit silly
-- if the compiler has just filled in field 'a' of constructor 'C' -- if the compiler has just filled in field 'a' of constructor 'C'
, (Opt_RecordWildCards, turnOn, Opt_DisambiguateRecordFields) , (Opt_RecordWildCards, turnOn, Opt_DisambiguateRecordFields)
, (Opt_ParallelArrays, turnOn, Opt_ParallelListComp) , (Opt_ParallelArrays, turnOn, Opt_ParallelListComp)
] ]
...@@ -2189,8 +2189,8 @@ setDumpFlag' dump_flag ...@@ -2189,8 +2189,8 @@ setDumpFlag' dump_flag
Opt_D_dump_hi_diffs] Opt_D_dump_hi_diffs]
forceRecompile :: DynP () forceRecompile :: DynP ()
-- Whenver we -ddump, force recompilation (by switching off the -- Whenver we -ddump, force recompilation (by switching off the
-- recompilation checker), else you don't see the dump! However, -- recompilation checker), else you don't see the dump! However,
-- don't switch it off in --make mode, else *everything* gets -- don't switch it off in --make mode, else *everything* gets
-- recompiled which probably isn't what you want -- recompiled which probably isn't what you want
forceRecompile = do dfs <- liftEwM getCmdLineState forceRecompile = do dfs <- liftEwM getCmdLineState
...@@ -2200,7 +2200,7 @@ forceRecompile = do dfs <- liftEwM getCmdLineState ...@@ -2200,7 +2200,7 @@ forceRecompile = do dfs <- liftEwM getCmdLineState
setVerboseCore2Core :: DynP () setVerboseCore2Core :: DynP ()
setVerboseCore2Core = do forceRecompile setVerboseCore2Core = do forceRecompile
setDynFlag Opt_D_verbose_core2core setDynFlag Opt_D_verbose_core2core
upd (\dfs -> dfs { shouldDumpSimplPhase = Nothing }) upd (\dfs -> dfs { shouldDumpSimplPhase = Nothing })
setDumpSimplPhases :: String -> DynP () setDumpSimplPhases :: String -> DynP ()
...@@ -2313,7 +2313,7 @@ setDPHBackend backend = upd $ \dflags -> dflags { dphBackend = backend } ...@@ -2313,7 +2313,7 @@ setDPHBackend backend = upd $ \dflags -> dflags { dphBackend = backend }
-- Query the DPH backend package to be used by the vectoriser and desugaring of DPH syntax. -- Query the DPH backend package to be used by the vectoriser and desugaring of DPH syntax.
-- --
dphPackageMaybe :: DynFlags -> Maybe PackageId dphPackageMaybe :: DynFlags -> Maybe PackageId
dphPackageMaybe dflags dphPackageMaybe dflags
= case dphBackend dflags of = case dphBackend dflags of
DPHPar -> Just dphParPackageId DPHPar -> Just dphParPackageId
DPHSeq -> Just dphSeqPackageId DPHSeq -> Just dphSeqPackageId
......
...@@ -77,7 +77,7 @@ parseStaticFlags args = do ...@@ -77,7 +77,7 @@ parseStaticFlags args = do
| otherwise = [] | otherwise = []
-- HACK: -fexcess-precision is both a static and a dynamic flag. If -- 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 -- the static flag parser has slurped it, we must return it as a
-- leftover too. ToDo: make -fexcess-precision dynamic only. -- leftover too. ToDo: make -fexcess-precision dynamic only.
let excess_prec let excess_prec
| opt_SimplExcessPrecision = map (mkGeneralLocated "in excess_prec") | opt_SimplExcessPrecision = map (mkGeneralLocated "in excess_prec")
...@@ -104,11 +104,11 @@ static_flags :: [Flag IO] ...@@ -104,11 +104,11 @@ static_flags :: [Flag IO]
static_flags = [ static_flags = [
------- GHCi ------------------------------------------------------- ------- GHCi -------------------------------------------------------
Flag "ignore-dot-ghci" (PassFlag addOpt) Flag "ignore-dot-ghci" (PassFlag addOpt)
, Flag "read-dot-ghci" (NoArg (removeOpt "-ignore-dot-ghci")) , Flag "read-dot-ghci" (NoArg (removeOpt "-ignore-dot-ghci"))
------- ways -------------------------------------------------------- ------- ways --------------------------------------------------------
, Flag "prof" (NoArg (addWay WayProf)) , Flag "prof" (NoArg (addWay WayProf))
, Flag "eventlog" (NoArg (addWay WayEventLog)) , Flag "eventlog" (NoArg (addWay WayEventLog))
, Flag "parallel" (NoArg (addWay WayPar)) , Flag "parallel" (NoArg (addWay WayPar))
, Flag "gransim" (NoArg (addWay WayGran)) , Flag "gransim" (NoArg (addWay WayGran))
...@@ -147,7 +147,7 @@ static_flags = [ ...@@ -147,7 +147,7 @@ static_flags = [
----- RTS opts ------------------------------------------------------ ----- RTS opts ------------------------------------------------------
, Flag "H" (HasArg (\s -> liftEwM (setHeapSize (fromIntegral (decodeSize s))))) , Flag "H" (HasArg (\s -> liftEwM (setHeapSize (fromIntegral (decodeSize s)))))
, Flag "Rghc-timing" (NoArg (liftEwM enableTimingStats)) , Flag "Rghc-timing" (NoArg (liftEwM enableTimingStats))
------ Compiler flags ----------------------------------------------- ------ Compiler flags -----------------------------------------------
...@@ -159,7 +159,7 @@ static_flags = [ ...@@ -159,7 +159,7 @@ static_flags = [
-- All other "-fno-<blah>" options cancel out "-f<blah>" on the hsc cmdline -- All other "-fno-<blah>" options cancel out "-f<blah>" on the hsc cmdline
, Flag "fno-" , Flag "fno-"
(PrefixPred (\s -> isStaticFlag ("f"++s)) (\s -> removeOpt ("-f"++s))) (PrefixPred (\s -> isStaticFlag ("f"++s)) (\s -> removeOpt ("-f"++s)))
-- Pass all remaining "-f<blah>" options to hsc -- Pass all remaining "-f<blah>" options to hsc
, Flag "f" (AnySuffixPred isStaticFlag addOpt) , Flag "f" (AnySuffixPred isStaticFlag addOpt)
......
...@@ -24,7 +24,7 @@ module StaticFlags ( ...@@ -24,7 +24,7 @@ module StaticFlags (
opt_PprCols, opt_PprCols,
opt_PprCaseAsLet, opt_PprCaseAsLet,
opt_PprStyle_Debug, opt_TraceLevel, opt_PprStyle_Debug, opt_TraceLevel,
opt_NoDebugOutput, opt_NoDebugOutput,
-- Suppressing boring aspects of core dumps -- Suppressing boring aspects of core dumps
opt_SuppressAll, opt_SuppressAll,
...@@ -85,7 +85,7 @@ module StaticFlags ( ...@@ -85,7 +85,7 @@ module StaticFlags (
-- For the parser -- For the parser
addOpt, removeOpt, addWay, getWayFlags, v_opt_C_ready, addOpt, removeOpt, addWay, getWayFlags, v_opt_C_ready,
-- Saving/restoring globals -- Saving/restoring globals
saveStaticFlagGlobals, restoreStaticFlagGlobals saveStaticFlagGlobals, restoreStaticFlagGlobals
) where ) where
...@@ -119,7 +119,7 @@ addWay = consIORef v_Ways . lkupWay ...@@ -119,7 +119,7 @@ addWay = consIORef v_Ways . lkupWay
removeOpt :: String -> IO () removeOpt :: String -> IO ()
removeOpt f = do removeOpt f = do
fs <- readIORef v_opt_C fs <- readIORef v_opt_C
writeIORef v_opt_C $! filter (/= f) fs writeIORef v_opt_C $! filter (/= f) fs
lookUp :: FastString -> Bool lookUp :: FastString -> Bool
lookup_def_int :: String -> Int -> Int lookup_def_int :: String -> Int -> Int
...@@ -147,14 +147,14 @@ packed_static_opts :: [FastString] ...@@ -147,14 +147,14 @@ packed_static_opts :: [FastString]
packed_static_opts = map mkFastString staticFlags packed_static_opts = map mkFastString staticFlags
lookUp sw = sw `elem` packed_static_opts lookUp sw = sw `elem` packed_static_opts
-- (lookup_str "foo") looks for the flag -foo=X or -fooX, -- (lookup_str "foo") looks for the flag -foo=X or -fooX,
-- and returns the string X -- and returns the string X
lookup_str sw lookup_str sw
= case firstJusts (map (stripPrefix sw) staticFlags) of = case firstJusts (map (stripPrefix sw) staticFlags) of
Just ('=' : str) -> Just str Just ('=' : str) -> Just str
Just str -> Just str Just str -> Just str
Nothing -> Nothing Nothing -> Nothing
lookup_all_str sw = map f $ catMaybes (map (stripPrefix sw) staticFlags) where lookup_all_str sw = map f $ catMaybes (map (stripPrefix sw) staticFlags) where
f ('=' : str) = str f ('=' : str) = str
...@@ -198,7 +198,7 @@ unpacked_opts = ...@@ -198,7 +198,7 @@ unpacked_opts =
opt_IgnoreDotGhci :: Bool opt_IgnoreDotGhci :: Bool
opt_IgnoreDotGhci = lookUp (fsLit "-ignore-dot-ghci") opt_IgnoreDotGhci = lookUp (fsLit "-ignore-dot-ghci")
opt_GhciScripts :: [String] opt_GhciScripts :: [String]
opt_GhciScripts = lookup_all_str "-ghci-script" opt_GhciScripts = lookup_all_str "-ghci-script"
...@@ -207,13 +207,13 @@ opt_GhciScripts = lookup_all_str "-ghci-script" ...@@ -207,13 +207,13 @@ opt_GhciScripts = lookup_all_str "-ghci-script"
-- Except for uniques, as some simplifier phases introduce new varibles that -- Except for uniques, as some simplifier phases introduce new varibles that
-- have otherwise identical names. -- have otherwise identical names.
opt_SuppressAll :: Bool opt_SuppressAll :: Bool
opt_SuppressAll opt_SuppressAll
= lookUp (fsLit "-dsuppress-all") = lookUp (fsLit "-dsuppress-all")
-- | Suppress all coercions, them replacing with '...' -- | Suppress all coercions, them replacing with '...'
opt_SuppressCoercions :: Bool opt_SuppressCoercions :: Bool
opt_SuppressCoercions opt_SuppressCoercions
= lookUp (fsLit "-dsuppress-all") = lookUp (fsLit "-dsuppress-all")
|| lookUp (fsLit "-dsuppress-coercions") || lookUp (fsLit "-dsuppress-coercions")
-- | Suppress module id prefixes on variables. -- | Suppress module id prefixes on variables.
...@@ -230,7 +230,7 @@ opt_SuppressTypeApplications ...@@ -230,7 +230,7 @@ opt_SuppressTypeApplications
-- | Suppress info such as arity and unfoldings on identifiers. -- | Suppress info such as arity and unfoldings on identifiers.
opt_SuppressIdInfo :: Bool opt_SuppressIdInfo :: Bool
opt_SuppressIdInfo opt_SuppressIdInfo
= lookUp (fsLit "-dsuppress-all") = lookUp (fsLit "-dsuppress-all")
|| lookUp (fsLit "-dsuppress-idinfo") || lookUp (fsLit "-dsuppress-idinfo")
...@@ -254,10 +254,10 @@ opt_PprCaseAsLet = lookUp (fsLit "-dppr-case-as-let") ...@@ -254,10 +254,10 @@ opt_PprCaseAsLet = lookUp (fsLit "-dppr-case-as-let")
-- | Set the maximum width of the dumps -- | Set the maximum width of the dumps
-- If GHC's command line options are bad then the options parser uses the -- If GHC's command line options are bad then the options parser uses the
-- pretty printer display the error message. In this case the staticFlags -- pretty printer display the error message. In this case the staticFlags
-- won't be initialized yet, so we must check for this case explicitly -- won't be initialized yet, so we must check for this case explicitly
-- and return the default value. -- and return the default value.
opt_PprCols :: Int opt_PprCols :: Int
opt_PprCols opt_PprCols
= unsafePerformIO = unsafePerformIO
$ do ready <- readIORef v_opt_C_ready $ do ready <- readIORef v_opt_C_ready
if (not ready) if (not ready)
...@@ -287,7 +287,7 @@ opt_SccProfilingOn = lookUp (fsLit "-fscc-profiling") ...@@ -287,7 +287,7 @@ opt_SccProfilingOn = lookUp (fsLit "-fscc-profiling")
-- Hpc opts -- Hpc opts
opt_Hpc :: Bool opt_Hpc :: Bool
opt_Hpc = lookUp (fsLit "-fhpc") opt_Hpc = lookUp (fsLit "-fhpc")
-- language opts -- language opts
opt_DictsStrict :: Bool opt_DictsStrict :: Bool
...@@ -369,7 +369,7 @@ opt_Unregisterised = lookUp (fsLit "-funregisterised") ...@@ -369,7 +369,7 @@ opt_Unregisterised = lookUp (fsLit "-funregisterised")
-- Derived, not a real option. Determines whether we will be compiling -- Derived, not a real option. Determines whether we will be compiling
-- info tables that reside just before the entry code, or with an -- info tables that reside just before the entry code, or with an
-- indirection to the entry code. See TABLES_NEXT_TO_CODE in -- indirection to the entry code. See TABLES_NEXT_TO_CODE in
-- includes/rts/storage/InfoTables.h. -- includes/rts/storage/InfoTables.h.
tablesNextToCode :: Bool tablesNextToCode :: Bool
tablesNextToCode = not opt_Unregisterised tablesNextToCode = not opt_Unregisterised
...@@ -417,7 +417,7 @@ data WayName ...@@ -417,7 +417,7 @@ data WayName
GLOBAL_VAR(v_Ways, [] ,[Way]) GLOBAL_VAR(v_Ways, [] ,[Way])
allowed_combination :: [WayName] -> Bool allowed_combination :: [WayName] -> Bool
allowed_combination way = and [ x `allowedWith` y allowed_combination way = and [ x `allowedWith` y
| x <- way, y <- way, x < y ] | x <- way, y <- way, x < y ]
where where
-- Note ordering in these tests: the left argument is -- Note ordering in these tests: the left argument is
...@@ -448,7 +448,7 @@ getWayFlags = do ...@@ -448,7 +448,7 @@ getWayFlags = do
if not (allowed_combination (map wayName ways)) if not (allowed_combination (map wayName ways))
then ghcError (CmdLineError $ then ghcError (CmdLineError $
"combination not supported: " ++ "combination not supported: " ++
foldr1 (\a b -> a ++ '/':b) foldr1 (\a b -> a ++ '/':b)
(map wayDesc ways)) (map wayDesc ways))
else else
return (concatMap wayOpts ways) return (concatMap wayOpts ways)
...@@ -457,13 +457,13 @@ mkBuildTag :: [Way] -> String ...@@ -457,13 +457,13 @@ mkBuildTag :: [Way] -> String
mkBuildTag ways = concat (intersperse "_" (map wayTag ways)) mkBuildTag ways = concat (intersperse "_" (map wayTag ways))
lkupWay :: WayName -> Way lkupWay :: WayName -> Way
lkupWay w = lkupWay w =
case listToMaybe (filter ((==) w . wayName) way_details) of case listToMaybe (filter ((==) w . wayName) way_details) of
Nothing -> error "findBuildTag" Nothing -> error "findBuildTag"
Just details -> details Just details -> details
isRTSWay :: WayName -> Bool isRTSWay :: WayName -> Bool
isRTSWay = wayRTSOnly . lkupWay isRTSWay = wayRTSOnly . lkupWay
data Way = Way { data Way = Way {
wayName :: WayName, wayName :: WayName,
...@@ -496,10 +496,10 @@ way_details = ...@@ -496,10 +496,10 @@ way_details =
Way WayDyn "dyn" False "Dynamic" Way WayDyn "dyn" False "Dynamic"
[ "-DDYNAMIC" [ "-DDYNAMIC"
, "-optc-DDYNAMIC" , "-optc-DDYNAMIC"
#if defined(mingw32_TARGET_OS) #if defined(mingw32_TARGET_OS)
-- On Windows, code that is to be linked into a dynamic library must be compiled -- 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 -- with -fPIC. Labels not in the current package are assumed to be in a DLL
-- different from the current one. -- different from the current one.
, "-fPIC" , "-fPIC"
#elif defined(openbsd_TARGET_OS) #elif defined(openbsd_TARGET_OS)
...@@ -518,7 +518,7 @@ way_details = ...@@ -518,7 +518,7 @@ way_details =
[ "-DTRACING" [ "-DTRACING"
, "-optc-DTRACING" ], , "-optc-DTRACING" ],
Way WayPar "mp" False "Parallel" Way WayPar "mp" False "Parallel"
[ "-fparallel" [ "-fparallel"
, "-D__PARALLEL_HASKELL__" , "-D__PARALLEL_HASKELL__"
, "-optc-DPAR" , "-optc-DPAR"
...@@ -529,7 +529,7 @@ way_details = ...@@ -529,7 +529,7 @@ way_details =
, "-optl-lgpvm3" ], , "-optl-lgpvm3" ],
-- at the moment we only change the RTS and could share compiler and libs! -- at the moment we only change the RTS and could share compiler and libs!
Way WayPar "mt" False "Parallel ticky profiling" Way WayPar "mt" False "Parallel ticky profiling"
[ "-fparallel" [ "-fparallel"
, "-D__PARALLEL_HASKELL__" , "-D__PARALLEL_HASKELL__"
, "-optc-DPAR" , "-optc-DPAR"
...@@ -540,7 +540,7 @@ way_details = ...@@ -540,7 +540,7 @@ way_details =
, "-optl-lpvm3" , "-optl-lpvm3"
, "-optl-lgpvm3" ], , "-optl-lgpvm3" ],
Way WayPar "md" False "Distributed" Way WayPar "md" False "Distributed"
[ "-fparallel" [ "-fparallel"
, "-D__PARALLEL_HASKELL__" , "-D__PARALLEL_HASKELL__"
, "-D__DISTRIBUTED_HASKELL__" , "-D__DISTRIBUTED_HASKELL__"
...@@ -580,3 +580,4 @@ restoreStaticFlagGlobals (c_ready, c, ways) = do ...@@ -580,3 +580,4 @@ restoreStaticFlagGlobals (c_ready, c, ways) = do
writeIORef v_opt_C_ready c_ready writeIORef v_opt_C_ready c_ready
writeIORef v_opt_C c writeIORef v_opt_C c
writeIORef v_Ways ways writeIORef v_Ways ways
This diff is collapsed.
<
...@@ -182,13 +182,13 @@ main' postLoadMode dflags0 args flagWarnings = do ...@@ -182,13 +182,13 @@ main' postLoadMode dflags0 args flagWarnings = do
hsc_env <- GHC.getSession hsc_env <- GHC.getSession
let let
-- To simplify the handling of filepaths, we normalise all filepaths right -- To simplify the handling of filepaths, we normalise all filepaths right