{-# OPTIONS -fno-warn-missing-fields #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
-----------------------------------------------------------------------------
--
-- Dynamic flags
GhcLink(..), isNoLink,
PackageFlag(..),
Option(..),
+ DynLibLoader(..),
+ fFlags, xFlags,
-- Configuration of the core-to-core and stg-to-stg phases
CoreToDo(..),
allFlags,
-- misc stuff
- machdepCCOpts, picCCOpts
+ machdepCCOpts, picCCOpts,
+ supportedLanguages,
+ compilerInfo,
) where
#include "HsVersions.h"
-import Module ( Module, mkModuleName, mkModule )
+import Module
import PackageConfig
import PrelNames ( mAIN )
#ifdef i386_TARGET_ARCH
import Constants ( mAX_CONTEXT_REDUCTION_DEPTH )
import Panic ( panic, GhcException(..) )
import UniqFM ( UniqFM )
-import Util ( notNull, splitLongestPrefix, normalisePath )
+import Util
import Maybes ( orElse, fromJust )
import SrcLoc ( SrcSpan )
import Outputable
import Data.IORef ( readIORef )
import Control.Exception ( throwDyn )
import Control.Monad ( when )
-#ifdef mingw32_TARGET_OS
-import Data.List ( isPrefixOf )
-#else
-import Util ( split )
-#endif
-import Data.Char ( isUpper, toLower )
+import Data.Char
+import System.FilePath
import System.IO ( hPutStrLn, stderr )
-- -----------------------------------------------------------------------------
-- debugging flags
= Opt_D_dump_cmm
+ | Opt_D_dump_cmmz
+ | Opt_D_dump_cmmz_pretty
| Opt_D_dump_cps_cmm
+ | Opt_D_dump_cvt_cmm
| Opt_D_dump_asm
+ | Opt_D_dump_asm_native
+ | Opt_D_dump_asm_liveness
+ | Opt_D_dump_asm_coalesce
+ | Opt_D_dump_asm_regalloc
+ | Opt_D_dump_asm_regalloc_stages
+ | Opt_D_dump_asm_conflicts
+ | Opt_D_dump_asm_stats
| Opt_D_dump_cpranal
| Opt_D_dump_deriv
| Opt_D_dump_ds
| Opt_D_dump_rn
| Opt_D_dump_simpl
| Opt_D_dump_simpl_iterations
+ | Opt_D_dump_simpl_phases
| Opt_D_dump_spec
| Opt_D_dump_prep
| Opt_D_dump_stg
| Opt_D_dump_hi_diffs
| Opt_D_dump_minimal_imports
| Opt_D_dump_mod_cycles
+ | Opt_D_dump_view_pattern_commoning
| Opt_D_faststring_stats
+ | Opt_DumpToFile -- ^ Append dump output to files instead of stdout.
| Opt_DoCoreLinting
| Opt_DoStgLinting
| Opt_DoCmmLinting
+ | Opt_DoAsmLinting
- | Opt_WarnIsError -- -Werror; makes warnings fatal
+ | Opt_WarnIsError -- -Werror; makes warnings fatal
| Opt_WarnDuplicateExports
| Opt_WarnHiShadows
| Opt_WarnImplicitPrelude
| Opt_WarnTabs
-- language opts
- | Opt_AllowOverlappingInstances
- | Opt_AllowUndecidableInstances
- | Opt_AllowIncoherentInstances
+ | Opt_OverlappingInstances
+ | Opt_UndecidableInstances
+ | Opt_IncoherentInstances
| Opt_MonomorphismRestriction
| Opt_MonoPatBinds
| Opt_ExtendedDefaultRules -- Use GHC's extended rules for defaulting
- | Opt_GlasgowExts
- | Opt_FFI
+ | Opt_ForeignFunctionInterface
+ | Opt_UnliftedFFITypes
| Opt_PArr -- Syntactic support for parallel arrays
| Opt_Arrows -- Arrow-notation syntax
- | Opt_TH
+ | Opt_TemplateHaskell
+ | Opt_QuasiQuotes
| Opt_ImplicitParams
| Opt_Generics
| Opt_ImplicitPrelude
| Opt_ScopedTypeVariables
+ | Opt_UnboxedTuples
| Opt_BangPatterns
| Opt_TypeFamilies
| Opt_OverloadedStrings
| Opt_DisambiguateRecordFields
| Opt_RecordWildCards
| Opt_RecordPuns
+ | Opt_ViewPatterns
| Opt_GADTs
- | Opt_RelaxedPolyRec -- -X=RelaxedPolyRec
+ | Opt_RelaxedPolyRec
+ | Opt_StandaloneDeriving
+ | Opt_DeriveDataTypeable
| Opt_TypeSynonymInstances
| Opt_FlexibleContexts
| Opt_FlexibleInstances
+ | Opt_ConstrainedClassMethods
| Opt_MultiParamTypeClasses
| Opt_FunctionalDependencies
| Opt_UnicodeSyntax
| Opt_MagicHash
| Opt_EmptyDataDecls
| Opt_KindSignatures
+ | Opt_PatternSignatures
| Opt_ParallelListComp
+ | Opt_TransformListComp
| Opt_GeneralizedNewtypeDeriving
| Opt_RecursiveDo
| Opt_PatternGuards
+ | Opt_LiberalTypeSynonyms
| Opt_Rank2Types
| Opt_RankNTypes
+ | Opt_ImpredicativeTypes
| Opt_TypeOperators
| Opt_PrintExplicitForalls
-- optimisation opts
| Opt_Strictness
| Opt_FullLaziness
+ | Opt_StaticArgumentTransformation
| Opt_CSE
| Opt_LiberateCase
| Opt_SpecConstr
| Opt_OmitInterfacePragmas
| Opt_DoLambdaEtaExpansion
| Opt_IgnoreAsserts
- | Opt_IgnoreBreakpoints
| Opt_DoEtaReduction
| Opt_CaseMerge
| Opt_UnboxStrictFields
| Opt_DictsCheap
| Opt_RewriteRules
| Opt_Vectorise
+ | Opt_RegsGraph -- do graph coloring register allocation
+ | Opt_RegsIterative -- do iterative coalescing graph coloring register allocation
-- misc opts
| Opt_Cpp
| Opt_HideAllPackages
| Opt_PrintBindResult
| Opt_Haddock
+ | Opt_HaddockOptions
| Opt_Hpc_No_Auto
| Opt_BreakOnException
+ | Opt_BreakOnError
+ | Opt_PrintEvldWithShow
+ | Opt_PrintBindContents
+ | Opt_GenManifest
+ | Opt_EmbedManifest
+ | Opt_RunCPSZ
+ | Opt_ConvertToZipCfgAndBack
-- keeping stuff
| Opt_KeepHiDiffs
| Opt_KeepRawSFiles
| Opt_KeepTmpFiles
- deriving (Eq)
+ deriving (Eq, Show)
data DynFlags = DynFlags {
ghcMode :: GhcMode,
extCoreName :: String, -- name of the .core output file
verbosity :: Int, -- verbosity level
optLevel :: Int, -- optimisation level
+ simplPhases :: Int, -- number of simplifier phases
maxSimplIterations :: Int, -- max simplifier iterations
+ shouldDumpSimplPhase :: SimplifierMode -> Bool,
ruleCheck :: Maybe String,
- specThreshold :: Int, -- Threshold for function specialisation
+ specConstrThreshold :: Maybe Int, -- Threshold for SpecConstr
+ specConstrCount :: Maybe Int, -- Max number of specialisations for any one function
+ liberateCaseThreshold :: Maybe Int, -- Threshold for LiberateCase
stolen_x86_regs :: Int,
cmdlineHcIncludes :: [String], -- -#includes
outputFile :: Maybe String,
outputHi :: Maybe String,
+ dynLibLoader :: DynLibLoader,
+
+ -- | This is set by DriverPipeline.runPipeline based on where
+ -- its output is going.
+ dumpPrefix :: Maybe FilePath,
+
+ -- | Override the dumpPrefix set by runPipeline.
+ -- Set by -ddump-file-prefix
+ dumpPrefixForce :: Maybe FilePath,
includePaths :: [String],
libraryPaths :: [String],
opt_m :: [String],
opt_a :: [String],
opt_l :: [String],
- opt_dll :: [String],
opt_dep :: [String],
+ opt_windres :: [String],
-- commands for particular phases
pgm_L :: String,
pgm_dll :: (String,[Option]),
pgm_T :: String,
pgm_sysman :: String,
+ pgm_windres :: String,
-- Package flags
extraPkgConfs :: [FilePath],
-- Package state
-- NB. do not modify this field, it is calculated by
-- Packages.initPackages and Packages.updatePackages.
- pkgDatabase :: Maybe (UniqFM InstalledPackageInfo),
+ pkgDatabase :: Maybe (UniqFM PackageConfig),
pkgState :: PackageState,
-- hsc dynamic flags
flags :: [DynFlag],
-- message output
- log_action :: Severity -> SrcSpan -> PprStyle -> Message -> IO ()
+ log_action :: Severity -> SrcSpan -> PprStyle -> Message -> IO (),
+
+ haddockOptions :: Maybe String
}
data HscTarget
| LinkBinary -- Link object code into a binary
| LinkInMemory -- Use the in-memory dynamic linker
| LinkDynLib -- Link objects into a dynamic lib (DLL on Windows, DSO on ELF platforms)
- deriving Eq
+ deriving (Eq, Show)
isNoLink :: GhcLink -> Bool
isNoLink NoLink = True
-isNoLink other = False
+isNoLink _ = False
data PackageFlag
= ExposePackage String
| IgnorePackage String
deriving Eq
+defaultHscTarget :: HscTarget
defaultHscTarget = defaultObjectTarget
-- | the 'HscTarget' value corresponding to the default way to create
-- object files on the current platform.
+defaultObjectTarget :: HscTarget
defaultObjectTarget
| cGhcWithNativeCodeGen == "YES" = HscAsm
| otherwise = HscC
+data DynLibLoader
+ = Deployable
+ | Wrapped (Maybe String)
+ | SystemDependent
+ deriving Eq
+
+initDynFlags :: DynFlags -> IO DynFlags
initDynFlags dflags = do
-- someday these will be dynamic flags
ways <- readIORef v_Ways
rtsBuildTag = rts_build_tag
}
+defaultDynFlags :: DynFlags
defaultDynFlags =
DynFlags {
ghcMode = CompManager,
extCoreName = "",
verbosity = 0,
optLevel = 0,
+ simplPhases = 2,
maxSimplIterations = 4,
+ shouldDumpSimplPhase = const False,
ruleCheck = Nothing,
- specThreshold = 200,
+ specConstrThreshold = Just 200,
+ specConstrCount = Just 3,
+ liberateCaseThreshold = Just 200,
stolen_x86_regs = 4,
cmdlineHcIncludes = [],
importPaths = ["."],
outputFile = Nothing,
outputHi = Nothing,
+ dynLibLoader = Deployable,
+ dumpPrefix = Nothing,
+ dumpPrefixForce = Nothing,
includePaths = [],
libraryPaths = [],
frameworkPaths = [],
hpcDir = ".hpc",
opt_L = [],
- opt_P = [],
+ opt_P = (if opt_PIC
+ then ["-D__PIC__"]
+ else []),
opt_F = [],
opt_c = [],
opt_a = [],
opt_m = [],
opt_l = [],
- opt_dll = [],
opt_dep = [],
+ opt_windres = [],
extraPkgConfs = [],
packageFlags = [],
pkgDatabase = Nothing,
pkgState = panic "no package state yet: call GHC.setSessionDynFlags",
- flags = [
- Opt_ReadUserPackageConf,
-
- Opt_MonoPatBinds, -- Experimentally, I'm making this non-standard
- -- behaviour the default, to see if anyone notices
- -- SLPJ July 06
+ haddockOptions = Nothing,
+ flags = [
+ Opt_ReadUserPackageConf,
- Opt_ImplicitPrelude,
- Opt_MonomorphismRestriction,
+ Opt_MonoPatBinds, -- Experimentally, I'm making this non-standard
+ -- behaviour the default, to see if anyone notices
+ -- SLPJ July 06
+
+ Opt_ImplicitPrelude,
+ Opt_MonomorphismRestriction,
+
+ Opt_DoAsmMangling,
+
+ Opt_GenManifest,
+ Opt_EmbedManifest,
+ Opt_PrintBindContents
+ ]
+ ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns]
+ -- The default -O0 options
+ ++ standardWarnings,
- Opt_DoAsmMangling,
-
- -- on by default:
- Opt_PrintBindResult ]
- ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns]
- -- The default -O0 options
- ++ standardWarnings,
-
log_action = \severity srcSpan style msg ->
case severity of
SevInfo -> hPutStrLn stderr (show (msg style))
| verbosity dflags >= 3 = "-v"
| otherwise = ""
-setObjectDir f d = d{ objectDir = f}
-setHiDir f d = d{ hiDir = f}
-setStubDir f d = d{ stubDir = f}
+setObjectDir, setHiDir, setStubDir, setObjectSuf, setHiSuf, setHcSuf, parseDynLibLoaderMode,
+ setPgmP, setPgmL, setPgmF, setPgmc, setPgmm, setPgms, setPgma, setPgml, setPgmdll, setPgmwindres,
+ addOptL, addOptP, addOptF, addOptc, addOptm, addOpta, addOptl, addOptdep, addOptwindres,
+ addCmdlineFramework, addHaddockOpts
+ :: String -> DynFlags -> DynFlags
+setOutputFile, setOutputHi, setDumpPrefixForce
+ :: Maybe String -> DynFlags -> DynFlags
+
+setObjectDir f d = d{ objectDir = Just f}
+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.
setObjectSuf f d = d{ objectSuf = f}
setHiSuf f d = d{ hiSuf = f}
setOutputFile f d = d{ outputFile = f}
setOutputHi f d = d{ outputHi = f}
+parseDynLibLoaderMode f d =
+ case splitAt 8 f of
+ ("deploy", "") -> d{ dynLibLoader = Deployable }
+ ("sysdep", "") -> d{ dynLibLoader = SystemDependent }
+ ("wrapped", "") -> d{ dynLibLoader = Wrapped Nothing }
+ ("wrapped:", "hard") -> d{ dynLibLoader = Wrapped Nothing }
+ ("wrapped:", flex) -> d{ dynLibLoader = Wrapped (Just flex) }
+ (_,_) -> error "Unknown dynlib loader"
+
+setDumpPrefixForce f d = d { dumpPrefixForce = f}
+
-- XXX HACK: Prelude> words "'does not' work" ===> ["'does","not'","work"]
-- Config.hs should really use Option.
setPgmP f d = let (pgm:args) = words f in d{ pgm_P = (pgm, map Option args)}
setPgma f d = d{ pgm_a = (f,[])}
setPgml f d = d{ pgm_l = (f,[])}
setPgmdll f d = d{ pgm_dll = (f,[])}
+setPgmwindres f d = d{ pgm_windres = f}
addOptL f d = d{ opt_L = f : opt_L d}
addOptP f d = d{ opt_P = f : opt_P d}
addOptm f d = d{ opt_m = f : opt_m d}
addOpta f d = d{ opt_a = f : opt_a d}
addOptl f d = d{ opt_l = f : opt_l d}
-addOptdll f d = d{ opt_dll = f : opt_dll d}
addOptdep f d = d{ opt_dep = f : opt_dep d}
+addOptwindres f d = d{ opt_windres = f : opt_windres d}
addCmdlineFramework f d = d{ cmdlineFrameworks = f : cmdlineFrameworks d}
+addHaddockOpts f d = d{ haddockOptions = Just f}
+
-- -----------------------------------------------------------------------------
-- Command-line options
, ([2], Opt_LiberateCase)
, ([2], Opt_SpecConstr)
+ , ([2], Opt_StaticArgumentTransformation)
, ([0,1,2], Opt_DoLambdaEtaExpansion)
-- This one is important for a tiresome reason:
-- -----------------------------------------------------------------------------
-- Standard sets of warning options
+standardWarnings :: [DynFlag]
standardWarnings
= [ Opt_WarnDeprecations,
Opt_WarnOverlappingPatterns,
Opt_WarnDuplicateExports
]
+minusWOpts :: [DynFlag]
minusWOpts
= standardWarnings ++
[ Opt_WarnUnusedBinds,
Opt_WarnDodgyImports
]
+minusWallOpts :: [DynFlag]
minusWallOpts
= minusWOpts ++
[ Opt_WarnTypeDefaults,
Opt_WarnOrphans
]
+-- minuswRemovesOpts should be every warning option
+minuswRemovesOpts :: [DynFlag]
+minuswRemovesOpts
+ = minusWallOpts ++
+ [Opt_WarnImplicitPrelude,
+ Opt_WarnIncompletePatternsRecUpd,
+ Opt_WarnSimplePatterns,
+ Opt_WarnMonomorphism,
+ Opt_WarnTabs
+ ]
+
-- -----------------------------------------------------------------------------
-- CoreToDo: abstraction of core-to-core passes to run.
| CoreCSE
| CoreDoRuleCheck Int{-CompilerPhase-} String -- Check for non-application of rules
-- matching this string
+ | CoreDoVectorisation
| CoreDoNothing -- Useful when building up
| CoreDoPasses [CoreToDo] -- lists of these things
data SimplifierMode -- See comments in SimplMonad
= SimplGently
- | SimplPhase Int
+ | SimplPhase Int [String]
data SimplifierSwitch
= MaxSimplifierIterations Int
-- The core-to-core pass ordering is derived from the DynFlags:
runWhen :: Bool -> CoreToDo -> CoreToDo
runWhen True do_this = do_this
-runWhen False do_this = CoreDoNothing
+runWhen False _ = CoreDoNothing
+
+runMaybe :: Maybe a -> (a -> CoreToDo) -> CoreToDo
+runMaybe (Just x) f = f x
+runMaybe Nothing _ = CoreDoNothing
getCoreToDo :: DynFlags -> [CoreToDo]
getCoreToDo dflags
| otherwise = core_todo
where
opt_level = optLevel dflags
+ phases = simplPhases dflags
max_iter = maxSimplIterations dflags
strictness = dopt Opt_Strictness dflags
full_laziness = dopt Opt_FullLaziness dflags
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)
+
+ simpl_phase phase names iter
+ = CoreDoPasses
+ [ CoreDoSimplify (SimplPhase phase names) [
+ MaxSimplifierIterations iter
+ ],
+ maybe_rule_check phase
+ ]
+
+ -- By default, we have 2 phases before phase 0.
+
+ -- Want to run with inline phase 2 after the specialiser to give
+ -- maximum chance for fusion to work before we inline build/augment
+ -- in phase 1. This made a difference in 'ansi' where an
+ -- overloaded function wasn't inlined till too late.
+
+ -- Need phase 1 so that build/augment get
+ -- inlined. I found that spectral/hartel/genfft lost some useful
+ -- strictness in the function sumcode' if augment is not inlined
+ -- before strictness analysis runs
+ simpl_phases = CoreDoPasses [ simpl_phase phase ["main"] max_iter
+ | phase <- [phases, phases-1 .. 1] ]
- core_todo =
- if opt_level == 0 then
- [
- CoreDoSimplify (SimplPhase 0) [
- MaxSimplifierIterations max_iter
- ]
- ]
- else {- opt_level >= 1 -} [
-- initial simplify: mk specialiser happy: minimum effort please
- CoreDoSimplify SimplGently [
+ simpl_gently = CoreDoSimplify SimplGently [
-- Simplify "gently"
-- Don't inline anything till full laziness has bitten
-- In particular, inlining wrappers inhibits floating
NoCaseOfCase, -- Don't do case-of-case transformations.
-- This makes full laziness work better
MaxSimplifierIterations max_iter
- ],
+ ]
+
+ core_todo =
+ if opt_level == 0 then
+ [simpl_phase 0 ["final"] max_iter]
+ else {- opt_level >= 1 -} [
+
+ -- We want to do the static argument transform before full laziness as it
+ -- may expose extra opportunities to float things outwards. However, to fix
+ -- up the output of the transformation we need at do at least one simplify
+ -- after this before anything else
+ runWhen static_args 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 ]),
-- Specialisation is best done before full laziness
-- so that overloaded functions have all their dictionary lambdas manifest
CoreDoFloatInwards,
- CoreDoSimplify (SimplPhase 2) [
- -- Want to run with inline phase 2 after the specialiser to give
- -- maximum chance for fusion to work before we inline build/augment
- -- in phase 1. This made a difference in 'ansi' where an
- -- overloaded function wasn't inlined till too late.
- MaxSimplifierIterations max_iter
- ],
- case rule_check of { Just pat -> CoreDoRuleCheck 2 pat; Nothing -> CoreDoNothing },
-
- CoreDoSimplify (SimplPhase 1) [
- -- Need inline-phase2 here so that build/augment get
- -- inlined. I found that spectral/hartel/genfft lost some useful
- -- strictness in the function sumcode' if augment is not inlined
- -- before strictness analysis runs
- MaxSimplifierIterations max_iter
- ],
- case rule_check of { Just pat -> CoreDoRuleCheck 1 pat; Nothing -> CoreDoNothing },
+ simpl_phases,
- CoreDoSimplify (SimplPhase 0) [
-- Phase 0: allow all Ids to be inlined now
-- This gets foldr inlined before strictness analysis
- MaxSimplifierIterations 3
-- At least 3 iterations because otherwise we land up with
-- huge dead expressions because of an infelicity in the
-- simpifier.
-- ==> let k = BIG in letrec go = \xs -> ...(k x).... in go xs
-- ==> let k = BIG in letrec go = \xs -> ...(BIG x).... in go xs
-- Don't stop now!
+ simpl_phase 0 ["main"] (max max_iter 3),
- ],
- case rule_check of { Just pat -> CoreDoRuleCheck 0 pat; Nothing -> CoreDoNothing },
#ifdef OLD_STRICTNESS
CoreDoOldStrictness,
CoreDoStrictness,
CoreDoWorkerWrapper,
CoreDoGlomBinds,
- CoreDoSimplify (SimplPhase 0) [
- MaxSimplifierIterations max_iter
- ]]),
+ simpl_phase 0 ["post-worker-wrapper"] max_iter
+ ]),
runWhen full_laziness
(CoreDoFloatOutwards (FloatOutSw False -- Not lambdas
CoreDoFloatInwards,
- case rule_check of { Just pat -> CoreDoRuleCheck 0 pat; Nothing -> CoreDoNothing },
+ maybe_rule_check 0,
-- Case-liberation for -O2. This should be after
-- strictness analysis and the simplification which follows it.
runWhen liberate_case (CoreDoPasses [
CoreLiberateCase,
- CoreDoSimplify (SimplPhase 0) [
- MaxSimplifierIterations max_iter
- ] ]), -- Run the simplifier after LiberateCase to vastly
+ simpl_phase 0 ["post-liberate-case"] max_iter
+ ]), -- Run the simplifier after LiberateCase to vastly
-- reduce the possiblility of shadowing
-- Reason: see Note [Shadowing] in SpecConstr.lhs
runWhen spec_constr CoreDoSpecConstr,
+ maybe_rule_check 0,
+
-- Final clean-up simplification:
- CoreDoSimplify (SimplPhase 0) [
- MaxSimplifierIterations max_iter
- ]
+ simpl_phase 0 ["final"] max_iter
]
-- -----------------------------------------------------------------------------
allFlags = map ('-':) $
[ name | (name, optkind) <- dynamic_flags, ok optkind ] ++
map ("fno-"++) flags ++
- map ("f"++) flags
+ map ("f"++) flags ++
+ map ("X"++) xs ++
+ map ("XNo"++) xs
where ok (PrefixPred _ _) = False
ok _ = True
flags = map fst fFlags
+ xs = map fst xFlags
dynamic_flags :: [(String, OptKind DynP)]
dynamic_flags = [
, ( "pgma" , HasArg (upd . setPgma) )
, ( "pgml" , HasArg (upd . setPgml) )
, ( "pgmdll" , HasArg (upd . setPgmdll) )
+ , ( "pgmwindres" , HasArg (upd . setPgmwindres) )
, ( "optL" , HasArg (upd . addOptL) )
, ( "optP" , HasArg (upd . addOptP) )
, ( "optm" , HasArg (upd . addOptm) )
, ( "opta" , HasArg (upd . addOpta) )
, ( "optl" , HasArg (upd . addOptl) )
- , ( "optdll" , HasArg (upd . addOptdll) )
, ( "optdep" , HasArg (upd . addOptdep) )
+ , ( "optwindres" , HasArg (upd . addOptwindres) )
, ( "split-objs" , NoArg (if can_split
then setDynFlag Opt_SplitObjs
, ( "c" , NoArg (upd $ \d -> d{ ghcLink=NoLink } ))
, ( "no-link" , NoArg (upd $ \d -> d{ ghcLink=NoLink } )) -- Dep.
, ( "shared" , NoArg (upd $ \d -> d{ ghcLink=LinkDynLib } ))
+ , ( "dynload" , HasArg (upd . parseDynLibLoaderMode))
------- Libraries ---------------------------------------------------
, ( "L" , Prefix addLibraryPath )
- , ( "l" , AnySuffix (\s -> do upd (addOptl s)
- upd (addOptdll s)))
+ , ( "l" , AnySuffix (\s -> do upd (addOptl s)))
------- Frameworks --------------------------------------------------
-- -framework-path should really be -F ...
, ( "framework" , HasArg (upd . addCmdlineFramework) )
------- Output Redirection ------------------------------------------
- , ( "odir" , HasArg (upd . setObjectDir . Just))
+ , ( "odir" , HasArg (upd . setObjectDir))
, ( "o" , SepArg (upd . setOutputFile . Just))
, ( "ohi" , HasArg (upd . setOutputHi . Just ))
, ( "osuf" , HasArg (upd . setObjectSuf))
, ( "hcsuf" , HasArg (upd . setHcSuf))
, ( "hisuf" , HasArg (upd . setHiSuf))
- , ( "hidir" , HasArg (upd . setHiDir . Just))
+ , ( "hidir" , HasArg (upd . setHiDir))
, ( "tmpdir" , HasArg (upd . setTmpDir))
- , ( "stubdir" , HasArg (upd . setStubDir . Just))
+ , ( "stubdir" , HasArg (upd . setStubDir))
+ , ( "ddump-file-prefix", HasArg (upd . setDumpPrefixForce . Just))
------- Keeping temporary files -------------------------------------
-- These can be singular (think ghc -c) or plural (think ghc --make)
, ( "no-hs-main" , NoArg (setDynFlag Opt_NoHsMain))
, ( "main-is" , SepArg setMainIs )
, ( "haddock" , NoArg (setDynFlag Opt_Haddock) )
+ , ( "haddock-opts" , HasArg (upd . addHaddockOpts))
, ( "hpcdir" , SepArg setOptHpcDir )
------- recompilation checker (DEPRECATED, use -fforce-recomp) -----
, ( "dstg-stats", NoArg (setDynFlag Opt_StgStats))
, ( "ddump-cmm", setDumpFlag Opt_D_dump_cmm)
+ , ( "ddump-cmmz", setDumpFlag Opt_D_dump_cmmz)
+ , ( "ddump-cmmz-pretty", setDumpFlag Opt_D_dump_cmmz_pretty)
, ( "ddump-cps-cmm", setDumpFlag Opt_D_dump_cps_cmm)
+ , ( "ddump-cvt-cmm", setDumpFlag Opt_D_dump_cvt_cmm)
, ( "ddump-asm", setDumpFlag Opt_D_dump_asm)
+ , ( "ddump-asm-native", setDumpFlag Opt_D_dump_asm_native)
+ , ( "ddump-asm-liveness", setDumpFlag Opt_D_dump_asm_liveness)
+ , ( "ddump-asm-coalesce", setDumpFlag Opt_D_dump_asm_coalesce)
+ , ( "ddump-asm-regalloc", setDumpFlag Opt_D_dump_asm_regalloc)
+ , ( "ddump-asm-conflicts", setDumpFlag Opt_D_dump_asm_conflicts)
+ , ( "ddump-asm-regalloc-stages",
+ setDumpFlag Opt_D_dump_asm_regalloc_stages)
+ , ( "ddump-asm-stats", setDumpFlag Opt_D_dump_asm_stats)
, ( "ddump-cpranal", setDumpFlag Opt_D_dump_cpranal)
, ( "ddump-deriv", setDumpFlag Opt_D_dump_deriv)
, ( "ddump-ds", setDumpFlag Opt_D_dump_ds)
, ( "ddump-rn", setDumpFlag Opt_D_dump_rn)
, ( "ddump-simpl", setDumpFlag Opt_D_dump_simpl)
, ( "ddump-simpl-iterations", setDumpFlag Opt_D_dump_simpl_iterations)
+ , ( "ddump-simpl-phases", OptPrefix setDumpSimplPhases)
, ( "ddump-spec", setDumpFlag Opt_D_dump_spec)
, ( "ddump-prep", setDumpFlag Opt_D_dump_prep)
, ( "ddump-stg", setDumpFlag Opt_D_dump_stg)
, ( "ddump-simpl-stats", setDumpFlag Opt_D_dump_simpl_stats)
, ( "ddump-bcos", setDumpFlag Opt_D_dump_BCOs)
, ( "dsource-stats", setDumpFlag Opt_D_source_stats)
- , ( "dverbose-core2core", setDumpFlag Opt_D_verbose_core2core)
+ , ( "dverbose-core2core", NoArg setVerboseCore2Core)
, ( "dverbose-stg2stg", setDumpFlag Opt_D_verbose_stg2stg)
, ( "ddump-hi", setDumpFlag Opt_D_dump_hi)
, ( "ddump-minimal-imports", setDumpFlag Opt_D_dump_minimal_imports)
, ( "ddump-vect", setDumpFlag Opt_D_dump_vect)
, ( "ddump-hpc", setDumpFlag Opt_D_dump_hpc)
, ( "ddump-mod-cycles", setDumpFlag Opt_D_dump_mod_cycles)
-
+ , ( "ddump-view-pattern-commoning", setDumpFlag Opt_D_dump_view_pattern_commoning)
+ , ( "ddump-to-file", setDumpFlag Opt_DumpToFile)
, ( "ddump-hi-diffs", NoArg (setDynFlag Opt_D_dump_hi_diffs))
, ( "dcore-lint", NoArg (setDynFlag Opt_DoCoreLinting))
, ( "dstg-lint", NoArg (setDynFlag Opt_DoStgLinting))
, ( "dcmm-lint", NoArg (setDynFlag Opt_DoCmmLinting))
+ , ( "dasm-lint", NoArg (setDynFlag Opt_DoAsmLinting))
, ( "dshow-passes", NoArg (do setDynFlag Opt_ForceRecomp
setVerbosity (Just 2)) )
, ( "dfaststring-stats", NoArg (setDynFlag Opt_D_faststring_stats))
, ( "monly-3-regs", NoArg (upd (\s -> s{stolen_x86_regs = 3}) ))
, ( "monly-4-regs", NoArg (upd (\s -> s{stolen_x86_regs = 4}) ))
- ------ Warning opts -------------------------------------------------
- , ( "W" , NoArg (mapM_ setDynFlag minusWOpts) )
- , ( "Werror" , NoArg (setDynFlag Opt_WarnIsError) )
- , ( "Wall" , NoArg (mapM_ setDynFlag minusWallOpts) )
- , ( "Wnot" , NoArg (mapM_ unSetDynFlag minusWallOpts) ) /* DEPREC */
- , ( "w" , NoArg (mapM_ unSetDynFlag minusWallOpts) )
+ ------ Warning opts -------------------------------------------------
+ , ( "W" , NoArg (mapM_ setDynFlag minusWOpts) )
+ , ( "Werror", NoArg (setDynFlag Opt_WarnIsError) )
+ , ( "Wwarn" , NoArg (unSetDynFlag Opt_WarnIsError) )
+ , ( "Wall" , NoArg (mapM_ setDynFlag minusWallOpts) )
+ , ( "Wnot" , NoArg (mapM_ unSetDynFlag minusWallOpts) ) -- DEPRECATED
+ , ( "w" , NoArg (mapM_ unSetDynFlag minuswRemovesOpts) )
------ Optimisation flags ------------------------------------------
, ( "O" , NoArg (upd (setOptLevel 1)))
- , ( "Onot" , NoArg (upd (setOptLevel 0)))
+ , ( "Onot" , NoArg (upd (setOptLevel 0))) -- deprecated
, ( "O" , OptIntSuffix (\mb_n -> upd (setOptLevel (mb_n `orElse` 1))))
-- If the number is missing, use 1
+ , ( "fsimplifier-phases", IntSuffix (\n ->
+ upd (\dfs -> dfs{ simplPhases = n })) )
, ( "fmax-simplifier-iterations", IntSuffix (\n ->
upd (\dfs -> dfs{ maxSimplIterations = n })) )
- -- liberate-case-threshold is an old flag for '-fspec-threshold'
- , ( "fspec-threshold", IntSuffix (\n -> upd (\dfs -> dfs{ specThreshold = n })))
- , ( "fliberate-case-threshold", IntSuffix (\n -> upd (\dfs -> dfs{ specThreshold = n })))
-
- , ( "frule-check", SepArg (\s -> upd (\dfs -> dfs{ ruleCheck = Just s })))
+ , ( "fspec-constr-threshold", IntSuffix (\n ->
+ upd (\dfs -> dfs{ specConstrThreshold = Just n })))
+ , ( "fno-spec-constr-threshold", NoArg (
+ upd (\dfs -> dfs{ specConstrThreshold = Nothing })))
+ , ( "fspec-constr-count", IntSuffix (\n ->
+ upd (\dfs -> dfs{ specConstrCount = Just n })))
+ , ( "fno-spec-constr-count", NoArg (
+ upd (\dfs -> dfs{ specConstrCount = Nothing })))
+ , ( "fliberate-case-threshold", IntSuffix (\n ->
+ upd (\dfs -> dfs{ liberateCaseThreshold = Just n })))
+ , ( "fno-liberate-case-threshold", NoArg (
+ upd (\dfs -> dfs{ liberateCaseThreshold = Nothing })))
+
+ , ( "frule-check", SepArg (\s -> upd (\dfs -> dfs{ ruleCheck = Just s })))
, ( "fcontext-stack" , IntSuffix $ \n -> upd $ \dfs -> dfs{ ctxtStkDepth = n })
------ Compiler flags -----------------------------------------------
- , ( "fasm", NoArg (setObjTarget HscAsm) )
- , ( "fvia-c", NoArg (setObjTarget HscC) )
- , ( "fvia-C", NoArg (setObjTarget HscC) )
+ , ( "fasm", NoArg (setObjTarget HscAsm) )
+ , ( "fvia-c", NoArg (setObjTarget HscC) )
+ , ( "fvia-C", NoArg (setObjTarget HscC) )
- , ( "fno-code", NoArg (setTarget HscNothing))
- , ( "fbyte-code", NoArg (setTarget HscInterpreted) )
- , ( "fobject-code", NoArg (setTarget defaultHscTarget) )
+ , ( "fno-code", NoArg (setTarget HscNothing))
+ , ( "fbyte-code", NoArg (setTarget HscInterpreted) )
+ , ( "fobject-code", NoArg (setTarget defaultHscTarget) )
, ( "fglasgow-exts", NoArg (mapM_ setDynFlag glasgowExtsFlags) )
, ( "fno-glasgow-exts", NoArg (mapM_ unSetDynFlag glasgowExtsFlags) )
- -- the rest of the -f* and -fno-* flags
- , ( "f", PrefixPred (isFlag fFlags) (\f -> setDynFlag (getFlag fFlags f)) )
- , ( "f", PrefixPred (isNoFlag fFlags) (\f -> unSetDynFlag (getNoFlag fFlags f)) )
-
- -- For now, allow -X flags with -f; ToDo: report this as deprecated
- , ( "f", PrefixPred (isFlag xFlags) (\f -> setDynFlag (getFlag xFlags f)) )
- , ( "f", PrefixPred (isNoFlag xFlags) (\f -> unSetDynFlag (getNoFlag xFlags f)) )
-
- -- the rest of the -X* and -Xno-* flags
- , ( "X", PrefixPred (isFlag xFlags) (\f -> setDynFlag (getFlag xFlags f)) )
- , ( "X", PrefixPred (isNoFlag xFlags) (\f -> unSetDynFlag (getNoFlag xFlags f)) )
+ -- the rest of the -f* and -fno-* flags
+ , ( "f", PrefixPred (isFlag fFlags)
+ (\f -> setDynFlag (getFlag fFlags f)) )
+ , ( "f", PrefixPred (isPrefFlag "no-" fFlags)
+ (\f -> unSetDynFlag (getPrefFlag "no-" fFlags f)) )
+
+ -- the -X* and -XNo* flags
+ , ( "X", PrefixPred (isFlag xFlags)
+ (\f -> setDynFlag (getFlag xFlags f)) )
+ , ( "X", PrefixPred (isPrefFlag "No" xFlags)
+ (\f -> unSetDynFlag (getPrefFlag "No" xFlags f)) )
]
-- these -f<blah> flags can all be reversed with -fno-<blah>
+fFlags :: [(String, DynFlag)]
fFlags = [
- ( "warn-duplicate-exports", Opt_WarnDuplicateExports ),
- ( "warn-hi-shadowing", Opt_WarnHiShadows ),
+ ( "warn-dodgy-imports", Opt_WarnDodgyImports ),
+ ( "warn-duplicate-exports", Opt_WarnDuplicateExports ),
+ ( "warn-hi-shadowing", Opt_WarnHiShadows ),
( "warn-implicit-prelude", Opt_WarnImplicitPrelude ),
- ( "warn-incomplete-patterns", Opt_WarnIncompletePatterns ),
- ( "warn-incomplete-record-updates", Opt_WarnIncompletePatternsRecUpd ),
- ( "warn-missing-fields", Opt_WarnMissingFields ),
- ( "warn-missing-methods", Opt_WarnMissingMethods ),
- ( "warn-missing-signatures", Opt_WarnMissingSigs ),
- ( "warn-name-shadowing", Opt_WarnNameShadowing ),
- ( "warn-overlapping-patterns", Opt_WarnOverlappingPatterns ),
- ( "warn-simple-patterns", Opt_WarnSimplePatterns ),
- ( "warn-type-defaults", Opt_WarnTypeDefaults ),
- ( "warn-monomorphism-restriction", Opt_WarnMonomorphism ),
- ( "warn-unused-binds", Opt_WarnUnusedBinds ),
- ( "warn-unused-imports", Opt_WarnUnusedImports ),
- ( "warn-unused-matches", Opt_WarnUnusedMatches ),
- ( "warn-deprecations", Opt_WarnDeprecations ),
- ( "warn-orphans", Opt_WarnOrphans ),
- ( "warn-tabs", Opt_WarnTabs ),
- ( "print-explicit-foralls", Opt_PrintExplicitForalls ),
- ( "strictness", Opt_Strictness ),
- ( "full-laziness", Opt_FullLaziness ),
- ( "liberate-case", Opt_LiberateCase ),
- ( "spec-constr", Opt_SpecConstr ),
- ( "cse", Opt_CSE ),
- ( "ignore-interface-pragmas", Opt_IgnoreInterfacePragmas ),
- ( "omit-interface-pragmas", Opt_OmitInterfacePragmas ),
- ( "do-lambda-eta-expansion", Opt_DoLambdaEtaExpansion ),
- ( "ignore-asserts", Opt_IgnoreAsserts ),
- ( "ignore-breakpoints", Opt_IgnoreBreakpoints),
- ( "do-eta-reduction", Opt_DoEtaReduction ),
- ( "case-merge", Opt_CaseMerge ),
- ( "unbox-strict-fields", Opt_UnboxStrictFields ),
- ( "dicts-cheap", Opt_DictsCheap ),
- ( "excess-precision", Opt_ExcessPrecision ),
- ( "asm-mangling", Opt_DoAsmMangling ),
- ( "print-bind-result", Opt_PrintBindResult ),
- ( "force-recomp", Opt_ForceRecomp ),
- ( "hpc-no-auto", Opt_Hpc_No_Auto ),
- ( "rewrite-rules", Opt_RewriteRules ),
+ ( "warn-incomplete-patterns", Opt_WarnIncompletePatterns ),
+ ( "warn-incomplete-record-updates", Opt_WarnIncompletePatternsRecUpd ),
+ ( "warn-missing-fields", Opt_WarnMissingFields ),
+ ( "warn-missing-methods", Opt_WarnMissingMethods ),
+ ( "warn-missing-signatures", Opt_WarnMissingSigs ),
+ ( "warn-name-shadowing", Opt_WarnNameShadowing ),
+ ( "warn-overlapping-patterns", Opt_WarnOverlappingPatterns ),
+ ( "warn-simple-patterns", Opt_WarnSimplePatterns ),
+ ( "warn-type-defaults", Opt_WarnTypeDefaults ),
+ ( "warn-monomorphism-restriction", Opt_WarnMonomorphism ),
+ ( "warn-unused-binds", Opt_WarnUnusedBinds ),
+ ( "warn-unused-imports", Opt_WarnUnusedImports ),
+ ( "warn-unused-matches", Opt_WarnUnusedMatches ),
+ ( "warn-deprecations", Opt_WarnDeprecations ),
+ ( "warn-orphans", Opt_WarnOrphans ),
+ ( "warn-tabs", Opt_WarnTabs ),
+ ( "print-explicit-foralls", Opt_PrintExplicitForalls ),
+ ( "strictness", Opt_Strictness ),
+ ( "static-argument-transformation", Opt_StaticArgumentTransformation ),
+ ( "full-laziness", Opt_FullLaziness ),
+ ( "liberate-case", Opt_LiberateCase ),
+ ( "spec-constr", Opt_SpecConstr ),
+ ( "cse", Opt_CSE ),
+ ( "ignore-interface-pragmas", Opt_IgnoreInterfacePragmas ),
+ ( "omit-interface-pragmas", Opt_OmitInterfacePragmas ),
+ ( "do-lambda-eta-expansion", Opt_DoLambdaEtaExpansion ),
+ ( "ignore-asserts", Opt_IgnoreAsserts ),
+ ( "do-eta-reduction", Opt_DoEtaReduction ),
+ ( "case-merge", Opt_CaseMerge ),
+ ( "unbox-strict-fields", Opt_UnboxStrictFields ),
+ ( "dicts-cheap", Opt_DictsCheap ),
+ ( "excess-precision", Opt_ExcessPrecision ),
+ ( "asm-mangling", Opt_DoAsmMangling ),
+ ( "print-bind-result", Opt_PrintBindResult ),
+ ( "force-recomp", Opt_ForceRecomp ),
+ ( "hpc-no-auto", Opt_Hpc_No_Auto ),
+ ( "rewrite-rules", Opt_RewriteRules ),
( "break-on-exception", Opt_BreakOnException ),
- ( "vectorise", Opt_Vectorise )
+ ( "break-on-error", Opt_BreakOnError ),
+ ( "print-evld-with-show", Opt_PrintEvldWithShow ),
+ ( "print-bind-contents", Opt_PrintBindContents ),
+ ( "run-cps", Opt_RunCPSZ ),
+ ( "convert-to-zipper-and-back", Opt_ConvertToZipCfgAndBack),
+ ( "vectorise", Opt_Vectorise ),
+ ( "regs-graph", Opt_RegsGraph),
+ ( "regs-iterative", Opt_RegsIterative),
+ -- Deprecated in favour of -XTemplateHaskell:
+ ( "th", Opt_TemplateHaskell ),
+ -- Deprecated in favour of -XForeignFunctionInterface:
+ ( "fi", Opt_ForeignFunctionInterface ),
+ -- Deprecated in favour of -XForeignFunctionInterface:
+ ( "ffi", Opt_ForeignFunctionInterface ),
+ -- Deprecated in favour of -XArrows:
+ ( "arrows", Opt_Arrows ),
+ -- Deprecated in favour of -XGenerics:
+ ( "generics", Opt_Generics ),
+ -- Deprecated in favour of -XImplicitPrelude:
+ ( "implicit-prelude", Opt_ImplicitPrelude ),
+ -- Deprecated in favour of -XBangPatterns:
+ ( "bang-patterns", Opt_BangPatterns ),
+ -- Deprecated in favour of -XMonomorphismRestriction:
+ ( "monomorphism-restriction", Opt_MonomorphismRestriction ),
+ -- Deprecated in favour of -XMonoPatBinds:
+ ( "mono-pat-binds", Opt_MonoPatBinds ),
+ -- Deprecated in favour of -XExtendedDefaultRules:
+ ( "extended-default-rules", Opt_ExtendedDefaultRules ),
+ -- Deprecated in favour of -XImplicitParams:
+ ( "implicit-params", Opt_ImplicitParams ),
+ -- Deprecated in favour of -XScopedTypeVariables:
+ ( "scoped-type-variables", Opt_ScopedTypeVariables ),
+ -- Deprecated in favour of -XPArr:
+ ( "parr", Opt_PArr ),
+ -- Deprecated in favour of -XOverlappingInstances:
+ ( "allow-overlapping-instances", Opt_OverlappingInstances ),
+ -- Deprecated in favour of -XUndecidableInstances:
+ ( "allow-undecidable-instances", Opt_UndecidableInstances ),
+ -- Deprecated in favour of -XIncoherentInstances:
+ ( "allow-incoherent-instances", Opt_IncoherentInstances ),
+ ( "gen-manifest", Opt_GenManifest ),
+ ( "embed-manifest", Opt_EmbedManifest )
]
+supportedLanguages :: [String]
+supportedLanguages = map fst xFlags
--- These -X<blah> flags can all be reversed with -Xno-<blah>
+-- These -X<blah> flags can all be reversed with -XNo<blah>
xFlags :: [(String, DynFlag)]
xFlags = [
( "CPP", Opt_Cpp ),
( "PolymorphicComponents", Opt_PolymorphicComponents ),
( "ExistentialQuantification", Opt_ExistentialQuantification ),
( "KindSignatures", Opt_KindSignatures ),
+ ( "PatternSignatures", Opt_PatternSignatures ),
( "EmptyDataDecls", Opt_EmptyDataDecls ),
( "ParallelListComp", Opt_ParallelListComp ),
- ( "FI", Opt_FFI ), -- support `-ffi'...
- ( "FFI", Opt_FFI ), -- ...and also `-fffi'
- ( "ForeignFunctionInterface", Opt_FFI ),
-
+ ( "TransformListComp", Opt_TransformListComp ),
+ ( "ForeignFunctionInterface", Opt_ForeignFunctionInterface ),
+ ( "UnliftedFFITypes", Opt_UnliftedFFITypes ),
+ ( "LiberalTypeSynonyms", Opt_LiberalTypeSynonyms ),
( "Rank2Types", Opt_Rank2Types ),
( "RankNTypes", Opt_RankNTypes ),
+ ( "ImpredicativeTypes", Opt_ImpredicativeTypes ),
( "TypeOperators", Opt_TypeOperators ),
( "RecursiveDo", Opt_RecursiveDo ),
- ( "Arrows", Opt_Arrows ), -- arrow syntax
- ( "Parr", Opt_PArr ),
-
- ( "TH", Opt_TH ), -- support -fth
- ( "TemplateHaskelll", Opt_TH ),
-
- ( "Generics", Opt_Generics ),
-
- ( "ImplicitPrelude", Opt_ImplicitPrelude ), -- On by default
-
- ( "RecordWildCards", Opt_RecordWildCards ),
- ( "RecordPuns", Opt_RecordPuns ),
- ( "DisambiguateRecordFields", Opt_DisambiguateRecordFields ),
-
- ( "OverloadedStrings", Opt_OverloadedStrings ),
- ( "GADTs", Opt_GADTs ),
- ( "TypeFamilies", Opt_TypeFamilies ),
- ( "BangPatterns", Opt_BangPatterns ),
- ( "MonomorphismRestriction", Opt_MonomorphismRestriction ), -- On by default
- ( "MonoPatBinds", Opt_MonoPatBinds ), -- On by default (which is not strictly H98)
- ( "RelaxedPolyRec", Opt_RelaxedPolyRec),
- ( "ExtendedDefaultRules", Opt_ExtendedDefaultRules ),
- ( "ImplicitParams", Opt_ImplicitParams ),
- ( "ScopedTypeVariables", Opt_ScopedTypeVariables ),
- ( "TypeSynonymInstances", Opt_TypeSynonymInstances ),
- ( "FlexibleContexts", Opt_FlexibleContexts ),
- ( "FlexibleInstances", Opt_FlexibleInstances ),
- ( "MultiParamTypeClasses", Opt_MultiParamTypeClasses ),
- ( "FunctionalDependencies", Opt_FunctionalDependencies ),
- ( "GeneralizedNewtypeDeriving", Opt_GeneralizedNewtypeDeriving ),
- ( "AllowOverlappingInstances", Opt_AllowOverlappingInstances ),
- ( "AllowUndecidableInstances", Opt_AllowUndecidableInstances ),
- ( "AllowIncoherentInstances", Opt_AllowIncoherentInstances )
+ ( "Arrows", Opt_Arrows ),
+ ( "PArr", Opt_PArr ),
+ ( "TemplateHaskell", Opt_TemplateHaskell ),
+ ( "QuasiQuotes", Opt_QuasiQuotes ),
+ ( "Generics", Opt_Generics ),
+ -- On by default:
+ ( "ImplicitPrelude", Opt_ImplicitPrelude ),
+ ( "RecordWildCards", Opt_RecordWildCards ),
+ ( "RecordPuns", Opt_RecordPuns ),
+ ( "DisambiguateRecordFields", Opt_DisambiguateRecordFields ),
+ ( "OverloadedStrings", Opt_OverloadedStrings ),
+ ( "GADTs", Opt_GADTs ),
+ ( "ViewPatterns", Opt_ViewPatterns),
+ ( "TypeFamilies", Opt_TypeFamilies ),
+ ( "BangPatterns", Opt_BangPatterns ),
+ -- On by default:
+ ( "MonomorphismRestriction", Opt_MonomorphismRestriction ),
+ -- On by default (which is not strictly H98):
+ ( "MonoPatBinds", Opt_MonoPatBinds ),
+ ( "RelaxedPolyRec", Opt_RelaxedPolyRec),
+ ( "ExtendedDefaultRules", Opt_ExtendedDefaultRules ),
+ ( "ImplicitParams", Opt_ImplicitParams ),
+ ( "ScopedTypeVariables", Opt_ScopedTypeVariables ),
+ ( "UnboxedTuples", Opt_UnboxedTuples ),
+ ( "StandaloneDeriving", Opt_StandaloneDeriving ),
+ ( "DeriveDataTypeable", Opt_DeriveDataTypeable ),
+ ( "TypeSynonymInstances", Opt_TypeSynonymInstances ),
+ ( "FlexibleContexts", Opt_FlexibleContexts ),
+ ( "FlexibleInstances", Opt_FlexibleInstances ),
+ ( "ConstrainedClassMethods", Opt_ConstrainedClassMethods ),
+ ( "MultiParamTypeClasses", Opt_MultiParamTypeClasses ),
+ ( "FunctionalDependencies", Opt_FunctionalDependencies ),
+ ( "GeneralizedNewtypeDeriving", Opt_GeneralizedNewtypeDeriving ),
+ ( "OverlappingInstances", Opt_OverlappingInstances ),
+ ( "UndecidableInstances", Opt_UndecidableInstances ),
+ ( "IncoherentInstances", Opt_IncoherentInstances )
]
impliedFlags :: [(DynFlag, [DynFlag])]
impliedFlags = [
- ( Opt_GADTs, [Opt_RelaxedPolyRec] ) -- We want type-sig variables to be completely rigid for GADTs
+ ( Opt_GADTs, [Opt_RelaxedPolyRec] ) -- We want type-sig variables to
+ -- be completely rigid for GADTs
+ , ( Opt_ScopedTypeVariables, [Opt_RelaxedPolyRec] ) -- Ditto for scoped type variables; see
+ -- Note [Scoped tyvars] in TcBinds
]
-glasgowExtsFlags = [ Opt_GlasgowExts
- , Opt_PrintExplicitForalls
- , Opt_FFI
- , Opt_GADTs
- , Opt_ImplicitParams
- , Opt_ScopedTypeVariables
+glasgowExtsFlags :: [DynFlag]
+glasgowExtsFlags = [
+ Opt_PrintExplicitForalls
+ , Opt_ForeignFunctionInterface
+ , Opt_UnliftedFFITypes
+ , Opt_GADTs
+ , Opt_ImplicitParams
+ , Opt_ScopedTypeVariables
+ , Opt_UnboxedTuples
, Opt_TypeSynonymInstances
+ , Opt_StandaloneDeriving
+ , Opt_DeriveDataTypeable
, Opt_FlexibleContexts
, Opt_FlexibleInstances
+ , Opt_ConstrainedClassMethods
, Opt_MultiParamTypeClasses
, Opt_FunctionalDependencies
- , Opt_MagicHash
+ , Opt_MagicHash
, Opt_PolymorphicComponents
, Opt_ExistentialQuantification
, Opt_UnicodeSyntax
, Opt_PatternGuards
+ , Opt_LiberalTypeSynonyms
, Opt_RankNTypes
+ , Opt_ImpredicativeTypes
, Opt_TypeOperators
, Opt_RecursiveDo
, Opt_ParallelListComp
, Opt_EmptyDataDecls
, Opt_KindSignatures
+ , Opt_PatternSignatures
, Opt_GeneralizedNewtypeDeriving
- , Opt_TypeFamilies ]
+ , Opt_TypeFamilies ]
------------------
-isNoFlag, isFlag :: [(String,a)] -> String -> Bool
-
-isFlag flags f = is_flag flags (normaliseFlag f)
-
-isNoFlag flags no_f
- | Just f <- noFlag_maybe (normaliseFlag no_f) = is_flag flags f
- | otherwise = False
+isFlag :: [(String,a)] -> String -> Bool
+isFlag flags f = any (\(ff,_) -> ff == f) flags
-is_flag flags nf = any (\(ff,_) -> normaliseFlag ff == nf) flags
- -- nf is normalised alreadly
+isPrefFlag :: String -> [(String,a)] -> String -> Bool
+isPrefFlag pref flags no_f
+ | Just f <- maybePrefixMatch pref no_f = isFlag flags f
+ | otherwise = False
------------------
-getFlag, getNoFlag :: [(String,a)] -> String -> a
-
-getFlag flags f = get_flag flags (normaliseFlag f)
-
-getNoFlag flags f = get_flag flags (fromJust (noFlag_maybe (normaliseFlag f)))
- -- The flag should be a no-flag already
+getFlag :: [(String,a)] -> String -> a
+getFlag flags f = case [ opt | (ff, opt) <- flags, ff == f] of
+ (o:_) -> o
+ [] -> panic ("get_flag " ++ f)
-get_flag flags nf = case [ opt | (ff, opt) <- flags, normaliseFlag ff == nf] of
- (o:os) -> o
- [] -> panic ("get_flag " ++ nf)
-
-------------------
-noFlag_maybe :: String -> Maybe String
--- The input is normalised already
-noFlag_maybe ('n' : 'o' : f) = Just f
-noFlag_maybe other = Nothing
-
-normaliseFlag :: String -> String
--- Normalise a option flag by
--- * map to lower case
--- * removing hyphens
--- Thus: -X=overloaded-strings or -XOverloadedStrings
-normaliseFlag [] = []
-normaliseFlag ('-':s) = normaliseFlag s
-normaliseFlag (c:s) = toLower c : normaliseFlag s
+getPrefFlag :: String -> [(String,a)] -> String -> a
+getPrefFlag pref flags f = getFlag flags (fromJust (maybePrefixMatch pref f))
+-- We should only be passed flags which match the prefix
-- -----------------------------------------------------------------------------
-- Parsing the dynamic flags.
-- Whenver we -ddump, switch off the recompilation checker,
-- else you don't see the dump!
+setVerboseCore2Core :: DynP ()
+setVerboseCore2Core = do setDynFlag Opt_ForceRecomp
+ setDynFlag Opt_D_verbose_core2core
+ upd (\s -> s { shouldDumpSimplPhase = const True })
+
+setDumpSimplPhases :: String -> DynP ()
+setDumpSimplPhases s = do setDynFlag Opt_ForceRecomp
+ upd (\s -> s { shouldDumpSimplPhase = spec })
+ where
+ spec :: SimplifierMode -> Bool
+ spec = join (||)
+ . map (join (&&) . map match . split ':')
+ . split ','
+ $ case s of
+ '=' : s' -> s'
+ _ -> s
+
+ join :: (Bool -> Bool -> Bool)
+ -> [SimplifierMode -> Bool]
+ -> SimplifierMode -> Bool
+ join _ [] = const True
+ join op ss = foldr1 (\f g x -> f x `op` g x) ss
+
+ match :: String -> SimplifierMode -> Bool
+ match "" = const True
+ match s = case reads s of
+ [(n,"")] -> phase_num n
+ _ -> phase_name s
+
+ phase_num :: Int -> SimplifierMode -> Bool
+ phase_num n (SimplPhase k _) = n == k
+ phase_num _ _ = False
+
+ phase_name :: String -> SimplifierMode -> Bool
+ phase_name s SimplGently = s == "gentle"
+ phase_name s (SimplPhase _ ss) = s `elem` ss
+
setVerbosity :: Maybe Int -> DynP ()
setVerbosity mb_n = upd (\dfs -> dfs{ verbosity = mb_n `orElse` 3 })
+addCmdlineHCInclude :: String -> DynP ()
addCmdlineHCInclude a = upd (\s -> s{cmdlineHcIncludes = a : cmdlineHcIncludes s})
+extraPkgConf_ :: FilePath -> DynP ()
extraPkgConf_ p = upd (\s -> s{ extraPkgConfs = p : extraPkgConfs s })
+exposePackage, hidePackage, ignorePackage :: String -> DynP ()
exposePackage p =
upd (\s -> s{ packageFlags = ExposePackage p : packageFlags s })
hidePackage p =
ignorePackage p =
upd (\s -> s{ packageFlags = IgnorePackage p : packageFlags s })
+setPackageName :: String -> DynFlags -> DynFlags
setPackageName p
| Nothing <- unpackPackageId pid
= throwDyn (CmdLineError ("cannot parse \'" ++ p ++ "\' as a package identifier"))
-- If we're linking a binary, then only targets that produce object
-- code are allowed (requests for other target types are ignored).
+setTarget :: HscTarget -> DynP ()
setTarget l = upd set
where
set dfs
-- used by -fasm and -fvia-C, which switch from one to the other, but
-- not from bytecode to object-code. The idea is that -fasm/-fvia-C
-- can be safely used in an OPTIONS_GHC pragma.
+setObjTarget :: HscTarget -> DynP ()
setObjTarget l = upd set
where
set dfs
setMainIs :: String -> DynP ()
setMainIs arg
- | not (null main_fn) -- The arg looked like "Foo.baz"
+ | not (null main_fn) && isLower (head main_fn)
+ -- The arg looked like "Foo.Bar.baz"
= upd $ \d -> d{ mainFunIs = Just main_fn,
- mainModIs = mkModule mainPackageId (mkModuleName main_mod) }
+ mainModIs = mkModule mainPackageId (mkModuleName main_mod) }
- | isUpper (head main_mod) -- The arg looked like "Foo"
- = upd $ \d -> d{ mainModIs = mkModule mainPackageId (mkModuleName main_mod) }
+ | isUpper (head arg) -- The arg looked like "Foo" or "Foo.Bar"
+ = upd $ \d -> d{ mainModIs = mkModule mainPackageId (mkModuleName arg) }
| otherwise -- The arg looked like "baz"
- = upd $ \d -> d{ mainFunIs = Just main_mod }
+ = upd $ \d -> d{ mainFunIs = Just arg }
where
(main_mod, main_fn) = splitLongestPrefix arg (== '.')
-----------------------------------------------------------------------------
-- Paths & Libraries
+addImportPath, addLibraryPath, addIncludePath, addFrameworkPath :: FilePath -> DynP ()
+
-- -i on its own deletes the import paths
addImportPath "" = upd (\s -> s{importPaths = []})
addImportPath p = upd (\s -> s{importPaths = importPaths s ++ splitPathList p})
addFrameworkPath p =
upd (\s -> s{frameworkPaths = frameworkPaths s ++ splitPathList p})
+#ifndef mingw32_TARGET_OS
+split_marker :: Char
split_marker = ':' -- not configurable (ToDo)
+#endif
splitPathList :: String -> [String]
splitPathList s = filter notNull (splitUp s)
-- finding the next split marker.
findNextPath xs =
case break (`elem` split_markers) xs of
- (p, d:ds) -> (p, ds)
+ (p, _:ds) -> (p, ds)
(p, xs) -> (p, xs)
split_markers :: [Char]
-- tmpDir, where we store temporary files.
setTmpDir :: FilePath -> DynFlags -> DynFlags
-setTmpDir dir dflags = dflags{ tmpDir = canonicalise dir }
- where
-#if !defined(mingw32_HOST_OS)
- canonicalise p = normalisePath p
-#else
- -- Canonicalisation of temp path under win32 is a bit more
- -- involved: (a) strip trailing slash,
- -- (b) normalise slashes
- -- (c) just in case, if there is a prefix /cygdrive/x/, change to x:
- --
- canonicalise path = normalisePath (xltCygdrive (removeTrailingSlash path))
-
- -- if we're operating under cygwin, and TMP/TEMP is of
- -- the form "/cygdrive/drive/path", translate this to
- -- "drive:/path" (as GHC isn't a cygwin app and doesn't
- -- understand /cygdrive paths.)
- xltCygdrive path
- | "/cygdrive/" `isPrefixOf` path =
- case drop (length "/cygdrive/") path of
- drive:xs@('/':_) -> drive:':':xs
- _ -> path
- | otherwise = path
-
- -- strip the trailing backslash (awful, but we only do this once).
- removeTrailingSlash path =
- case last path of
- '/' -> init path
- '\\' -> init path
- _ -> path
-#endif
+setTmpDir dir dflags = dflags{ tmpDir = normalise dir }
+ -- we used to fix /cygdrive/c/.. on Windows, but this doesn't
+ -- seem necessary now --SDM 7/2/2008
-----------------------------------------------------------------------------
-- Hpc stuff
-----------------------------------------------------------------------------
-- Via-C compilation stuff
+-- There are some options that we need to pass to gcc when compiling
+-- Haskell code via C, but are only supported by recent versions of
+-- gcc. The configure script decides which of these options we need,
+-- and puts them in the file "extra-gcc-opts" in $topdir, which is
+-- read before each via-C compilation. The advantage of having these
+-- in a separate file is that the file can be created at install-time
+-- depending on the available gcc version, and even re-generated later
+-- if gcc is upgraded.
+--
+-- The options below are not dependent on the version of gcc, only the
+-- platform.
+
machdepCCOpts :: DynFlags -> ([String], -- flags for all C compilations
[String]) -- for registerised HC compilations
-machdepCCOpts dflags
+machdepCCOpts _dflags
#if alpha_TARGET_ARCH
= ( ["-w", "-mieee"
#ifdef HAVE_THREADED_RTS_SUPPORT
--
-- -fomit-frame-pointer : *must* in .hc files; because we're stealing
-- the fp (%ebp) for our register maps.
- = let n_regs = stolen_x86_regs dflags
+ = let n_regs = stolen_x86_regs _dflags
sta = opt_Static
in
( [ if sta then "-DDONT_WANT_WIN32_DLL_SUPPORT" else ""
-- , if "mingw32" `isSuffixOf` cTARGETPLATFORM then "-mno-cygwin" else ""
],
[ "-fno-defer-pop",
-#ifdef HAVE_GCC_MNO_OMIT_LFPTR
- -- Some gccs are configured with
- -- -momit-leaf-frame-pointer on by default, and it
- -- apparently takes precedence over
- -- -fomit-frame-pointer, so we disable it first here.
- "-mno-omit-leaf-frame-pointer",
-#endif
-#ifdef HAVE_GCC_HAS_NO_UNIT_AT_A_TIME
- "-fno-unit-at-a-time",
- -- unit-at-a-time doesn't do us any good, and screws
- -- up -split-objs by moving the split markers around.
- -- It's only turned on with -O2, but put it here just
- -- in case someone uses -optc-O2.
-#endif
"-fomit-frame-pointer",
-- we want -fno-builtin, because when gcc inlines
-- built-in functions like memcpy() it tends to
-- and get in the way of -split-objs. Another option
-- would be to throw them away in the mangler, but this
-- is easier.
-#ifdef HAVE_GCC_HAS_NO_UNIT_AT_A_TIME
- "-fno-unit-at-a-time",
- -- unit-at-a-time doesn't do us any good, and screws
- -- up -split-objs by moving the split markers around.
- -- It's only turned on with -O2, but put it here just
- -- in case someone uses -optc-O2.
-#endif
"-fno-builtin"
-- calling builtins like strlen() using the FFI can
-- cause gcc to run out of regs, so use the external
#endif
picCCOpts :: DynFlags -> [String]
-picCCOpts dflags
+picCCOpts _dflags
#if darwin_TARGET_OS
-- Apple prefers to do things the other way round.
-- PIC is on by default.
-- in dynamic libraries.
| opt_PIC
- = ["-fno-common"]
+ = ["-fno-common", "-D__PIC__"]
| otherwise
= ["-mdynamic-no-pic"]
#elif mingw32_TARGET_OS
-- no -fPIC for Windows
+ | opt_PIC
+ = ["-D__PIC__"]
+ | otherwise
= []
#else
| opt_PIC
- = ["-fPIC"]
+ = ["-fPIC", "-D__PIC__"]
| otherwise
= []
#endif
-- Splitting
can_split :: Bool
-can_split =
-#if defined(i386_TARGET_ARCH) \
- || defined(x86_64_TARGET_ARCH) \
- || defined(alpha_TARGET_ARCH) \
- || defined(hppa_TARGET_ARCH) \
- || defined(m68k_TARGET_ARCH) \
- || defined(mips_TARGET_ARCH) \
- || defined(powerpc_TARGET_ARCH) \
- || defined(rs6000_TARGET_ARCH) \
- || defined(sparc_TARGET_ARCH)
- True
-#else
- False
-#endif
+can_split = cSplitObjs == "YES"
+
+-- -----------------------------------------------------------------------------
+-- Compiler Info
+
+compilerInfo :: [(String, String)]
+compilerInfo = [("Project name", cProjectName),
+ ("Project version", cProjectVersion),
+ ("Booter version", cBooterVersion),
+ ("Stage", cStage),
+ ("Interface file version", cHscIfaceFileVersion),
+ ("Have interpreter", cGhcWithInterpreter),
+ ("Object splitting", cSplitObjs),
+ ("Have native code generator", cGhcWithNativeCodeGen),
+ ("Support SMP", cGhcWithSMP),
+ ("Unregisterised", cGhcUnregisterised),
+ ("Tables next to code", cGhcEnableTablesNextToCode),
+ ("Win32 DLLs", cEnableWin32DLLs),
+ ("RTS ways", cGhcRTSWays),
+ ("Leading underscore", cLeadingUnderscore)]