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
--------------------------------------------------------
-- The EwM monad
-- The EwM monad
--------------------------------------------------------
type Err = Located String
......@@ -84,7 +84,7 @@ addWarn msg = EwM (\(L loc _) es ws -> return (es, ws `snocBag` L loc w, ()))
w = "Warning: " ++ msg
deprecate :: Monad m => String -> EwM m ()
deprecate s
deprecate s
= do arg <- getArg
addWarn (arg ++ " is deprecated: " ++ s)
......@@ -146,9 +146,9 @@ processArgs spec args
let b = process rest spare
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]
......
......@@ -81,7 +81,7 @@ module DynFlags (
-- * Compiler configuration suitable for display to the user
compilerInfo
#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
, rtsIsProfiled
#endif
......@@ -384,7 +384,7 @@ data ExtensionFlag
| Opt_DoAndIfThenElse
| Opt_RebindableSyntax
| Opt_ConstraintKinds
| Opt_StandaloneDeriving
| Opt_DeriveDataTypeable
| Opt_DeriveFunctor
......@@ -802,7 +802,7 @@ defaultDynFlags mySettings =
maxSimplIterations = 4,
shouldDumpSimplPhase = Nothing,
ruleCheck = Nothing,
simplTickFactor = 100,
simplTickFactor = 100,
specConstrThreshold = Just 2000,
specConstrCount = Just 3,
liberateCaseThreshold = Just 2000,
......@@ -1303,9 +1303,9 @@ allFlags = map ('-':) $
dynamic_flags :: [Flag (CmdLineP DynFlags)]
dynamic_flags = [
Flag "n" (NoArg (addWarn "The -n flag is deprecated and no longer has any effect"))
, Flag "cpp" (NoArg (setExtensionFlag Opt_Cpp))
, Flag "F" (NoArg (setDynFlag Opt_Pp))
, Flag "#include"
, Flag "cpp" (NoArg (setExtensionFlag Opt_Cpp))
, Flag "F" (NoArg (setDynFlag Opt_Pp))
, Flag "#include"
(HasArg (\s -> do addCmdlineHCInclude s
addWarn "-#include and INCLUDE pragmas are deprecated: They no longer have any effect"))
, Flag "v" (OptIntSuffix setVerbosity)
......@@ -1338,7 +1338,7 @@ dynamic_flags = [
, Flag "optwindres" (hasArg (\f -> alterSettings (\s -> s { sOpt_windres = f : sOpt_windres s})))
, Flag "split-objs"
(NoArg (if can_split
(NoArg (if can_split
then setDynFlag Opt_SplitObjs
else addWarn "ignoring -fsplit-objs"))
......@@ -1532,7 +1532,7 @@ dynamic_flags = [
------ Plugin flags ------------------------------------------------
, Flag "fplugin-opt" (hasArg addPluginModuleNameOption)
, Flag "fplugin" (hasArg addPluginModuleName)
------ Optimisation flags ------------------------------------------
, Flag "O" (noArgM (setOptLevel 1))
, Flag "Onot" (noArgM (\dflags -> do deprecate "Use -O0 instead"
......@@ -1646,7 +1646,7 @@ mkFlag turn_on flagPrefix f (name, flag, extra_action)
deprecatedForExtension :: String -> TurnOnFlag -> DynP ()
deprecatedForExtension lang turn_on
= deprecate ("use -X" ++ flag ++ " or pragma {-# LANGUAGE " ++ flag ++ " #-} instead")
where
where
flag | turn_on = lang
| otherwise = "No"++lang
......@@ -1833,11 +1833,11 @@ xFlags = [
( "LiberalTypeSynonyms", Opt_LiberalTypeSynonyms, nop ),
( "Rank2Types", Opt_Rank2Types, nop ),
( "RankNTypes", Opt_RankNTypes, nop ),
( "ImpredicativeTypes", Opt_ImpredicativeTypes, nop),
( "ImpredicativeTypes", Opt_ImpredicativeTypes, nop),
( "TypeOperators", Opt_TypeOperators, nop ),
( "RecursiveDo", Opt_RecursiveDo, -- Enables 'mdo'
deprecatedForExtension "DoRec"),
( "DoRec", Opt_DoRec, nop ), -- Enables 'rec' keyword
( "DoRec", Opt_DoRec, nop ), -- Enables 'rec' keyword
( "Arrows", Opt_Arrows, nop ),
( "ParallelArrays", Opt_ParallelArrays, nop ),
( "TemplateHaskell", Opt_TemplateHaskell, checkTemplateHaskellOk ),
......@@ -1859,7 +1859,7 @@ xFlags = [
( "DoAndIfThenElse", Opt_DoAndIfThenElse, nop ),
( "RebindableSyntax", Opt_RebindableSyntax, nop ),
( "ConstraintKinds", Opt_ConstraintKinds, nop ),
( "MonoPatBinds", Opt_MonoPatBinds,
( "MonoPatBinds", Opt_MonoPatBinds,
\ turn_on -> when turn_on $ deprecate "Experimental feature now removed; has no effect" ),
( "ExplicitForAll", Opt_ExplicitForAll, nop ),
( "AlternativeLayoutRule", Opt_AlternativeLayoutRule, nop ),
......@@ -1870,15 +1870,15 @@ xFlags = [
( "RelaxedLayout", Opt_RelaxedLayout, nop ),
( "TraditionalRecordSyntax", Opt_TraditionalRecordSyntax, nop ),
( "MonoLocalBinds", Opt_MonoLocalBinds, nop ),
( "RelaxedPolyRec", Opt_RelaxedPolyRec,
\ turn_on -> if not turn_on
( "RelaxedPolyRec", Opt_RelaxedPolyRec,
\ turn_on -> if not turn_on
then deprecate "You can't turn off RelaxedPolyRec any more"
else return () ),
( "ExtendedDefaultRules", Opt_ExtendedDefaultRules, nop ),
( "ImplicitParams", Opt_ImplicitParams, nop ),
( "ScopedTypeVariables", Opt_ScopedTypeVariables, nop ),
( "PatternSignatures", Opt_ScopedTypeVariables,
( "PatternSignatures", Opt_ScopedTypeVariables,
deprecatedForExtension "ScopedTypeVariables" ),
( "UnboxedTuples", Opt_UnboxedTuples, nop ),
......@@ -1903,7 +1903,7 @@ xFlags = [
]
defaultFlags :: [DynFlag]
defaultFlags
defaultFlags
= [ Opt_AutoLinkPackages,
Opt_ReadUserPackageConf,
......@@ -1951,7 +1951,7 @@ impliedFlags
-- stuff like " 'a' not in scope ", which is a bit silly
-- if the compiler has just filled in field 'a' of constructor 'C'
, (Opt_RecordWildCards, turnOn, Opt_DisambiguateRecordFields)
, (Opt_ParallelArrays, turnOn, Opt_ParallelListComp)
]
......@@ -2189,8 +2189,8 @@ setDumpFlag' dump_flag
Opt_D_dump_hi_diffs]
forceRecompile :: DynP ()
-- Whenver we -ddump, force recompilation (by switching off the
-- recompilation checker), else you don't see the dump! However,
-- Whenver we -ddump, force recompilation (by switching off the
-- recompilation checker), else you don't see the dump! However,
-- don't switch it off in --make mode, else *everything* gets
-- recompiled which probably isn't what you want
forceRecompile = do dfs <- liftEwM getCmdLineState
......@@ -2200,7 +2200,7 @@ forceRecompile = do dfs <- liftEwM getCmdLineState
setVerboseCore2Core :: DynP ()
setVerboseCore2Core = do forceRecompile
setDynFlag Opt_D_verbose_core2core
setDynFlag Opt_D_verbose_core2core
upd (\dfs -> dfs { shouldDumpSimplPhase = Nothing })
setDumpSimplPhases :: String -> DynP ()
......@@ -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.
--
dphPackageMaybe :: DynFlags -> Maybe PackageId
dphPackageMaybe dflags
dphPackageMaybe dflags
= case dphBackend dflags of
DPHPar -> Just dphParPackageId
DPHSeq -> Just dphSeqPackageId
......
......@@ -77,7 +77,7 @@ parseStaticFlags args = do
| 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
-- 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 = map (mkGeneralLocated "in excess_prec")
......@@ -104,11 +104,11 @@ static_flags :: [Flag IO]
static_flags = [
------- GHCi -------------------------------------------------------
Flag "ignore-dot-ghci" (PassFlag addOpt)
Flag "ignore-dot-ghci" (PassFlag addOpt)
, Flag "read-dot-ghci" (NoArg (removeOpt "-ignore-dot-ghci"))
------- ways --------------------------------------------------------
, Flag "prof" (NoArg (addWay WayProf))
, Flag "prof" (NoArg (addWay WayProf))
, Flag "eventlog" (NoArg (addWay WayEventLog))
, Flag "parallel" (NoArg (addWay WayPar))
, Flag "gransim" (NoArg (addWay WayGran))
......@@ -147,7 +147,7 @@ static_flags = [
----- RTS opts ------------------------------------------------------
, Flag "H" (HasArg (\s -> liftEwM (setHeapSize (fromIntegral (decodeSize s)))))
, Flag "Rghc-timing" (NoArg (liftEwM enableTimingStats))
------ Compiler flags -----------------------------------------------
......@@ -159,7 +159,7 @@ static_flags = [
-- All other "-fno-<blah>" options cancel out "-f<blah>" on the hsc cmdline
, Flag "fno-"
(PrefixPred (\s -> isStaticFlag ("f"++s)) (\s -> removeOpt ("-f"++s)))
-- Pass all remaining "-f<blah>" options to hsc
, Flag "f" (AnySuffixPred isStaticFlag addOpt)
......
......@@ -24,7 +24,7 @@ module StaticFlags (
opt_PprCols,
opt_PprCaseAsLet,
opt_PprStyle_Debug, opt_TraceLevel,
opt_NoDebugOutput,
opt_NoDebugOutput,
-- Suppressing boring aspects of core dumps
opt_SuppressAll,
......@@ -85,7 +85,7 @@ module StaticFlags (
-- For the parser
addOpt, removeOpt, addWay, getWayFlags, v_opt_C_ready,
-- Saving/restoring globals
saveStaticFlagGlobals, restoreStaticFlagGlobals
) where
......@@ -119,7 +119,7 @@ addWay = consIORef v_Ways . lkupWay
removeOpt :: String -> IO ()
removeOpt f = do
fs <- readIORef v_opt_C
writeIORef v_opt_C $! filter (/= f) fs
writeIORef v_opt_C $! filter (/= f) fs
lookUp :: FastString -> Bool
lookup_def_int :: String -> Int -> Int
......@@ -147,14 +147,14 @@ packed_static_opts :: [FastString]
packed_static_opts = map mkFastString staticFlags
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
lookup_str sw
lookup_str sw
= case firstJusts (map (stripPrefix sw) staticFlags) of
Just ('=' : str) -> Just str
Just str -> Just str
Nothing -> Nothing
Nothing -> Nothing
lookup_all_str sw = map f $ catMaybes (map (stripPrefix sw) staticFlags) where
f ('=' : str) = str
......@@ -198,7 +198,7 @@ unpacked_opts =
opt_IgnoreDotGhci :: Bool
opt_IgnoreDotGhci = lookUp (fsLit "-ignore-dot-ghci")
opt_GhciScripts :: [String]
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
-- have otherwise identical names.
opt_SuppressAll :: Bool
opt_SuppressAll
opt_SuppressAll
= lookUp (fsLit "-dsuppress-all")
-- | Suppress all coercions, them replacing with '...'
opt_SuppressCoercions :: Bool
opt_SuppressCoercions
= lookUp (fsLit "-dsuppress-all")
= lookUp (fsLit "-dsuppress-all")
|| lookUp (fsLit "-dsuppress-coercions")
-- | Suppress module id prefixes on variables.
......@@ -230,7 +230,7 @@ opt_SuppressTypeApplications
-- | Suppress info such as arity and unfoldings on identifiers.
opt_SuppressIdInfo :: Bool
opt_SuppressIdInfo
opt_SuppressIdInfo
= lookUp (fsLit "-dsuppress-all")
|| lookUp (fsLit "-dsuppress-idinfo")
......@@ -254,10 +254,10 @@ opt_PprCaseAsLet = lookUp (fsLit "-dppr-case-as-let")
-- | Set the maximum width of the dumps
-- 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
-- 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.
opt_PprCols :: Int
opt_PprCols
opt_PprCols
= unsafePerformIO
$ do ready <- readIORef v_opt_C_ready
if (not ready)
......@@ -287,7 +287,7 @@ opt_SccProfilingOn = lookUp (fsLit "-fscc-profiling")
-- Hpc opts
opt_Hpc :: Bool
opt_Hpc = lookUp (fsLit "-fhpc")
opt_Hpc = lookUp (fsLit "-fhpc")
-- language opts
opt_DictsStrict :: Bool
......@@ -369,7 +369,7 @@ 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
-- indirection to the entry code. See TABLES_NEXT_TO_CODE in
-- includes/rts/storage/InfoTables.h.
tablesNextToCode :: Bool
tablesNextToCode = not opt_Unregisterised
......@@ -417,7 +417,7 @@ data WayName
GLOBAL_VAR(v_Ways, [] ,[Way])
allowed_combination :: [WayName] -> Bool
allowed_combination way = and [ x `allowedWith` y
allowed_combination way = and [ x `allowedWith` y
| x <- way, y <- way, x < y ]
where
-- Note ordering in these tests: the left argument is
......@@ -448,7 +448,7 @@ getWayFlags = do
if not (allowed_combination (map wayName ways))
then ghcError (CmdLineError $
"combination not supported: " ++
foldr1 (\a b -> a ++ '/':b)
foldr1 (\a b -> a ++ '/':b)
(map wayDesc ways))
else
return (concatMap wayOpts ways)
......@@ -457,13 +457,13 @@ mkBuildTag :: [Way] -> String
mkBuildTag ways = concat (intersperse "_" (map wayTag ways))
lkupWay :: WayName -> Way
lkupWay w =
lkupWay w =
case listToMaybe (filter ((==) w . wayName) way_details) of
Nothing -> error "findBuildTag"
Just details -> details
isRTSWay :: WayName -> Bool
isRTSWay = wayRTSOnly . lkupWay
isRTSWay = wayRTSOnly . lkupWay
data Way = Way {
wayName :: WayName,
......@@ -496,10 +496,10 @@ way_details =
Way WayDyn "dyn" False "Dynamic"
[ "-DDYNAMIC"
, "-optc-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
-- 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)
......@@ -518,7 +518,7 @@ way_details =
[ "-DTRACING"
, "-optc-DTRACING" ],
Way WayPar "mp" False "Parallel"
Way WayPar "mp" False "Parallel"
[ "-fparallel"
, "-D__PARALLEL_HASKELL__"
, "-optc-DPAR"
......@@ -529,7 +529,7 @@ way_details =
, "-optl-lgpvm3" ],
-- 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"
, "-D__PARALLEL_HASKELL__"
, "-optc-DPAR"
......@@ -540,7 +540,7 @@ way_details =
, "-optl-lpvm3"
, "-optl-lgpvm3" ],
Way WayPar "md" False "Distributed"
Way WayPar "md" False "Distributed"
[ "-fparallel"
, "-D__PARALLEL_HASKELL__"
, "-D__DISTRIBUTED_HASKELL__"
......@@ -580,3 +580,4 @@ restoreStaticFlagGlobals (c_ready, c, ways) = do
writeIORef v_opt_C_ready c_ready
writeIORef v_opt_C c
writeIORef v_Ways ways
This diff is collapsed.
......@@ -182,13 +182,13 @@ main' postLoadMode dflags0 args flagWarnings = do
hsc_env <- GHC.getSession
let
-- To simplify the handling of filepaths, we normalise all filepaths right
-- To simplify the handling of filepaths, we normalise all filepaths right
-- away - e.g., for win32 platforms, backslashes are converted
-- into forward slashes.
normal_fileish_paths = map (normalise . unLoc) fileish_args
(srcs, objs) = partition_args normal_fileish_paths [] []
-- Note: have v_Ld_inputs maintain the order in which 'objs' occurred on
-- Note: have v_Ld_inputs maintain the order in which 'objs' occurred on
-- the command-line.
liftIO $ mapM_ (consIORef v_Ld_inputs) (reverse objs)
......@@ -236,7 +236,7 @@ partition_args ("-x":suff:args) srcs objs
| StopLn <- phase = partition_args args srcs (slurp ++ objs)
| otherwise = partition_args rest (these_srcs ++ srcs) objs
where phase = startPhase suff
(slurp,rest) = break (== "-x") args
(slurp,rest) = break (== "-x") args
these_srcs = zip slurp (repeat (Just phase))
partition_args (arg:args) srcs objs
| looks_like_an_input arg = partition_args args ((arg,Nothing):srcs) objs
......@@ -248,7 +248,7 @@ partition_args (arg:args) srcs objs
The following things should be considered compilation manager inputs:
- haskell source files (strings ending in .hs, .lhs or other
- haskell source files (strings ending in .hs, .lhs or other
haskellish extension),
- module names (not forgetting hierarchical module names),
......@@ -260,7 +260,7 @@ partition_args (arg:args) srcs objs
straight through to the linker.
-}
looks_like_an_input :: String -> Bool
looks_like_an_input m = isSourceFilename m
looks_like_an_input m = isSourceFilename m
|| looksLikeModuleName m
|| '.' `notElem` m
......@@ -284,10 +284,10 @@ checkOptions mode dflags srcs objs = do
-- -prof and --interactive are not a good combination
when (notNull (filter (not . isRTSWay) (wayNames dflags))
&& isInterpretiveMode mode) $
do ghcError (UsageError
do ghcError (UsageError
"--interactive can't be used with -prof or -unreg.")
-- -ohi sanity check
if (isJust (outputHi dflags) &&
if (isJust (outputHi dflags) &&
(isCompManagerMode mode || srcs `lengthExceeds` 1))
then ghcError (UsageError "-ohi can only be used when compiling a single source file")
else do
......@@ -316,12 +316,12 @@ checkOptions mode dflags srcs objs = do
-- Compiler output options
-- called to verify that the output files & directories
-- point somewhere valid.
-- 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 :: DynFlags -> IO ()
verifyOutputFiles dflags = do
-- not -odir: we create the directory for -odir if it doesn't exist (#2278).
......@@ -336,9 +336,9 @@ verifyOutputFiles dflags = do
flg <- doesDirNameExist hi
when (not flg) (nonExistentDir "-ohi" hi)
where
nonExistentDir flg dir =
ghcError (CmdLineError ("error: directory portion of " ++
show dir ++ " does not exist (used with " ++
nonExistentDir flg dir =
ghcError (CmdLineError ("error: directory portion of " ++
show dir ++ " does not exist (used with " ++
show flg ++ " option.)"))
-----------------------------------------------------------------------------
......@@ -603,9 +603,9 @@ doMake :: [(String,Maybe Phase)] -> Ghc ()
doMake srcs = do
let (hs_srcs, non_hs_srcs) = partition haskellish srcs
haskellish (f,Nothing) =
haskellish (f,Nothing) =
looksLikeModuleName f || isHaskellSrcFilename f || '.' `notElem` f
haskellish (_,Just phase) =
haskellish (_,Just phase) =
phase `notElem` [As, Cc, Cobjc, Cobjcpp, CmmCpp, Cmm, StopLn]
hsc_env <- GHC.getSession
......@@ -690,7 +690,7 @@ showUsage ghci dflags = do
dump (c:s) = putChar c >> dump s
dumpFinalStats :: DynFlags -> IO ()
dumpFinalStats dflags =
dumpFinalStats dflags =
when (dopt Opt_D_faststring_stats dflags) $ dumpFastStringStats dflags
dumpFastStringStats :: DynFlags -> IO ()
......@@ -715,7 +715,7 @@ dumpFastStringStats dflags = do
countFS :: Int -> Int -> Int -> Int -> [[FastString]] -> (Int, Int, Int, Int)
countFS entries longest is_z has_z [] = (entries, longest, is_z, has_z)
countFS entries longest is_z has_z (b:bs) =
countFS entries longest is_z has_z (b:bs) =
let
len = length b
longest' = max len longest
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment