Option(..),
DynLibLoader(..),
fFlags, xFlags,
+ DPHBackend(..),
-- Configuration of the core-to-core and stg-to-stg phases
CoreToDo(..),
import Data.Char
import System.FilePath
-import System.IO ( hPutStrLn, stderr )
+import System.IO ( stderr, hPutChar )
-- -----------------------------------------------------------------------------
-- DynFlags
| Opt_WarnUnusedBinds
| Opt_WarnUnusedImports
| Opt_WarnUnusedMatches
- | Opt_WarnDeprecations
+ | Opt_WarnWarningsDeprecations
| Opt_WarnDeprecatedFlags
| Opt_WarnDodgyImports
| Opt_WarnOrphans
| Opt_WarnTabs
+ | Opt_WarnDodgyForeignImports
-- language opts
| Opt_OverlappingInstances
| Opt_TransformListComp
| Opt_GeneralizedNewtypeDeriving
| Opt_RecursiveDo
+ | Opt_PostfixOperators
| Opt_PatternGuards
| Opt_LiberalTypeSynonyms
| Opt_Rank2Types
| Opt_EmbedManifest
| Opt_RunCPSZ
| Opt_ConvertToZipCfgAndBack
+ | Opt_AutoLinkPackages
-- keeping stuff
| Opt_KeepHiDiffs
mainFunIs :: Maybe String,
ctxtStkDepth :: Int, -- Typechecker context stack depth
+ dphBackend :: DPHBackend,
+
thisPackage :: PackageId,
-- ways
mainFunIs = Nothing,
ctxtStkDepth = mAX_CONTEXT_REDUCTION_DEPTH,
+ dphBackend = DPHPar,
+
thisPackage = mainPackageId,
objectDir = Nothing,
-- end of initSysTools values
haddockOptions = Nothing,
flags = [
+ Opt_AutoLinkPackages,
Opt_ReadUserPackageConf,
Opt_MonoPatBinds, -- Experimentally, I'm making this non-standard
log_action = \severity srcSpan style msg ->
case severity of
- SevInfo -> hPutStrLn stderr (show (msg style))
- SevFatal -> hPutStrLn stderr (show (msg style))
- _ -> hPutStrLn stderr ('\n':show ((mkLocMessage srcSpan msg) style))
+ SevInfo -> printErrs (msg style)
+ SevFatal -> printErrs (msg style)
+ _ -> do
+ hPutChar stderr '\n'
+ printErrs ((mkLocMessage srcSpan msg) style)
+ -- careful (#2302): printErrs prints in UTF-8, whereas
+ -- converting to string first and using hPutStr would
+ -- just emit the low 8 bits of each unicode char.
}
{-
setHiDir f d = d{ hiDir = Just f}
setStubDir f d = d{ stubDir = Just f, includePaths = f : includePaths d }
-- -stubdir D adds an implicit -I D, so that gcc can find the _stub.h file
- -- #included from the .hc file when compiling with -fvia-C.
+ -- \#included from the .hc file when compiling with -fvia-C.
setObjectSuf f d = d{ objectSuf = f}
setHiSuf f d = d{ hiSuf = f}
standardWarnings :: [DynFlag]
standardWarnings
- = [ Opt_WarnDeprecations,
+ = [ Opt_WarnWarningsDeprecations,
Opt_WarnDeprecatedFlags,
Opt_WarnOverlappingPatterns,
Opt_WarnMissingFields,
Opt_WarnMissingMethods,
- Opt_WarnDuplicateExports
+ Opt_WarnDuplicateExports,
+ Opt_WarnDodgyForeignImports
]
minusWOpts :: [DynFlag]
| CoreCSE
| CoreDoRuleCheck Int{-CompilerPhase-} String -- Check for non-application of rules
-- matching this string
- | CoreDoVectorisation
+ | CoreDoVectorisation DPHBackend
| CoreDoNothing -- Useful when building up
| CoreDoPasses [CoreToDo] -- lists of these things
spec_constr = dopt Opt_SpecConstr dflags
liberate_case = dopt Opt_LiberateCase dflags
rule_check = ruleCheck dflags
- vectorisation = dopt Opt_Vectorise dflags
static_args = dopt Opt_StaticArgumentTransformation dflags
maybe_rule_check phase = runMaybe rule_check (CoreDoRuleCheck phase)
maybe_rule_check phase
]
+ vectorisation
+ = runWhen (dopt Opt_Vectorise dflags)
+ $ CoreDoPasses [ simpl_gently, CoreDoVectorisation (dphBackend dflags) ]
+
+
-- By default, we have 2 phases before phase 0.
-- Want to run with inline phase 2 after the specialiser to give
core_todo =
if opt_level == 0 then
- [runWhen vectorisation (CoreDoPasses [ simpl_gently, CoreDoVectorisation ]),
+ [vectorisation,
simpl_phase 0 ["final"] max_iter]
else {- opt_level >= 1 -} [
-- after this before anything else
runWhen static_args (CoreDoPasses [ simpl_gently, CoreDoStaticArgs ]),
- -- initial simplify: mk specialiser happy: minimum effort please
- simpl_gently,
-
-- We run vectorisation here for now, but we might also try to run
-- it later
- runWhen vectorisation (CoreDoPasses [ CoreDoVectorisation, simpl_gently ]),
+ vectorisation,
+
+ -- initial simplify: mk specialiser happy: minimum effort please
+ simpl_gently,
-- Specialisation is best done before full laziness
-- so that overloaded functions have all their dictionary lambdas manifest
, Flag "keep-tmp-files" (NoArg (setDynFlag Opt_KeepTmpFiles)) Supported
------- Miscellaneous ----------------------------------------------
+ , Flag "no-auto-link-packages" (NoArg (unSetDynFlag Opt_AutoLinkPackages)) Supported
, Flag "no-hs-main" (NoArg (setDynFlag Opt_NoHsMain)) Supported
, Flag "main-is" (SepArg setMainIs ) Supported
, Flag "haddock" (NoArg (setDynFlag Opt_Haddock)) Supported
(IntSuffix $ \n -> upd $ \dfs -> dfs{ ctxtStkDepth = n })
Supported
+ ------ DPH flags ----------------------------------------------------
+
+ , Flag "fdph-seq"
+ (NoArg (upd (setDPHBackend DPHSeq)))
+ Supported
+ , Flag "fdph-par"
+ (NoArg (upd (setDPHBackend DPHPar)))
+ Supported
+
------ Compiler flags -----------------------------------------------
, Flag "fasm" (NoArg (setObjTarget HscAsm)) Supported
fFlags :: [(String, DynFlag, Bool -> Deprecated)]
fFlags = [
+ ( "warn-dodgy-foreign-imports", Opt_WarnDodgyForeignImports, const Supported ),
( "warn-dodgy-imports", Opt_WarnDodgyImports, const Supported ),
( "warn-duplicate-exports", Opt_WarnDuplicateExports, const Supported ),
( "warn-hi-shadowing", Opt_WarnHiShadows, const Supported ),
( "warn-unused-binds", Opt_WarnUnusedBinds, const Supported ),
( "warn-unused-imports", Opt_WarnUnusedImports, const Supported ),
( "warn-unused-matches", Opt_WarnUnusedMatches, const Supported ),
- ( "warn-deprecations", Opt_WarnDeprecations, const Supported ),
+ ( "warn-warnings-deprecations", Opt_WarnWarningsDeprecations, const Supported ),
( "warn-deprecated-flags", Opt_WarnDeprecatedFlags, const Supported ),
( "warn-orphans", Opt_WarnOrphans, const Supported ),
( "warn-tabs", Opt_WarnTabs, const Supported ),
xFlags :: [(String, DynFlag, Bool -> Deprecated)]
xFlags = [
( "CPP", Opt_Cpp, const Supported ),
+ ( "PostfixOperators", Opt_PostfixOperators, const Supported ),
( "PatternGuards", Opt_PatternGuards, const Supported ),
( "UnicodeSyntax", Opt_UnicodeSyntax, const Supported ),
( "MagicHash", Opt_MagicHash, const Supported ),
, Opt_PolymorphicComponents
, Opt_ExistentialQuantification
, Opt_UnicodeSyntax
+ , Opt_PostfixOperators
, Opt_PatternGuards
, Opt_LiberalTypeSynonyms
, Opt_RankNTypes
`dopt_set` Opt_DictsCheap
`dopt_unset` Opt_MethodSharing
+data DPHBackend = DPHPar
+ | DPHSeq
+
+setDPHBackend :: DPHBackend -> DynFlags -> DynFlags
+setDPHBackend backend dflags = dflags { dphBackend = backend }
setMainIs :: String -> DynP ()
sta = opt_Static
in
( [ if sta then "-DDONT_WANT_WIN32_DLL_SUPPORT" else ""
--- , if "mingw32" `isSuffixOf` cTARGETPLATFORM then "-mno-cygwin" else ""
],
[ "-fno-defer-pop",
"-fomit-frame-pointer",