{-# OPTIONS -fno-warn-missing-fields #-}
+{-# OPTIONS -w #-}
+-- 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
-- Dynamic flags
DynFlag(..),
DynFlags(..),
- HscTarget(..), isObjectTarget,
+ HscTarget(..), isObjectTarget, defaultObjectTarget,
GhcMode(..), isOneShot,
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 Maybes ( fromJust, orElse )
+import Util
+import Maybes ( orElse, fromJust )
import SrcLoc ( SrcSpan )
import Outputable
import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage )
import Util ( split )
#endif
-import Data.Char ( isUpper )
+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_WarnIncompletePatterns
| Opt_WarnIncompletePatternsRecUpd
| Opt_WarnMissingFields
| Opt_WarnOverlappingPatterns
| Opt_WarnSimplePatterns
| Opt_WarnTypeDefaults
+ | Opt_WarnMonomorphism
| Opt_WarnUnusedBinds
| Opt_WarnUnusedImports
| Opt_WarnUnusedMatches
| 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_IndexedTypes
+ | Opt_TypeFamilies
| Opt_OverloadedStrings
+ | Opt_DisambiguateRecordFields
+ | Opt_RecordWildCards
+ | Opt_RecordPuns
+ | Opt_ViewPatterns
+ | Opt_GADTs
+ | Opt_RelaxedPolyRec
+ | Opt_StandaloneDeriving
+ | Opt_DeriveDataTypeable
+ | Opt_TypeSynonymInstances
+ | Opt_FlexibleContexts
+ | Opt_FlexibleInstances
+ | Opt_ConstrainedClassMethods
+ | Opt_MultiParamTypeClasses
+ | Opt_FunctionalDependencies
+ | Opt_UnicodeSyntax
+ | Opt_PolymorphicComponents
+ | Opt_ExistentialQuantification
+ | 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_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
ruleCheck :: Maybe String,
- specThreshold :: Int, -- Threshold for function specialisation
+ specConstrThreshold :: Maybe Int, -- Threshold for SpecConstr
+ 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
= NoLink -- Don't link at all
| LinkBinary -- Link object code into a binary
| LinkInMemory -- Use the in-memory dynamic linker
- | MkDLL -- Make a DLL
- deriving Eq
+ | LinkDynLib -- Link objects into a dynamic lib (DLL on Windows, DSO on ELF platforms)
+ deriving (Eq, Show)
isNoLink :: GhcLink -> Bool
isNoLink NoLink = True
| IgnorePackage String
deriving Eq
-defaultHscTarget
+defaultHscTarget = defaultObjectTarget
+
+-- | the 'HscTarget' value corresponding to the default way to create
+-- object files on the current platform.
+defaultObjectTarget
| cGhcWithNativeCodeGen == "YES" = HscAsm
| otherwise = HscC
+data DynLibLoader
+ = Deployable
+ | Wrapped (Maybe String)
+ | SystemDependent
+ deriving Eq
+
initDynFlags dflags = do
-- someday these will be dynamic flags
ways <- readIORef v_Ways
extCoreName = "",
verbosity = 0,
optLevel = 0,
+ simplPhases = 2,
maxSimplIterations = 4,
ruleCheck = Nothing,
- specThreshold = 200,
+ specConstrThreshold = Just 200,
+ 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 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
updOptLevel :: Int -> DynFlags -> DynFlags
-- Set dynflags appropriate to the optimisation level
updOptLevel n dfs
- = dfs2{ optLevel = n }
+ = dfs2{ optLevel = final_n }
where
+ final_n = max 0 (min 2 n) -- Clamp to 0 <= n <= 2
dfs1 = foldr (flip dopt_unset) dfs remove_dopts
dfs2 = foldr (flip dopt_set) dfs1 extra_dopts
- extra_dopts = [ f | (ns,f) <- optLevelFlags, n `elem` ns ]
- remove_dopts = [ f | (ns,f) <- optLevelFlags, n `notElem` ns ]
+ extra_dopts = [ f | (ns,f) <- optLevelFlags, final_n `elem` ns ]
+ remove_dopts = [ f | (ns,f) <- optLevelFlags, final_n `notElem` ns ]
optLevelFlags :: [([Int], DynFlag)]
optLevelFlags
= [ ([0], Opt_IgnoreInterfacePragmas)
, ([0], Opt_OmitInterfacePragmas)
+
, ([1,2], Opt_IgnoreAsserts)
+ , ([1,2], Opt_RewriteRules) -- Off for -O0; see Note [Scoping for Builtin rules]
+ -- in PrelRules
, ([1,2], Opt_DoEtaReduction)
, ([1,2], Opt_CaseMerge)
, ([1,2], Opt_Strictness)
, ([1,2], Opt_CSE)
, ([1,2], Opt_FullLaziness)
+
, ([2], Opt_LiberateCase)
, ([2], Opt_SpecConstr)
Opt_WarnOrphans
]
+-- minuswRemovesOpts should be every warning option
+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
runWhen True do_this = do_this
runWhen False do_this = CoreDoNothing
+runMaybe :: Maybe a -> (a -> CoreToDo) -> CoreToDo
+runMaybe (Just x) f = f x
+runMaybe Nothing _ = CoreDoNothing
+
getCoreToDo :: DynFlags -> [CoreToDo]
getCoreToDo dflags
| Just todo <- coreToDo dflags = todo -- set explicitly by user
| 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
+
+ maybe_rule_check phase = runMaybe rule_check (CoreDoRuleCheck phase)
+
+ simpl_phase phase iter = CoreDoPasses
+ [ CoreDoSimplify (SimplPhase phase) [
+ 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 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 max_iter]
+ else {- opt_level >= 1 -} [
+
+ -- 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 },
+ simpl_phases,
- 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 },
-
- 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 (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 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 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 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
-------- Linking ----------------------------------------------------
, ( "c" , NoArg (upd $ \d -> d{ ghcLink=NoLink } ))
, ( "no-link" , NoArg (upd $ \d -> d{ ghcLink=NoLink } )) -- Dep.
- , ( "-mk-dll" , NoArg (upd $ \d -> d{ ghcLink=MkDLL } ))
+ , ( "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 -------------------------------------
- , ( "keep-hc-file" , AnySuffix (\_ -> setDynFlag Opt_KeepHcFiles))
- , ( "keep-s-file" , AnySuffix (\_ -> setDynFlag Opt_KeepSFiles))
- , ( "keep-raw-s-file", AnySuffix (\_ -> setDynFlag Opt_KeepRawSFiles))
- , ( "keep-tmp-files" , AnySuffix (\_ -> setDynFlag Opt_KeepTmpFiles))
+ -- These can be singular (think ghc -c) or plural (think ghc --make)
+ , ( "keep-hc-file" , NoArg (setDynFlag Opt_KeepHcFiles))
+ , ( "keep-hc-files" , NoArg (setDynFlag Opt_KeepHcFiles))
+ , ( "keep-s-file" , NoArg (setDynFlag Opt_KeepSFiles))
+ , ( "keep-s-files" , NoArg (setDynFlag Opt_KeepSFiles))
+ , ( "keep-raw-s-file" , NoArg (setDynFlag Opt_KeepRawSFiles))
+ , ( "keep-raw-s-files", NoArg (setDynFlag Opt_KeepRawSFiles))
+ -- This only makes sense as plural
+ , ( "keep-tmp-files" , NoArg (setDynFlag Opt_KeepTmpFiles))
------- Miscellaneous ----------------------------------------------
, ( "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", setDumpFlag Opt_D_dump_simpl_phases)
, ( "ddump-spec", setDumpFlag Opt_D_dump_spec)
, ( "ddump-prep", setDumpFlag Opt_D_dump_prep)
, ( "ddump-stg", setDumpFlag Opt_D_dump_stg)
, ( "dsource-stats", setDumpFlag Opt_D_source_stats)
, ( "dverbose-core2core", setDumpFlag Opt_D_verbose_core2core)
, ( "dverbose-stg2stg", setDumpFlag Opt_D_verbose_stg2stg)
- , ( "ddump-hi-diffs", setDumpFlag Opt_D_dump_hi_diffs)
, ( "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 })))
+ , ( "fspec-constr-threshold", IntSuffix (\n ->
+ upd (\dfs -> dfs{ specConstrThreshold = Just n })))
+ , ( "fno-spec-constr-threshold", NoArg (
+ upd (\dfs -> dfs{ specConstrThreshold = 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 })))
+ , ( "frule-check", SepArg (\s -> upd (\dfs -> dfs{ ruleCheck = Just s })))
, ( "fcontext-stack" , IntSuffix $ \n -> upd $ \dfs -> dfs{ ctxtStkDepth = n })
------ Compiler flags -----------------------------------------------
- , ( "fasm", AnySuffix (\_ -> 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
- , ( "fno-", PrefixPred (\f -> isFFlag f) (\f -> unSetDynFlag (getFFlag f)) )
- , ( "f", PrefixPred (\f -> isFFlag f) (\f -> setDynFlag (getFFlag 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 = [
- ( "warn-duplicate-exports", Opt_WarnDuplicateExports ),
- ( "warn-hi-shadowing", Opt_WarnHiShadows ),
- ( "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-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 ),
- ( "fi", Opt_FFI ), -- support `-ffi'...
- ( "ffi", Opt_FFI ), -- ...and also `-fffi'
- ( "arrows", Opt_Arrows ), -- arrow syntax
- ( "parr", Opt_PArr ),
- ( "th", Opt_TH ),
- ( "implicit-prelude", Opt_ImplicitPrelude ),
- ( "scoped-type-variables", Opt_ScopedTypeVariables ),
- ( "bang-patterns", Opt_BangPatterns ),
- ( "overloaded-strings", Opt_OverloadedStrings ),
- ( "indexed-types", Opt_IndexedTypes ),
- ( "monomorphism-restriction", Opt_MonomorphismRestriction ),
- ( "mono-pat-binds", Opt_MonoPatBinds ),
- ( "extended-default-rules", Opt_ExtendedDefaultRules ),
- ( "implicit-params", Opt_ImplicitParams ),
- ( "allow-overlapping-instances", Opt_AllowOverlappingInstances ),
- ( "allow-undecidable-instances", Opt_AllowUndecidableInstances ),
- ( "allow-incoherent-instances", Opt_AllowIncoherentInstances ),
- ( "generics", Opt_Generics ),
- ( "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 )
+ ( "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 ),
+ ( "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 ),
+ ( "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>
+xFlags :: [(String, DynFlag)]
+xFlags = [
+ ( "CPP", Opt_Cpp ),
+ ( "PatternGuards", Opt_PatternGuards ),
+ ( "UnicodeSyntax", Opt_UnicodeSyntax ),
+ ( "MagicHash", Opt_MagicHash ),
+ ( "PolymorphicComponents", Opt_PolymorphicComponents ),
+ ( "ExistentialQuantification", Opt_ExistentialQuantification ),
+ ( "KindSignatures", Opt_KindSignatures ),
+ ( "PatternSignatures", Opt_PatternSignatures ),
+ ( "EmptyDataDecls", Opt_EmptyDataDecls ),
+ ( "ParallelListComp", Opt_ParallelListComp ),
+ ( "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 ),
+ ( "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 )
+ ]
-glasgowExtsFlags = [
- Opt_GlasgowExts,
- Opt_FFI,
- Opt_ImplicitParams,
- Opt_ScopedTypeVariables,
- Opt_IndexedTypes ]
+impliedFlags :: [(DynFlag, [DynFlag])]
+impliedFlags = [
+ ( 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
+ ]
-isFFlag f = f `elem` (map fst fFlags)
-getFFlag f = fromJust (lookup f fFlags)
+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_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 ]
+
+------------------
+isFlag :: [(String,a)] -> String -> Bool
+isFlag flags f = any (\(ff,_) -> ff == f) flags
+
+isPrefFlag :: String -> [(String,a)] -> String -> Bool
+isPrefFlag pref flags no_f
+ | Just f <- maybePrefixMatch pref no_f = isFlag flags f
+ | otherwise = False
+
+------------------
+getFlag :: [(String,a)] -> String -> a
+getFlag flags f = case [ opt | (ff, opt) <- flags, ff == f] of
+ (o:os) -> o
+ [] -> panic ("get_flag " ++ f)
+
+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.
dfs <- getCmdLineState
putCmdLineState $! (f dfs)
+--------------------------
setDynFlag, unSetDynFlag :: DynFlag -> DynP ()
-setDynFlag f = upd (\dfs -> dopt_set dfs f)
+setDynFlag f = upd (\dfs -> foldl dopt_set (dopt_set dfs f) deps)
+ where
+ deps = [ d | (f', ds) <- impliedFlags, f' == f, d <- ds ]
+ -- When you set f, set the ones it implies
+ -- When you un-set f, however, we don't un-set the things it implies
+ -- (except for -fno-glasgow-exts, which is treated specially)
+
unSetDynFlag f = upd (\dfs -> dopt_unset dfs f)
+--------------------------
setDumpFlag :: DynFlag -> OptKind DynP
setDumpFlag dump_flag
= NoArg (setDynFlag Opt_ForceRecomp >> setDynFlag dump_flag)
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 (== '.')
setTmpDir dir dflags = dflags{ tmpDir = canonicalise dir }
where
#if !defined(mingw32_HOST_OS)
- canonicalise p = normalisePath p
+ canonicalise p = normalise 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
+ -- 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 = removeTrailingSlash $ normalise $ xltCygdrive 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.)
+ cygdrivePrefix = [pathSeparator] ++ "/cygdrive/" ++ [pathSeparator]
+ xltCygdrive path = case maybePrefixMatch cygdrivePrefix path of
+ Just (drive:sep:xs)
+ | isPathSeparator sep -> drive:':':pathSeparator:xs
+ _ -> path
+
+ -- strip the trailing backslash (awful, but we only do this once).
+ removeTrailingSlash path
+ | isPathSeparator (last path) = init path
+ | otherwise = path
#endif
-----------------------------------------------------------------------------
-----------------------------------------------------------------------------
-- 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
sta = opt_Static
in
( [ if sta then "-DDONT_WANT_WIN32_DLL_SUPPORT" else ""
--- , if suffixMatch "mingw32" cTARGETPLATFORM then "-mno-cygwin" 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
-- 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)]