Add OverloadedLists, allowing list syntax to be overloaded
[ghc.git] / compiler / main / DynFlags.hs
1 -------------------------------------------------------------------------------
2 --
3 -- | Dynamic flags
4 --
5 -- Most flags are dynamic flags, which means they can change from compilation
6 -- to compilation using @OPTIONS_GHC@ pragmas, and in a multi-session GHC each
7 -- session can be using different dynamic flags. Dynamic flags can also be set
8 -- at the prompt in GHCi.
9 --
10 -- (c) The University of Glasgow 2005
11 --
12 -------------------------------------------------------------------------------
13
14 {-# OPTIONS -fno-cse #-}
15 -- -fno-cse is needed for GLOBAL_VAR's to behave properly
16
17 module DynFlags (
18 -- * Dynamic flags and associated configuration types
19 DumpFlag(..),
20 GeneralFlag(..),
21 WarningFlag(..),
22 ExtensionFlag(..),
23 Language(..),
24 PlatformConstants(..),
25 FatalMessager, LogAction, FlushOut(..), FlushErr(..),
26 ProfAuto(..),
27 glasgowExtsFlags,
28 dopt,
29 gopt, gopt_set, gopt_unset,
30 wopt, wopt_set, wopt_unset,
31 xopt, xopt_set, xopt_unset,
32 lang_set,
33 whenGeneratingDynamicToo, ifGeneratingDynamicToo,
34 whenCannotGenerateDynamicToo,
35 doDynamicToo,
36 DynFlags(..),
37 HasDynFlags(..), ContainsDynFlags(..),
38 RtsOptsEnabled(..),
39 HscTarget(..), isObjectTarget, defaultObjectTarget,
40 targetRetainsAllBindings,
41 GhcMode(..), isOneShot,
42 GhcLink(..), isNoLink,
43 PackageFlag(..),
44 PkgConfRef(..),
45 Option(..), showOpt,
46 DynLibLoader(..),
47 fFlags, fWarningFlags, fLangFlags, xFlags,
48 dynFlagDependencies,
49 tablesNextToCode, mkTablesNextToCode,
50
51 printOutputForUser, printInfoForUser,
52
53 Way(..), mkBuildTag, wayRTSOnly,
54
55 -- ** Safe Haskell
56 SafeHaskellMode(..),
57 safeHaskellOn, safeImportsOn, safeLanguageOn, safeInferOn,
58 packageTrustOn,
59 safeDirectImpsReq, safeImplicitImpsReq,
60 unsafeFlags,
61
62 -- ** System tool settings and locations
63 Settings(..),
64 targetPlatform,
65 ghcUsagePath, ghciUsagePath, topDir, tmpDir, rawSettings,
66 extraGccViaCFlags, systemPackageConfig,
67 pgm_L, pgm_P, pgm_F, pgm_c, pgm_s, pgm_a, pgm_l, pgm_dll, pgm_T,
68 pgm_sysman, pgm_windres, pgm_lo, pgm_lc,
69 opt_L, opt_P, opt_F, opt_c, opt_a, opt_l,
70 opt_windres, opt_lo, opt_lc,
71
72
73 -- ** Manipulating DynFlags
74 defaultDynFlags, -- Settings -> DynFlags
75 defaultWays,
76 initDynFlags, -- DynFlags -> IO DynFlags
77 defaultFatalMessager,
78 defaultLogAction,
79 defaultLogActionHPrintDoc,
80 defaultFlushOut,
81 defaultFlushErr,
82
83 getOpts, -- DynFlags -> (DynFlags -> [a]) -> [a]
84 getVerbFlags,
85 updOptLevel,
86 setTmpDir,
87 setPackageName,
88
89 -- ** Parsing DynFlags
90 parseDynamicFlagsCmdLine,
91 parseDynamicFilePragma,
92 parseDynamicFlagsFull,
93
94 -- ** Available DynFlags
95 allFlags,
96 flagsAll,
97 flagsDynamic,
98 flagsPackage,
99
100 supportedLanguagesAndExtensions,
101
102 -- ** DynFlags C compiler options
103 picCCOpts, picPOpts,
104
105 -- * Configuration of the stg-to-stg passes
106 StgToDo(..),
107 getStgToDo,
108
109 -- * Compiler configuration suitable for display to the user
110 compilerInfo,
111
112 #ifdef GHCI
113 -- Only in stage 2 can we be sure that the RTS
114 -- exposes the appropriate runtime boolean
115 rtsIsProfiled,
116 #endif
117
118 #include "../includes/dist-derivedconstants/header/GHCConstantsHaskellExports.hs"
119 bLOCK_SIZE_W,
120 wORD_SIZE_IN_BITS,
121 tAG_MASK,
122 mAX_PTR_TAG,
123 tARGET_MIN_INT, tARGET_MAX_INT, tARGET_MAX_WORD,
124
125 unsafeGlobalDynFlags, setUnsafeGlobalDynFlags,
126
127 -- * SSE
128 isSse2Enabled,
129 isSse4_2Enabled,
130 ) where
131
132 #include "HsVersions.h"
133
134 import Platform
135 import PlatformConstants
136 import Module
137 import PackageConfig
138 import {-# SOURCE #-} PrelNames ( mAIN )
139 import {-# SOURCE #-} Packages (PackageState)
140 import DriverPhases ( Phase(..), phaseInputExt )
141 import Config
142 import CmdLineParser
143 import Constants
144 import Panic
145 import Util
146 import Maybes ( orElse )
147 import MonadUtils
148 import qualified Pretty
149 import SrcLoc
150 import FastString
151 import Outputable
152 #ifdef GHCI
153 import Foreign.C ( CInt(..) )
154 #endif
155 import {-# SOURCE #-} ErrUtils ( Severity(..), MsgDoc, mkLocMessage )
156
157 import System.IO.Unsafe ( unsafePerformIO )
158 import Data.IORef
159 import Control.Monad
160
161 import Data.Bits
162 import Data.Char
163 import Data.Int
164 import Data.List
165 import Data.Map (Map)
166 import qualified Data.Map as Map
167 import Data.Set (Set)
168 import qualified Data.Set as Set
169 import Data.Word
170 import System.FilePath
171 import System.IO
172
173 import Data.IntSet (IntSet)
174 import qualified Data.IntSet as IntSet
175
176 -- -----------------------------------------------------------------------------
177 -- DynFlags
178
179 data DumpFlag
180
181 -- debugging flags
182 = Opt_D_dump_cmm
183 | Opt_D_dump_cmm_raw
184 -- All of the cmm subflags (there are a lot!) Automatically
185 -- enabled if you run -ddump-cmm
186 | Opt_D_dump_cmm_cfg
187 | Opt_D_dump_cmm_cbe
188 | Opt_D_dump_cmm_proc
189 | Opt_D_dump_cmm_rewrite
190 | Opt_D_dump_cmm_sp
191 | Opt_D_dump_cmm_procmap
192 | Opt_D_dump_cmm_split
193 | Opt_D_dump_cmm_info
194 | Opt_D_dump_cmm_cps
195 -- end cmm subflags
196 | Opt_D_dump_asm
197 | Opt_D_dump_asm_native
198 | Opt_D_dump_asm_liveness
199 | Opt_D_dump_asm_regalloc
200 | Opt_D_dump_asm_regalloc_stages
201 | Opt_D_dump_asm_conflicts
202 | Opt_D_dump_asm_stats
203 | Opt_D_dump_asm_expanded
204 | Opt_D_dump_llvm
205 | Opt_D_dump_core_stats
206 | Opt_D_dump_deriv
207 | Opt_D_dump_ds
208 | Opt_D_dump_foreign
209 | Opt_D_dump_inlinings
210 | Opt_D_dump_rule_firings
211 | Opt_D_dump_rule_rewrites
212 | Opt_D_dump_simpl_trace
213 | Opt_D_dump_occur_anal
214 | Opt_D_dump_parsed
215 | Opt_D_dump_rn
216 | Opt_D_dump_core_pipeline -- TODO FIXME: dump after simplifier stats
217 | Opt_D_dump_simpl
218 | Opt_D_dump_simpl_iterations
219 | Opt_D_dump_simpl_phases
220 | Opt_D_dump_spec
221 | Opt_D_dump_prep
222 | Opt_D_dump_stg
223 | Opt_D_dump_stranal
224 | Opt_D_dump_tc
225 | Opt_D_dump_types
226 | Opt_D_dump_rules
227 | Opt_D_dump_cse
228 | Opt_D_dump_worker_wrapper
229 | Opt_D_dump_rn_trace
230 | Opt_D_dump_rn_stats
231 | Opt_D_dump_opt_cmm
232 | Opt_D_dump_simpl_stats
233 | Opt_D_dump_cs_trace -- Constraint solver in type checker
234 | Opt_D_dump_tc_trace
235 | Opt_D_dump_if_trace
236 | Opt_D_dump_vt_trace
237 | Opt_D_dump_splices
238 | Opt_D_dump_BCOs
239 | Opt_D_dump_vect
240 | Opt_D_dump_ticked
241 | Opt_D_dump_rtti
242 | Opt_D_source_stats
243 | Opt_D_verbose_stg2stg
244 | Opt_D_dump_hi
245 | Opt_D_dump_hi_diffs
246 | Opt_D_dump_mod_cycles
247 | Opt_D_dump_view_pattern_commoning
248 | Opt_D_verbose_core2core
249
250 deriving (Eq, Show, Enum)
251
252 -- | Enumerates the simple on-or-off dynamic flags
253 data GeneralFlag
254
255 = Opt_DumpToFile -- ^ Append dump output to files instead of stdout.
256 | Opt_D_faststring_stats
257 | Opt_D_dump_minimal_imports
258 | Opt_DoCoreLinting
259 | Opt_DoStgLinting
260 | Opt_DoCmmLinting
261 | Opt_DoAsmLinting
262 | Opt_NoLlvmMangler -- hidden flag
263
264 | Opt_WarnIsError -- -Werror; makes warnings fatal
265
266 | Opt_PrintExplicitForalls
267
268 -- optimisation opts
269 | Opt_Strictness
270 | Opt_FullLaziness
271 | Opt_FloatIn
272 | Opt_Specialise
273 | Opt_StaticArgumentTransformation
274 | Opt_CSE
275 | Opt_LiberateCase
276 | Opt_SpecConstr
277 | Opt_DoLambdaEtaExpansion
278 | Opt_IgnoreAsserts
279 | Opt_DoEtaReduction
280 | Opt_CaseMerge
281 | Opt_UnboxStrictFields
282 | Opt_UnboxSmallStrictFields
283 | Opt_DictsCheap
284 | Opt_EnableRewriteRules -- Apply rewrite rules during simplification
285 | Opt_Vectorise
286 | Opt_VectorisationAvoidance
287 | Opt_RegsGraph -- do graph coloring register allocation
288 | Opt_RegsIterative -- do iterative coalescing graph coloring register allocation
289 | Opt_PedanticBottoms -- Be picky about how we treat bottom
290 | Opt_LlvmTBAA -- Use LLVM TBAA infastructure for improving AA (hidden flag)
291 | Opt_IrrefutableTuples
292 | Opt_CmmSink
293 | Opt_CmmElimCommonBlocks
294 | Opt_OmitYields
295 | Opt_SimpleListLiterals
296
297 -- Interface files
298 | Opt_IgnoreInterfacePragmas
299 | Opt_OmitInterfacePragmas
300 | Opt_ExposeAllUnfoldings
301
302 -- profiling opts
303 | Opt_AutoSccsOnIndividualCafs
304 | Opt_ProfCountEntries
305
306 -- misc opts
307 | Opt_Pp
308 | Opt_ForceRecomp
309 | Opt_ExcessPrecision
310 | Opt_EagerBlackHoling
311 | Opt_NoHsMain
312 | Opt_SplitObjs
313 | Opt_StgStats
314 | Opt_HideAllPackages
315 | Opt_PrintBindResult
316 | Opt_Haddock
317 | Opt_HaddockOptions
318 | Opt_Hpc_No_Auto
319 | Opt_BreakOnException
320 | Opt_BreakOnError
321 | Opt_PrintEvldWithShow
322 | Opt_PrintBindContents
323 | Opt_GenManifest
324 | Opt_EmbedManifest
325 | Opt_EmitExternalCore
326 | Opt_SharedImplib
327 | Opt_BuildingCabalPackage
328 | Opt_IgnoreDotGhci
329 | Opt_GhciSandbox
330 | Opt_GhciHistory
331 | Opt_HelpfulErrors
332 | Opt_DeferTypeErrors
333 | Opt_Parallel
334 | Opt_GranMacros
335 | Opt_PIC
336 | Opt_SccProfilingOn
337 | Opt_Ticky
338 | Opt_Static
339 | Opt_RPath
340 | Opt_RelativeDynlibPaths
341 | Opt_Hpc
342
343 -- PreInlining is on by default. The option is there just to see how
344 -- bad things get if you turn it off!
345 | Opt_SimplPreInlining
346
347 -- output style opts
348 | Opt_ErrorSpans -- Include full span info in error messages,
349 -- instead of just the start position.
350 | Opt_PprCaseAsLet
351
352 -- Suppress all coercions, them replacing with '...'
353 | Opt_SuppressCoercions
354 | Opt_SuppressVarKinds
355 -- Suppress module id prefixes on variables.
356 | Opt_SuppressModulePrefixes
357 -- Suppress type applications.
358 | Opt_SuppressTypeApplications
359 -- Suppress info such as arity and unfoldings on identifiers.
360 | Opt_SuppressIdInfo
361 -- Suppress separate type signatures in core, but leave types on
362 -- lambda bound vars
363 | Opt_SuppressTypeSignatures
364 -- Suppress unique ids on variables.
365 -- Except for uniques, as some simplifier phases introduce new
366 -- variables that have otherwise identical names.
367 | Opt_SuppressUniques
368
369 -- temporary flags
370 | Opt_RunCPS
371 | Opt_RunCPSZ
372 | Opt_AutoLinkPackages
373 | Opt_ImplicitImportQualified
374
375 -- keeping stuff
376 | Opt_KeepHiDiffs
377 | Opt_KeepHcFiles
378 | Opt_KeepSFiles
379 | Opt_KeepTmpFiles
380 | Opt_KeepRawTokenStream
381 | Opt_KeepLlvmFiles
382
383 | Opt_BuildDynamicToo
384
385 -- safe haskell flags
386 | Opt_DistrustAllPackages
387 | Opt_PackageTrust
388
389 deriving (Eq, Show, Enum)
390
391 data WarningFlag =
392 Opt_WarnDuplicateExports
393 | Opt_WarnDuplicateConstraints
394 | Opt_WarnHiShadows
395 | Opt_WarnImplicitPrelude
396 | Opt_WarnIncompletePatterns
397 | Opt_WarnIncompleteUniPatterns
398 | Opt_WarnIncompletePatternsRecUpd
399 | Opt_WarnMissingFields
400 | Opt_WarnMissingImportList
401 | Opt_WarnMissingMethods
402 | Opt_WarnMissingSigs
403 | Opt_WarnMissingLocalSigs
404 | Opt_WarnNameShadowing
405 | Opt_WarnOverlappingPatterns
406 | Opt_WarnTypeDefaults
407 | Opt_WarnMonomorphism
408 | Opt_WarnUnusedBinds
409 | Opt_WarnUnusedImports
410 | Opt_WarnUnusedMatches
411 | Opt_WarnWarningsDeprecations
412 | Opt_WarnDeprecatedFlags
413 | Opt_WarnDodgyExports
414 | Opt_WarnDodgyImports
415 | Opt_WarnOrphans
416 | Opt_WarnAutoOrphans
417 | Opt_WarnIdentities
418 | Opt_WarnTabs
419 | Opt_WarnUnrecognisedPragmas
420 | Opt_WarnDodgyForeignImports
421 | Opt_WarnLazyUnliftedBindings
422 | Opt_WarnUnusedDoBind
423 | Opt_WarnWrongDoBind
424 | Opt_WarnAlternativeLayoutRuleTransitional
425 | Opt_WarnUnsafe
426 | Opt_WarnSafe
427 | Opt_WarnPointlessPragmas
428 | Opt_WarnUnsupportedCallingConventions
429 | Opt_WarnUnsupportedLlvmVersion
430 | Opt_WarnInlineRuleShadowing
431 | Opt_WarnTypeableInstances
432 deriving (Eq, Show, Enum)
433
434 data Language = Haskell98 | Haskell2010
435 deriving Enum
436
437 -- | The various Safe Haskell modes
438 data SafeHaskellMode
439 = Sf_None
440 | Sf_Unsafe
441 | Sf_Trustworthy
442 | Sf_Safe
443 | Sf_SafeInferred
444 deriving (Eq)
445
446 instance Show SafeHaskellMode where
447 show Sf_None = "None"
448 show Sf_Unsafe = "Unsafe"
449 show Sf_Trustworthy = "Trustworthy"
450 show Sf_Safe = "Safe"
451 show Sf_SafeInferred = "Safe-Inferred"
452
453 instance Outputable SafeHaskellMode where
454 ppr = text . show
455
456 data ExtensionFlag
457 = Opt_Cpp
458 | Opt_OverlappingInstances
459 | Opt_UndecidableInstances
460 | Opt_IncoherentInstances
461 | Opt_MonomorphismRestriction
462 | Opt_MonoPatBinds
463 | Opt_MonoLocalBinds
464 | Opt_RelaxedPolyRec -- Deprecated
465 | Opt_ExtendedDefaultRules -- Use GHC's extended rules for defaulting
466 | Opt_ForeignFunctionInterface
467 | Opt_UnliftedFFITypes
468 | Opt_InterruptibleFFI
469 | Opt_CApiFFI
470 | Opt_GHCForeignImportPrim
471 | Opt_ParallelArrays -- Syntactic support for parallel arrays
472 | Opt_Arrows -- Arrow-notation syntax
473 | Opt_TemplateHaskell
474 | Opt_QuasiQuotes
475 | Opt_ImplicitParams
476 | Opt_ImplicitPrelude
477 | Opt_ScopedTypeVariables
478 | Opt_AllowAmbiguousTypes
479 | Opt_UnboxedTuples
480 | Opt_BangPatterns
481 | Opt_TypeFamilies
482 | Opt_OverloadedStrings
483 | Opt_OverloadedLists
484 | Opt_DisambiguateRecordFields
485 | Opt_RecordWildCards
486 | Opt_RecordPuns
487 | Opt_ViewPatterns
488 | Opt_GADTs
489 | Opt_GADTSyntax
490 | Opt_NPlusKPatterns
491 | Opt_DoAndIfThenElse
492 | Opt_RebindableSyntax
493 | Opt_ConstraintKinds
494 | Opt_PolyKinds -- Kind polymorphism
495 | Opt_DataKinds -- Datatype promotion
496 | Opt_InstanceSigs
497
498 | Opt_StandaloneDeriving
499 | Opt_DeriveDataTypeable
500 | Opt_AutoDeriveTypeable -- Automatic derivation of Typeable
501 | Opt_DeriveFunctor
502 | Opt_DeriveTraversable
503 | Opt_DeriveFoldable
504 | Opt_DeriveGeneric -- Allow deriving Generic/1
505 | Opt_DefaultSignatures -- Allow extra signatures for defmeths
506
507 | Opt_TypeSynonymInstances
508 | Opt_FlexibleContexts
509 | Opt_FlexibleInstances
510 | Opt_ConstrainedClassMethods
511 | Opt_MultiParamTypeClasses
512 | Opt_FunctionalDependencies
513 | Opt_UnicodeSyntax
514 | Opt_ExistentialQuantification
515 | Opt_MagicHash
516 | Opt_EmptyDataDecls
517 | Opt_KindSignatures
518 | Opt_ParallelListComp
519 | Opt_TransformListComp
520 | Opt_MonadComprehensions
521 | Opt_GeneralizedNewtypeDeriving
522 | Opt_RecursiveDo
523 | Opt_PostfixOperators
524 | Opt_TupleSections
525 | Opt_PatternGuards
526 | Opt_LiberalTypeSynonyms
527 | Opt_RankNTypes
528 | Opt_ImpredicativeTypes
529 | Opt_TypeOperators
530 | Opt_ExplicitNamespaces
531 | Opt_PackageImports
532 | Opt_ExplicitForAll
533 | Opt_AlternativeLayoutRule
534 | Opt_AlternativeLayoutRuleTransitional
535 | Opt_DatatypeContexts
536 | Opt_NondecreasingIndentation
537 | Opt_RelaxedLayout
538 | Opt_TraditionalRecordSyntax
539 | Opt_LambdaCase
540 | Opt_MultiWayIf
541 | Opt_TypeHoles
542 | Opt_EmptyCase
543 deriving (Eq, Enum, Show)
544
545 -- | Contains not only a collection of 'GeneralFlag's but also a plethora of
546 -- information relating to the compilation of a single file or GHC session
547 data DynFlags = DynFlags {
548 ghcMode :: GhcMode,
549 ghcLink :: GhcLink,
550 hscTarget :: HscTarget,
551 settings :: Settings,
552 hscOutName :: String, -- ^ Name of the output file
553 extCoreName :: String, -- ^ Name of the .hcr output file
554 verbosity :: Int, -- ^ Verbosity level: see Note [Verbosity levels]
555 optLevel :: Int, -- ^ Optimisation level
556 simplPhases :: Int, -- ^ Number of simplifier phases
557 maxSimplIterations :: Int, -- ^ Max simplifier iterations
558 shouldDumpSimplPhase :: Maybe String,
559 ruleCheck :: Maybe String,
560 strictnessBefore :: [Int], -- ^ Additional demand analysis
561
562 simplTickFactor :: Int, -- ^ Multiplier for simplifier ticks
563 specConstrThreshold :: Maybe Int, -- ^ Threshold for SpecConstr
564 specConstrCount :: Maybe Int, -- ^ Max number of specialisations for any one function
565 liberateCaseThreshold :: Maybe Int, -- ^ Threshold for LiberateCase
566 floatLamArgs :: Maybe Int, -- ^ Arg count for lambda floating
567 -- See CoreMonad.FloatOutSwitches
568 historySize :: Int,
569
570 cmdlineHcIncludes :: [String], -- ^ @\-\#includes@
571 importPaths :: [FilePath],
572 mainModIs :: Module,
573 mainFunIs :: Maybe String,
574 ctxtStkDepth :: Int, -- ^ Typechecker context stack depth
575
576 thisPackage :: PackageId, -- ^ name of package currently being compiled
577
578 -- ways
579 ways :: [Way], -- ^ Way flags from the command line
580 buildTag :: String, -- ^ The global \"way\" (e.g. \"p\" for prof)
581 rtsBuildTag :: String, -- ^ The RTS \"way\"
582
583 -- For object splitting
584 splitInfo :: Maybe (String,Int),
585
586 -- paths etc.
587 objectDir :: Maybe String,
588 dylibInstallName :: Maybe String,
589 hiDir :: Maybe String,
590 stubDir :: Maybe String,
591 dumpDir :: Maybe String,
592
593 objectSuf :: String,
594 hcSuf :: String,
595 hiSuf :: String,
596
597 canGenerateDynamicToo :: IORef Bool,
598 dynObjectSuf :: String,
599 dynHiSuf :: String,
600
601 outputFile :: Maybe String,
602 dynOutputFile :: Maybe String,
603 outputHi :: Maybe String,
604 dynLibLoader :: DynLibLoader,
605
606 -- | This is set by 'DriverPipeline.runPipeline' based on where
607 -- its output is going.
608 dumpPrefix :: Maybe FilePath,
609
610 -- | Override the 'dumpPrefix' set by 'DriverPipeline.runPipeline'.
611 -- Set by @-ddump-file-prefix@
612 dumpPrefixForce :: Maybe FilePath,
613
614 ldInputs :: [String],
615
616 includePaths :: [String],
617 libraryPaths :: [String],
618 frameworkPaths :: [String], -- used on darwin only
619 cmdlineFrameworks :: [String], -- ditto
620
621 rtsOpts :: Maybe String,
622 rtsOptsEnabled :: RtsOptsEnabled,
623
624 hpcDir :: String, -- ^ Path to store the .mix files
625
626 -- Plugins
627 pluginModNames :: [ModuleName],
628 pluginModNameOpts :: [(ModuleName,String)],
629
630 -- For ghc -M
631 depMakefile :: FilePath,
632 depIncludePkgDeps :: Bool,
633 depExcludeMods :: [ModuleName],
634 depSuffixes :: [String],
635
636 -- Package flags
637 extraPkgConfs :: [PkgConfRef] -> [PkgConfRef],
638 -- ^ The @-package-db@ flags given on the command line, in the order
639 -- they appeared.
640
641 packageFlags :: [PackageFlag],
642 -- ^ The @-package@ and @-hide-package@ flags from the command-line
643
644 -- Package state
645 -- NB. do not modify this field, it is calculated by
646 -- Packages.initPackages and Packages.updatePackages.
647 pkgDatabase :: Maybe [PackageConfig],
648 pkgState :: PackageState,
649
650 -- Temporary files
651 -- These have to be IORefs, because the defaultCleanupHandler needs to
652 -- know what to clean when an exception happens
653 filesToClean :: IORef [FilePath],
654 dirsToClean :: IORef (Map FilePath FilePath),
655 filesToNotIntermediateClean :: IORef [FilePath],
656
657
658 -- Names of files which were generated from -ddump-to-file; used to
659 -- track which ones we need to truncate because it's our first run
660 -- through
661 generatedDumps :: IORef (Set FilePath),
662
663 -- hsc dynamic flags
664 dumpFlags :: IntSet,
665 generalFlags :: IntSet,
666 warningFlags :: IntSet,
667 -- Don't change this without updating extensionFlags:
668 language :: Maybe Language,
669 -- | Safe Haskell mode
670 safeHaskell :: SafeHaskellMode,
671 -- We store the location of where some extension and flags were turned on so
672 -- we can produce accurate error messages when Safe Haskell fails due to
673 -- them.
674 thOnLoc :: SrcSpan,
675 newDerivOnLoc :: SrcSpan,
676 pkgTrustOnLoc :: SrcSpan,
677 warnSafeOnLoc :: SrcSpan,
678 warnUnsafeOnLoc :: SrcSpan,
679 -- Don't change this without updating extensionFlags:
680 extensions :: [OnOff ExtensionFlag],
681 -- extensionFlags should always be equal to
682 -- flattenExtensionFlags language extensions
683 extensionFlags :: IntSet,
684
685 -- Unfolding control
686 -- See Note [Discounts and thresholds] in CoreUnfold
687 ufCreationThreshold :: Int,
688 ufUseThreshold :: Int,
689 ufFunAppDiscount :: Int,
690 ufDictDiscount :: Int,
691 ufKeenessFactor :: Float,
692 ufDearOp :: Int,
693
694 maxWorkerArgs :: Int,
695
696 ghciHistSize :: Int,
697
698 -- | MsgDoc output action: use "ErrUtils" instead of this if you can
699 log_action :: LogAction,
700 flushOut :: FlushOut,
701 flushErr :: FlushErr,
702
703 haddockOptions :: Maybe String,
704 ghciScripts :: [String],
705
706 -- Output style options
707 pprUserLength :: Int,
708 pprCols :: Int,
709 traceLevel :: Int, -- Standard level is 1. Less verbose is 0.
710
711 -- | what kind of {-# SCC #-} to add automatically
712 profAuto :: ProfAuto,
713
714 interactivePrint :: Maybe String,
715
716 llvmVersion :: IORef Int,
717
718 nextWrapperNum :: IORef Int,
719
720 -- | Machine dependant flags (-m<blah> stuff)
721 sseVersion :: Maybe (Int, Int) -- (major, minor)
722 }
723
724 class HasDynFlags m where
725 getDynFlags :: m DynFlags
726
727 class ContainsDynFlags t where
728 extractDynFlags :: t -> DynFlags
729 replaceDynFlags :: t -> DynFlags -> t
730
731 data ProfAuto
732 = NoProfAuto -- ^ no SCC annotations added
733 | ProfAutoAll -- ^ top-level and nested functions are annotated
734 | ProfAutoTop -- ^ top-level functions annotated only
735 | ProfAutoExports -- ^ exported functions annotated only
736 | ProfAutoCalls -- ^ annotate call-sites
737 deriving (Enum)
738
739 data Settings = Settings {
740 sTargetPlatform :: Platform, -- Filled in by SysTools
741 sGhcUsagePath :: FilePath, -- Filled in by SysTools
742 sGhciUsagePath :: FilePath, -- ditto
743 sTopDir :: FilePath,
744 sTmpDir :: String, -- no trailing '/'
745 -- You shouldn't need to look things up in rawSettings directly.
746 -- They should have their own fields instead.
747 sRawSettings :: [(String, String)],
748 sExtraGccViaCFlags :: [String],
749 sSystemPackageConfig :: FilePath,
750 sLdSupportsCompactUnwind :: Bool,
751 sLdSupportsBuildId :: Bool,
752 sLdIsGnuLd :: Bool,
753 -- commands for particular phases
754 sPgm_L :: String,
755 sPgm_P :: (String,[Option]),
756 sPgm_F :: String,
757 sPgm_c :: (String,[Option]),
758 sPgm_s :: (String,[Option]),
759 sPgm_a :: (String,[Option]),
760 sPgm_l :: (String,[Option]),
761 sPgm_dll :: (String,[Option]),
762 sPgm_T :: String,
763 sPgm_sysman :: String,
764 sPgm_windres :: String,
765 sPgm_lo :: (String,[Option]), -- LLVM: opt llvm optimiser
766 sPgm_lc :: (String,[Option]), -- LLVM: llc static compiler
767 -- options for particular phases
768 sOpt_L :: [String],
769 sOpt_P :: [String],
770 sOpt_F :: [String],
771 sOpt_c :: [String],
772 sOpt_a :: [String],
773 sOpt_l :: [String],
774 sOpt_windres :: [String],
775 sOpt_lo :: [String], -- LLVM: llvm optimiser
776 sOpt_lc :: [String], -- LLVM: llc static compiler
777
778 sPlatformConstants :: PlatformConstants
779 }
780
781 targetPlatform :: DynFlags -> Platform
782 targetPlatform dflags = sTargetPlatform (settings dflags)
783
784 ghcUsagePath :: DynFlags -> FilePath
785 ghcUsagePath dflags = sGhcUsagePath (settings dflags)
786 ghciUsagePath :: DynFlags -> FilePath
787 ghciUsagePath dflags = sGhciUsagePath (settings dflags)
788 topDir :: DynFlags -> FilePath
789 topDir dflags = sTopDir (settings dflags)
790 tmpDir :: DynFlags -> String
791 tmpDir dflags = sTmpDir (settings dflags)
792 rawSettings :: DynFlags -> [(String, String)]
793 rawSettings dflags = sRawSettings (settings dflags)
794 extraGccViaCFlags :: DynFlags -> [String]
795 extraGccViaCFlags dflags = sExtraGccViaCFlags (settings dflags)
796 systemPackageConfig :: DynFlags -> FilePath
797 systemPackageConfig dflags = sSystemPackageConfig (settings dflags)
798 pgm_L :: DynFlags -> String
799 pgm_L dflags = sPgm_L (settings dflags)
800 pgm_P :: DynFlags -> (String,[Option])
801 pgm_P dflags = sPgm_P (settings dflags)
802 pgm_F :: DynFlags -> String
803 pgm_F dflags = sPgm_F (settings dflags)
804 pgm_c :: DynFlags -> (String,[Option])
805 pgm_c dflags = sPgm_c (settings dflags)
806 pgm_s :: DynFlags -> (String,[Option])
807 pgm_s dflags = sPgm_s (settings dflags)
808 pgm_a :: DynFlags -> (String,[Option])
809 pgm_a dflags = sPgm_a (settings dflags)
810 pgm_l :: DynFlags -> (String,[Option])
811 pgm_l dflags = sPgm_l (settings dflags)
812 pgm_dll :: DynFlags -> (String,[Option])
813 pgm_dll dflags = sPgm_dll (settings dflags)
814 pgm_T :: DynFlags -> String
815 pgm_T dflags = sPgm_T (settings dflags)
816 pgm_sysman :: DynFlags -> String
817 pgm_sysman dflags = sPgm_sysman (settings dflags)
818 pgm_windres :: DynFlags -> String
819 pgm_windres dflags = sPgm_windres (settings dflags)
820 pgm_lo :: DynFlags -> (String,[Option])
821 pgm_lo dflags = sPgm_lo (settings dflags)
822 pgm_lc :: DynFlags -> (String,[Option])
823 pgm_lc dflags = sPgm_lc (settings dflags)
824 opt_L :: DynFlags -> [String]
825 opt_L dflags = sOpt_L (settings dflags)
826 opt_P :: DynFlags -> [String]
827 opt_P dflags = concatMap (wayOptP (targetPlatform dflags)) (ways dflags)
828 ++ sOpt_P (settings dflags)
829 opt_F :: DynFlags -> [String]
830 opt_F dflags = sOpt_F (settings dflags)
831 opt_c :: DynFlags -> [String]
832 opt_c dflags = concatMap (wayOptc (targetPlatform dflags)) (ways dflags)
833 ++ sOpt_c (settings dflags)
834 opt_a :: DynFlags -> [String]
835 opt_a dflags = sOpt_a (settings dflags)
836 opt_l :: DynFlags -> [String]
837 opt_l dflags = concatMap (wayOptl (targetPlatform dflags)) (ways dflags)
838 ++ sOpt_l (settings dflags)
839 opt_windres :: DynFlags -> [String]
840 opt_windres dflags = sOpt_windres (settings dflags)
841 opt_lo :: DynFlags -> [String]
842 opt_lo dflags = sOpt_lo (settings dflags)
843 opt_lc :: DynFlags -> [String]
844 opt_lc dflags = sOpt_lc (settings dflags)
845
846 -- | The target code type of the compilation (if any).
847 --
848 -- Whenever you change the target, also make sure to set 'ghcLink' to
849 -- something sensible.
850 --
851 -- 'HscNothing' can be used to avoid generating any output, however, note
852 -- that:
853 --
854 -- * This will not run the desugaring step, thus no warnings generated in
855 -- this step will be output. In particular, this includes warnings related
856 -- to pattern matching. You can run the desugarer manually using
857 -- 'GHC.desugarModule'.
858 --
859 -- * If a program uses Template Haskell the typechecker may try to run code
860 -- from an imported module. This will fail if no code has been generated
861 -- for this module. You can use 'GHC.needsTemplateHaskell' to detect
862 -- whether this might be the case and choose to either switch to a
863 -- different target or avoid typechecking such modules. (The latter may be
864 -- preferable for security reasons.)
865 --
866 data HscTarget
867 = HscC -- ^ Generate C code.
868 | HscAsm -- ^ Generate assembly using the native code generator.
869 | HscLlvm -- ^ Generate assembly using the llvm code generator.
870 | HscInterpreted -- ^ Generate bytecode. (Requires 'LinkInMemory')
871 | HscNothing -- ^ Don't generate any code. See notes above.
872 deriving (Eq, Show)
873
874 -- | Will this target result in an object file on the disk?
875 isObjectTarget :: HscTarget -> Bool
876 isObjectTarget HscC = True
877 isObjectTarget HscAsm = True
878 isObjectTarget HscLlvm = True
879 isObjectTarget _ = False
880
881 -- | Does this target retain *all* top-level bindings for a module,
882 -- rather than just the exported bindings, in the TypeEnv and compiled
883 -- code (if any)? In interpreted mode we do this, so that GHCi can
884 -- call functions inside a module. In HscNothing mode we also do it,
885 -- so that Haddock can get access to the GlobalRdrEnv for a module
886 -- after typechecking it.
887 targetRetainsAllBindings :: HscTarget -> Bool
888 targetRetainsAllBindings HscInterpreted = True
889 targetRetainsAllBindings HscNothing = True
890 targetRetainsAllBindings _ = False
891
892 -- | The 'GhcMode' tells us whether we're doing multi-module
893 -- compilation (controlled via the "GHC" API) or one-shot
894 -- (single-module) compilation. This makes a difference primarily to
895 -- the "Finder": in one-shot mode we look for interface files for
896 -- imported modules, but in multi-module mode we look for source files
897 -- in order to check whether they need to be recompiled.
898 data GhcMode
899 = CompManager -- ^ @\-\-make@, GHCi, etc.
900 | OneShot -- ^ @ghc -c Foo.hs@
901 | MkDepend -- ^ @ghc -M@, see "Finder" for why we need this
902 deriving Eq
903
904 instance Outputable GhcMode where
905 ppr CompManager = ptext (sLit "CompManager")
906 ppr OneShot = ptext (sLit "OneShot")
907 ppr MkDepend = ptext (sLit "MkDepend")
908
909 isOneShot :: GhcMode -> Bool
910 isOneShot OneShot = True
911 isOneShot _other = False
912
913 -- | What to do in the link step, if there is one.
914 data GhcLink
915 = NoLink -- ^ Don't link at all
916 | LinkBinary -- ^ Link object code into a binary
917 | LinkInMemory -- ^ Use the in-memory dynamic linker (works for both
918 -- bytecode and object code).
919 | LinkDynLib -- ^ Link objects into a dynamic lib (DLL on Windows, DSO on ELF platforms)
920 deriving (Eq, Show)
921
922 isNoLink :: GhcLink -> Bool
923 isNoLink NoLink = True
924 isNoLink _ = False
925
926 data PackageFlag
927 = ExposePackage String
928 | ExposePackageId String
929 | HidePackage String
930 | IgnorePackage String
931 | TrustPackage String
932 | DistrustPackage String
933 deriving (Eq, Show)
934
935 defaultHscTarget :: Platform -> HscTarget
936 defaultHscTarget = defaultObjectTarget
937
938 -- | The 'HscTarget' value corresponding to the default way to create
939 -- object files on the current platform.
940 defaultObjectTarget :: Platform -> HscTarget
941 defaultObjectTarget platform
942 | platformUnregisterised platform = HscC
943 | cGhcWithNativeCodeGen == "YES" = HscAsm
944 | otherwise = HscLlvm
945
946 tablesNextToCode :: DynFlags -> Bool
947 tablesNextToCode dflags
948 = mkTablesNextToCode (platformUnregisterised (targetPlatform dflags))
949
950 -- Determines whether we will be compiling
951 -- info tables that reside just before the entry code, or with an
952 -- indirection to the entry code. See TABLES_NEXT_TO_CODE in
953 -- includes/rts/storage/InfoTables.h.
954 mkTablesNextToCode :: Bool -> Bool
955 mkTablesNextToCode unregisterised
956 = not unregisterised && cGhcEnableTablesNextToCode == "YES"
957
958 data DynLibLoader
959 = Deployable
960 | SystemDependent
961 deriving Eq
962
963 data RtsOptsEnabled = RtsOptsNone | RtsOptsSafeOnly | RtsOptsAll
964 deriving (Show)
965
966 -----------------------------------------------------------------------------
967 -- Ways
968
969 -- The central concept of a "way" is that all objects in a given
970 -- program must be compiled in the same "way". Certain options change
971 -- parameters of the virtual machine, eg. profiling adds an extra word
972 -- to the object header, so profiling objects cannot be linked with
973 -- non-profiling objects.
974
975 -- After parsing the command-line options, we determine which "way" we
976 -- are building - this might be a combination way, eg. profiling+threaded.
977
978 -- We then find the "build-tag" associated with this way, and this
979 -- becomes the suffix used to find .hi files and libraries used in
980 -- this compilation.
981
982 data Way
983 = WayThreaded
984 | WayDebug
985 | WayProf
986 | WayEventLog
987 | WayPar
988 | WayGran
989 | WayNDP
990 | WayDyn
991 deriving (Eq, Ord, Show)
992
993 allowed_combination :: [Way] -> Bool
994 allowed_combination way = and [ x `allowedWith` y
995 | x <- way, y <- way, x < y ]
996 where
997 -- Note ordering in these tests: the left argument is
998 -- <= the right argument, according to the Ord instance
999 -- on Way above.
1000
1001 -- dyn is allowed with everything
1002 _ `allowedWith` WayDyn = True
1003 WayDyn `allowedWith` _ = True
1004
1005 -- debug is allowed with everything
1006 _ `allowedWith` WayDebug = True
1007 WayDebug `allowedWith` _ = True
1008
1009 WayProf `allowedWith` WayNDP = True
1010 WayThreaded `allowedWith` WayProf = True
1011 WayThreaded `allowedWith` WayEventLog = True
1012 _ `allowedWith` _ = False
1013
1014 mkBuildTag :: [Way] -> String
1015 mkBuildTag ways = concat (intersperse "_" (map wayTag ways))
1016
1017 wayTag :: Way -> String
1018 wayTag WayThreaded = "thr"
1019 wayTag WayDebug = "debug"
1020 wayTag WayDyn = "dyn"
1021 wayTag WayProf = "p"
1022 wayTag WayEventLog = "l"
1023 wayTag WayPar = "mp"
1024 wayTag WayGran = "mg"
1025 wayTag WayNDP = "ndp"
1026
1027 wayRTSOnly :: Way -> Bool
1028 wayRTSOnly WayThreaded = True
1029 wayRTSOnly WayDebug = True
1030 wayRTSOnly WayDyn = False
1031 wayRTSOnly WayProf = False
1032 wayRTSOnly WayEventLog = True
1033 wayRTSOnly WayPar = False
1034 wayRTSOnly WayGran = False
1035 wayRTSOnly WayNDP = False
1036
1037 wayDesc :: Way -> String
1038 wayDesc WayThreaded = "Threaded"
1039 wayDesc WayDebug = "Debug"
1040 wayDesc WayDyn = "Dynamic"
1041 wayDesc WayProf = "Profiling"
1042 wayDesc WayEventLog = "RTS Event Logging"
1043 wayDesc WayPar = "Parallel"
1044 wayDesc WayGran = "GranSim"
1045 wayDesc WayNDP = "Nested data parallelism"
1046
1047 wayGeneralFlags :: Platform -> Way -> [GeneralFlag]
1048 wayGeneralFlags _ WayThreaded = []
1049 wayGeneralFlags _ WayDebug = []
1050 wayGeneralFlags platform WayDyn =
1051 case platformOS platform of
1052 -- On Windows, code that is to be linked into a dynamic
1053 -- library must be compiled with -fPIC. Labels not in
1054 -- the current package are assumed to be in a DLL
1055 -- different from the current one.
1056 OSMinGW32 -> [Opt_PIC]
1057 OSDarwin -> [Opt_PIC]
1058 OSLinux -> [Opt_PIC] -- This needs to be here for GHCi to work:
1059 -- GHCi links objects into a .so before
1060 -- loading the .so using the system linker.
1061 -- Only PIC objects can be linked into a .so.
1062 _ -> []
1063 wayGeneralFlags _ WayProf = [Opt_SccProfilingOn]
1064 wayGeneralFlags _ WayEventLog = []
1065 wayGeneralFlags _ WayPar = [Opt_Parallel]
1066 wayGeneralFlags _ WayGran = [Opt_GranMacros]
1067 wayGeneralFlags _ WayNDP = []
1068
1069 wayExtras :: Platform -> Way -> DynFlags -> DynFlags
1070 wayExtras _ WayThreaded dflags = dflags
1071 wayExtras _ WayDebug dflags = dflags
1072 wayExtras _ WayDyn dflags = dflags
1073 wayExtras _ WayProf dflags = dflags
1074 wayExtras _ WayEventLog dflags = dflags
1075 wayExtras _ WayPar dflags = exposePackage' "concurrent" dflags
1076 wayExtras _ WayGran dflags = exposePackage' "concurrent" dflags
1077 wayExtras _ WayNDP dflags = setExtensionFlag' Opt_ParallelArrays
1078 $ setGeneralFlag' Opt_Vectorise dflags
1079
1080 wayOptc :: Platform -> Way -> [String]
1081 wayOptc platform WayThreaded = case platformOS platform of
1082 OSOpenBSD -> ["-pthread"]
1083 OSNetBSD -> ["-pthread"]
1084 _ -> []
1085 wayOptc _ WayDebug = []
1086 wayOptc _ WayDyn = []
1087 wayOptc _ WayProf = ["-DPROFILING"]
1088 wayOptc _ WayEventLog = ["-DTRACING"]
1089 wayOptc _ WayPar = ["-DPAR", "-w"]
1090 wayOptc _ WayGran = ["-DGRAN"]
1091 wayOptc _ WayNDP = []
1092
1093 wayOptl :: Platform -> Way -> [String]
1094 wayOptl platform WayThreaded =
1095 case platformOS platform of
1096 -- FreeBSD's default threading library is the KSE-based M:N libpthread,
1097 -- which GHC has some problems with. It's currently not clear whether
1098 -- the problems are our fault or theirs, but it seems that using the
1099 -- alternative 1:1 threading library libthr works around it:
1100 OSFreeBSD -> ["-lthr"]
1101 OSSolaris2 -> ["-lrt"]
1102 OSOpenBSD -> ["-pthread"]
1103 OSNetBSD -> ["-pthread"]
1104 _ -> []
1105 wayOptl _ WayDebug = []
1106 wayOptl platform WayDyn =
1107 case platformOS platform of
1108 OSOpenBSD -> -- Without this, linking the shared libHSffi fails
1109 -- because it uses pthread mutexes.
1110 ["-optl-pthread"]
1111 OSNetBSD -> -- Without this, linking the shared libHSffi fails
1112 -- because it uses pthread mutexes.
1113 ["-optl-pthread"]
1114 _ -> []
1115 wayOptl _ WayProf = []
1116 wayOptl _ WayEventLog = []
1117 wayOptl _ WayPar = ["-L${PVM_ROOT}/lib/${PVM_ARCH}",
1118 "-lpvm3",
1119 "-lgpvm3"]
1120 wayOptl _ WayGran = []
1121 wayOptl _ WayNDP = []
1122
1123 wayOptP :: Platform -> Way -> [String]
1124 wayOptP _ WayThreaded = []
1125 wayOptP _ WayDebug = []
1126 wayOptP _ WayDyn = []
1127 wayOptP _ WayProf = ["-DPROFILING"]
1128 wayOptP _ WayEventLog = ["-DTRACING"]
1129 wayOptP _ WayPar = ["-D__PARALLEL_HASKELL__"]
1130 wayOptP _ WayGran = ["-D__GRANSIM__"]
1131 wayOptP _ WayNDP = []
1132
1133 whenGeneratingDynamicToo :: MonadIO m => DynFlags -> m () -> m ()
1134 whenGeneratingDynamicToo dflags f = ifGeneratingDynamicToo dflags f (return ())
1135
1136 ifGeneratingDynamicToo :: MonadIO m => DynFlags -> m a -> m a -> m a
1137 ifGeneratingDynamicToo dflags f g = generateDynamicTooConditional dflags f g g
1138
1139 whenCannotGenerateDynamicToo :: MonadIO m => DynFlags -> m () -> m ()
1140 whenCannotGenerateDynamicToo dflags f
1141 = ifCannotGenerateDynamicToo dflags f (return ())
1142
1143 ifCannotGenerateDynamicToo :: MonadIO m => DynFlags -> m a -> m a -> m a
1144 ifCannotGenerateDynamicToo dflags f g
1145 = generateDynamicTooConditional dflags g f g
1146
1147 generateDynamicTooConditional :: MonadIO m
1148 => DynFlags -> m a -> m a -> m a -> m a
1149 generateDynamicTooConditional dflags canGen cannotGen notTryingToGen
1150 = if gopt Opt_BuildDynamicToo dflags
1151 then do let ref = canGenerateDynamicToo dflags
1152 b <- liftIO $ readIORef ref
1153 if b then canGen else cannotGen
1154 else notTryingToGen
1155
1156 doDynamicToo :: DynFlags -> DynFlags
1157 doDynamicToo dflags0 = let dflags1 = unSetGeneralFlag' Opt_Static dflags0
1158 dflags2 = addWay' WayDyn dflags1
1159 dflags3 = dflags2 {
1160 outputFile = dynOutputFile dflags2,
1161 hiSuf = dynHiSuf dflags2,
1162 objectSuf = dynObjectSuf dflags2
1163 }
1164 dflags4 = updateWays dflags3
1165 in dflags4
1166
1167 -----------------------------------------------------------------------------
1168
1169 -- | Used by 'GHC.newSession' to partially initialize a new 'DynFlags' value
1170 initDynFlags :: DynFlags -> IO DynFlags
1171 initDynFlags dflags = do
1172 refCanGenerateDynamicToo <- newIORef True
1173 refFilesToClean <- newIORef []
1174 refDirsToClean <- newIORef Map.empty
1175 refFilesToNotIntermediateClean <- newIORef []
1176 refGeneratedDumps <- newIORef Set.empty
1177 refLlvmVersion <- newIORef 28
1178 wrapperNum <- newIORef 0
1179 return dflags{
1180 canGenerateDynamicToo = refCanGenerateDynamicToo,
1181 filesToClean = refFilesToClean,
1182 dirsToClean = refDirsToClean,
1183 filesToNotIntermediateClean = refFilesToNotIntermediateClean,
1184 generatedDumps = refGeneratedDumps,
1185 llvmVersion = refLlvmVersion,
1186 nextWrapperNum = wrapperNum
1187 }
1188
1189 -- | The normal 'DynFlags'. Note that they is not suitable for use in this form
1190 -- and must be fully initialized by 'GHC.newSession' first.
1191 defaultDynFlags :: Settings -> DynFlags
1192 defaultDynFlags mySettings =
1193 DynFlags {
1194 ghcMode = CompManager,
1195 ghcLink = LinkBinary,
1196 hscTarget = defaultHscTarget (sTargetPlatform mySettings),
1197 hscOutName = "",
1198 extCoreName = "",
1199 verbosity = 0,
1200 optLevel = 0,
1201 simplPhases = 2,
1202 maxSimplIterations = 4,
1203 shouldDumpSimplPhase = Nothing,
1204 ruleCheck = Nothing,
1205 simplTickFactor = 100,
1206 specConstrThreshold = Just 2000,
1207 specConstrCount = Just 3,
1208 liberateCaseThreshold = Just 2000,
1209 floatLamArgs = Just 0, -- Default: float only if no fvs
1210 historySize = 20,
1211 strictnessBefore = [],
1212
1213 cmdlineHcIncludes = [],
1214 importPaths = ["."],
1215 mainModIs = mAIN,
1216 mainFunIs = Nothing,
1217 ctxtStkDepth = mAX_CONTEXT_REDUCTION_DEPTH,
1218
1219 thisPackage = mainPackageId,
1220
1221 objectDir = Nothing,
1222 dylibInstallName = Nothing,
1223 hiDir = Nothing,
1224 stubDir = Nothing,
1225 dumpDir = Nothing,
1226
1227 objectSuf = phaseInputExt StopLn,
1228 hcSuf = phaseInputExt HCc,
1229 hiSuf = "hi",
1230
1231 canGenerateDynamicToo = panic "defaultDynFlags: No canGenerateDynamicToo",
1232 dynObjectSuf = "dyn_" ++ phaseInputExt StopLn,
1233 dynHiSuf = "dyn_hi",
1234
1235 pluginModNames = [],
1236 pluginModNameOpts = [],
1237
1238 outputFile = Nothing,
1239 dynOutputFile = Nothing,
1240 outputHi = Nothing,
1241 dynLibLoader = SystemDependent,
1242 dumpPrefix = Nothing,
1243 dumpPrefixForce = Nothing,
1244 ldInputs = [],
1245 includePaths = [],
1246 libraryPaths = [],
1247 frameworkPaths = [],
1248 cmdlineFrameworks = [],
1249 rtsOpts = Nothing,
1250 rtsOptsEnabled = RtsOptsSafeOnly,
1251
1252 hpcDir = ".hpc",
1253
1254 extraPkgConfs = id,
1255 packageFlags = [],
1256 pkgDatabase = Nothing,
1257 pkgState = panic "no package state yet: call GHC.setSessionDynFlags",
1258 ways = defaultWays mySettings,
1259 buildTag = mkBuildTag (defaultWays mySettings),
1260 rtsBuildTag = mkBuildTag (defaultWays mySettings),
1261 splitInfo = Nothing,
1262 settings = mySettings,
1263 -- ghc -M values
1264 depMakefile = "Makefile",
1265 depIncludePkgDeps = False,
1266 depExcludeMods = [],
1267 depSuffixes = [],
1268 -- end of ghc -M values
1269 filesToClean = panic "defaultDynFlags: No filesToClean",
1270 dirsToClean = panic "defaultDynFlags: No dirsToClean",
1271 filesToNotIntermediateClean = panic "defaultDynFlags: No filesToNotIntermediateClean",
1272 generatedDumps = panic "defaultDynFlags: No generatedDumps",
1273 haddockOptions = Nothing,
1274 dumpFlags = IntSet.empty,
1275 generalFlags = IntSet.fromList (map fromEnum (defaultFlags mySettings)),
1276 warningFlags = IntSet.fromList (map fromEnum standardWarnings),
1277 ghciScripts = [],
1278 language = Nothing,
1279 safeHaskell = Sf_SafeInferred,
1280 thOnLoc = noSrcSpan,
1281 newDerivOnLoc = noSrcSpan,
1282 pkgTrustOnLoc = noSrcSpan,
1283 warnSafeOnLoc = noSrcSpan,
1284 warnUnsafeOnLoc = noSrcSpan,
1285 extensions = [],
1286 extensionFlags = flattenExtensionFlags Nothing [],
1287
1288 -- The ufCreationThreshold threshold must be reasonably high to
1289 -- take account of possible discounts.
1290 -- E.g. 450 is not enough in 'fulsom' for Interval.sqr to inline
1291 -- into Csg.calc (The unfolding for sqr never makes it into the
1292 -- interface file.)
1293 ufCreationThreshold = 750,
1294 ufUseThreshold = 60,
1295 ufFunAppDiscount = 60,
1296 -- Be fairly keen to inline a fuction if that means
1297 -- we'll be able to pick the right method from a dictionary
1298 ufDictDiscount = 30,
1299 ufKeenessFactor = 1.5,
1300 ufDearOp = 40,
1301
1302 maxWorkerArgs = 10,
1303
1304 ghciHistSize = 50, -- keep a log of length 50 by default
1305
1306 log_action = defaultLogAction,
1307 flushOut = defaultFlushOut,
1308 flushErr = defaultFlushErr,
1309 pprUserLength = 5,
1310 pprCols = 100,
1311 traceLevel = 1,
1312 profAuto = NoProfAuto,
1313 llvmVersion = panic "defaultDynFlags: No llvmVersion",
1314 interactivePrint = Nothing,
1315 nextWrapperNum = panic "defaultDynFlags: No nextWrapperNum",
1316 sseVersion = Nothing
1317 }
1318
1319 defaultWays :: Settings -> [Way]
1320 defaultWays settings = if pc_DYNAMIC_BY_DEFAULT (sPlatformConstants settings)
1321 then [WayDyn]
1322 else []
1323
1324 --------------------------------------------------------------------------
1325
1326 type FatalMessager = String -> IO ()
1327 type LogAction = DynFlags -> Severity -> SrcSpan -> PprStyle -> MsgDoc -> IO ()
1328
1329 defaultFatalMessager :: FatalMessager
1330 defaultFatalMessager = hPutStrLn stderr
1331
1332 defaultLogAction :: LogAction
1333 defaultLogAction dflags severity srcSpan style msg
1334 = case severity of
1335 SevOutput -> printSDoc msg style
1336 SevDump -> printSDoc (msg $$ blankLine) style
1337 SevInfo -> printErrs msg style
1338 SevFatal -> printErrs msg style
1339 _ -> do hPutChar stderr '\n'
1340 printErrs (mkLocMessage severity srcSpan msg) style
1341 -- careful (#2302): printErrs prints in UTF-8, whereas
1342 -- converting to string first and using hPutStr would
1343 -- just emit the low 8 bits of each unicode char.
1344 where printSDoc = defaultLogActionHPrintDoc dflags stdout
1345 printErrs = defaultLogActionHPrintDoc dflags stderr
1346
1347 defaultLogActionHPrintDoc :: DynFlags -> Handle -> SDoc -> PprStyle -> IO ()
1348 defaultLogActionHPrintDoc dflags h d sty
1349 = do let doc = runSDoc d (initSDocContext dflags sty)
1350 Pretty.printDoc Pretty.PageMode (pprCols dflags) h doc
1351 hFlush h
1352
1353 newtype FlushOut = FlushOut (IO ())
1354
1355 defaultFlushOut :: FlushOut
1356 defaultFlushOut = FlushOut $ hFlush stdout
1357
1358 newtype FlushErr = FlushErr (IO ())
1359
1360 defaultFlushErr :: FlushErr
1361 defaultFlushErr = FlushErr $ hFlush stderr
1362
1363 printOutputForUser :: DynFlags -> PrintUnqualified -> SDoc -> IO ()
1364 printOutputForUser = printSevForUser SevOutput
1365
1366 printInfoForUser :: DynFlags -> PrintUnqualified -> SDoc -> IO ()
1367 printInfoForUser = printSevForUser SevInfo
1368
1369 printSevForUser :: Severity -> DynFlags -> PrintUnqualified -> SDoc -> IO ()
1370 printSevForUser sev dflags unqual doc
1371 = log_action dflags dflags sev noSrcSpan (mkUserStyle unqual AllTheWay) doc
1372
1373 {-
1374 Note [Verbosity levels]
1375 ~~~~~~~~~~~~~~~~~~~~~~~
1376 0 | print errors & warnings only
1377 1 | minimal verbosity: print "compiling M ... done." for each module.
1378 2 | equivalent to -dshow-passes
1379 3 | equivalent to existing "ghc -v"
1380 4 | "ghc -v -ddump-most"
1381 5 | "ghc -v -ddump-all"
1382 -}
1383
1384 data OnOff a = On a
1385 | Off a
1386
1387 -- OnOffs accumulate in reverse order, so we use foldr in order to
1388 -- process them in the right order
1389 flattenExtensionFlags :: Maybe Language -> [OnOff ExtensionFlag] -> IntSet
1390 flattenExtensionFlags ml = foldr f defaultExtensionFlags
1391 where f (On f) flags = IntSet.insert (fromEnum f) flags
1392 f (Off f) flags = IntSet.delete (fromEnum f) flags
1393 defaultExtensionFlags = IntSet.fromList (map fromEnum (languageExtensions ml))
1394
1395 languageExtensions :: Maybe Language -> [ExtensionFlag]
1396
1397 languageExtensions Nothing
1398 -- Nothing => the default case
1399 = Opt_NondecreasingIndentation -- This has been on by default for some time
1400 : delete Opt_DatatypeContexts -- The Haskell' committee decided to
1401 -- remove datatype contexts from the
1402 -- language:
1403 -- http://www.haskell.org/pipermail/haskell-prime/2011-January/003335.html
1404 (languageExtensions (Just Haskell2010))
1405
1406 -- NB: MonoPatBinds is no longer the default
1407
1408 languageExtensions (Just Haskell98)
1409 = [Opt_ImplicitPrelude,
1410 Opt_MonomorphismRestriction,
1411 Opt_NPlusKPatterns,
1412 Opt_DatatypeContexts,
1413 Opt_TraditionalRecordSyntax,
1414 Opt_NondecreasingIndentation
1415 -- strictly speaking non-standard, but we always had this
1416 -- on implicitly before the option was added in 7.1, and
1417 -- turning it off breaks code, so we're keeping it on for
1418 -- backwards compatibility. Cabal uses -XHaskell98 by
1419 -- default unless you specify another language.
1420 ]
1421
1422 languageExtensions (Just Haskell2010)
1423 = [Opt_ImplicitPrelude,
1424 Opt_MonomorphismRestriction,
1425 Opt_DatatypeContexts,
1426 Opt_TraditionalRecordSyntax,
1427 Opt_EmptyDataDecls,
1428 Opt_ForeignFunctionInterface,
1429 Opt_PatternGuards,
1430 Opt_DoAndIfThenElse,
1431 Opt_RelaxedPolyRec]
1432
1433 -- | Test whether a 'DumpFlag' is set
1434 dopt :: DumpFlag -> DynFlags -> Bool
1435 dopt f dflags = (fromEnum f `IntSet.member` dumpFlags dflags)
1436 || (verbosity dflags >= 4 && enableIfVerbose f)
1437 where enableIfVerbose Opt_D_dump_tc_trace = False
1438 enableIfVerbose Opt_D_dump_rn_trace = False
1439 enableIfVerbose Opt_D_dump_cs_trace = False
1440 enableIfVerbose Opt_D_dump_if_trace = False
1441 enableIfVerbose Opt_D_dump_vt_trace = False
1442 enableIfVerbose Opt_D_dump_tc = False
1443 enableIfVerbose Opt_D_dump_rn = False
1444 enableIfVerbose Opt_D_dump_rn_stats = False
1445 enableIfVerbose Opt_D_dump_hi_diffs = False
1446 enableIfVerbose Opt_D_verbose_core2core = False
1447 enableIfVerbose Opt_D_verbose_stg2stg = False
1448 enableIfVerbose Opt_D_dump_splices = False
1449 enableIfVerbose Opt_D_dump_rule_firings = False
1450 enableIfVerbose Opt_D_dump_rule_rewrites = False
1451 enableIfVerbose Opt_D_dump_simpl_trace = False
1452 enableIfVerbose Opt_D_dump_rtti = False
1453 enableIfVerbose Opt_D_dump_inlinings = False
1454 enableIfVerbose Opt_D_dump_core_stats = False
1455 enableIfVerbose Opt_D_dump_asm_stats = False
1456 enableIfVerbose Opt_D_dump_types = False
1457 enableIfVerbose Opt_D_dump_simpl_iterations = False
1458 enableIfVerbose Opt_D_dump_ticked = False
1459 enableIfVerbose Opt_D_dump_view_pattern_commoning = False
1460 enableIfVerbose Opt_D_dump_mod_cycles = False
1461 enableIfVerbose _ = True
1462
1463 -- | Set a 'DumpFlag'
1464 dopt_set :: DynFlags -> DumpFlag -> DynFlags
1465 dopt_set dfs f = dfs{ dumpFlags = IntSet.insert (fromEnum f) (dumpFlags dfs) }
1466
1467 -- | Test whether a 'GeneralFlag' is set
1468 gopt :: GeneralFlag -> DynFlags -> Bool
1469 gopt f dflags = fromEnum f `IntSet.member` generalFlags dflags
1470
1471 -- | Set a 'GeneralFlag'
1472 gopt_set :: DynFlags -> GeneralFlag -> DynFlags
1473 gopt_set dfs f = dfs{ generalFlags = IntSet.insert (fromEnum f) (generalFlags dfs) }
1474
1475 -- | Unset a 'GeneralFlag'
1476 gopt_unset :: DynFlags -> GeneralFlag -> DynFlags
1477 gopt_unset dfs f = dfs{ generalFlags = IntSet.delete (fromEnum f) (generalFlags dfs) }
1478
1479 -- | Test whether a 'WarningFlag' is set
1480 wopt :: WarningFlag -> DynFlags -> Bool
1481 wopt f dflags = fromEnum f `IntSet.member` warningFlags dflags
1482
1483 -- | Set a 'WarningFlag'
1484 wopt_set :: DynFlags -> WarningFlag -> DynFlags
1485 wopt_set dfs f = dfs{ warningFlags = IntSet.insert (fromEnum f) (warningFlags dfs) }
1486
1487 -- | Unset a 'WarningFlag'
1488 wopt_unset :: DynFlags -> WarningFlag -> DynFlags
1489 wopt_unset dfs f = dfs{ warningFlags = IntSet.delete (fromEnum f) (warningFlags dfs) }
1490
1491 -- | Test whether a 'ExtensionFlag' is set
1492 xopt :: ExtensionFlag -> DynFlags -> Bool
1493 xopt f dflags = fromEnum f `IntSet.member` extensionFlags dflags
1494
1495 -- | Set a 'ExtensionFlag'
1496 xopt_set :: DynFlags -> ExtensionFlag -> DynFlags
1497 xopt_set dfs f
1498 = let onoffs = On f : extensions dfs
1499 in dfs { extensions = onoffs,
1500 extensionFlags = flattenExtensionFlags (language dfs) onoffs }
1501
1502 -- | Unset a 'ExtensionFlag'
1503 xopt_unset :: DynFlags -> ExtensionFlag -> DynFlags
1504 xopt_unset dfs f
1505 = let onoffs = Off f : extensions dfs
1506 in dfs { extensions = onoffs,
1507 extensionFlags = flattenExtensionFlags (language dfs) onoffs }
1508
1509 lang_set :: DynFlags -> Maybe Language -> DynFlags
1510 lang_set dflags lang =
1511 dflags {
1512 language = lang,
1513 extensionFlags = flattenExtensionFlags lang (extensions dflags)
1514 }
1515
1516 -- | Set the Haskell language standard to use
1517 setLanguage :: Language -> DynP ()
1518 setLanguage l = upd (`lang_set` Just l)
1519
1520 -- | Some modules have dependencies on others through the DynFlags rather than textual imports
1521 dynFlagDependencies :: DynFlags -> [ModuleName]
1522 dynFlagDependencies = pluginModNames
1523
1524 -- | Is the -fpackage-trust mode on
1525 packageTrustOn :: DynFlags -> Bool
1526 packageTrustOn = gopt Opt_PackageTrust
1527
1528 -- | Is Safe Haskell on in some way (including inference mode)
1529 safeHaskellOn :: DynFlags -> Bool
1530 safeHaskellOn dflags = safeHaskell dflags /= Sf_None
1531
1532 -- | Is the Safe Haskell safe language in use
1533 safeLanguageOn :: DynFlags -> Bool
1534 safeLanguageOn dflags = safeHaskell dflags == Sf_Safe
1535
1536 -- | Is the Safe Haskell safe inference mode active
1537 safeInferOn :: DynFlags -> Bool
1538 safeInferOn dflags = safeHaskell dflags == Sf_SafeInferred
1539
1540 -- | Test if Safe Imports are on in some form
1541 safeImportsOn :: DynFlags -> Bool
1542 safeImportsOn dflags = safeHaskell dflags == Sf_Unsafe ||
1543 safeHaskell dflags == Sf_Trustworthy ||
1544 safeHaskell dflags == Sf_Safe
1545
1546 -- | Set a 'Safe Haskell' flag
1547 setSafeHaskell :: SafeHaskellMode -> DynP ()
1548 setSafeHaskell s = updM f
1549 where f dfs = do
1550 let sf = safeHaskell dfs
1551 safeM <- combineSafeFlags sf s
1552 return $ dfs { safeHaskell = safeM }
1553
1554 -- | Are all direct imports required to be safe for this Safe Haskell mode?
1555 -- Direct imports are when the code explicitly imports a module
1556 safeDirectImpsReq :: DynFlags -> Bool
1557 safeDirectImpsReq d = safeLanguageOn d
1558
1559 -- | Are all implicit imports required to be safe for this Safe Haskell mode?
1560 -- Implicit imports are things in the prelude. e.g System.IO when print is used.
1561 safeImplicitImpsReq :: DynFlags -> Bool
1562 safeImplicitImpsReq d = safeLanguageOn d
1563
1564 -- | Combine two Safe Haskell modes correctly. Used for dealing with multiple flags.
1565 -- This makes Safe Haskell very much a monoid but for now I prefer this as I don't
1566 -- want to export this functionality from the module but do want to export the
1567 -- type constructors.
1568 combineSafeFlags :: SafeHaskellMode -> SafeHaskellMode -> DynP SafeHaskellMode
1569 combineSafeFlags a b | a == Sf_SafeInferred = return b
1570 | b == Sf_SafeInferred = return a
1571 | a == Sf_None = return b
1572 | b == Sf_None = return a
1573 | a == b = return a
1574 | otherwise = addErr errm >> return (panic errm)
1575 where errm = "Incompatible Safe Haskell flags! ("
1576 ++ show a ++ ", " ++ show b ++ ")"
1577
1578 -- | A list of unsafe flags under Safe Haskell. Tuple elements are:
1579 -- * name of the flag
1580 -- * function to get srcspan that enabled the flag
1581 -- * function to test if the flag is on
1582 -- * function to turn the flag off
1583 unsafeFlags :: [(String, DynFlags -> SrcSpan, DynFlags -> Bool, DynFlags -> DynFlags)]
1584 unsafeFlags = [("-XGeneralizedNewtypeDeriving", newDerivOnLoc,
1585 xopt Opt_GeneralizedNewtypeDeriving,
1586 flip xopt_unset Opt_GeneralizedNewtypeDeriving),
1587 ("-XTemplateHaskell", thOnLoc,
1588 xopt Opt_TemplateHaskell,
1589 flip xopt_unset Opt_TemplateHaskell)]
1590
1591 -- | Retrieve the options corresponding to a particular @opt_*@ field in the correct order
1592 getOpts :: DynFlags -- ^ 'DynFlags' to retrieve the options from
1593 -> (DynFlags -> [a]) -- ^ Relevant record accessor: one of the @opt_*@ accessors
1594 -> [a] -- ^ Correctly ordered extracted options
1595 getOpts dflags opts = reverse (opts dflags)
1596 -- We add to the options from the front, so we need to reverse the list
1597
1598 -- | Gets the verbosity flag for the current verbosity level. This is fed to
1599 -- other tools, so GHC-specific verbosity flags like @-ddump-most@ are not included
1600 getVerbFlags :: DynFlags -> [String]
1601 getVerbFlags dflags
1602 | verbosity dflags >= 4 = ["-v"]
1603 | otherwise = []
1604
1605 setObjectDir, setHiDir, setStubDir, setDumpDir, setOutputDir,
1606 setDynObjectSuf, setDynHiSuf,
1607 setDylibInstallName,
1608 setObjectSuf, setHiSuf, setHcSuf, parseDynLibLoaderMode,
1609 setPgmP, addOptl, addOptc, addOptP,
1610 addCmdlineFramework, addHaddockOpts, addGhciScript,
1611 setInteractivePrint
1612 :: String -> DynFlags -> DynFlags
1613 setOutputFile, setDynOutputFile, setOutputHi, setDumpPrefixForce
1614 :: Maybe String -> DynFlags -> DynFlags
1615
1616 setObjectDir f d = d{ objectDir = Just f}
1617 setHiDir f d = d{ hiDir = Just f}
1618 setStubDir f d = d{ stubDir = Just f, includePaths = f : includePaths d }
1619 -- -stubdir D adds an implicit -I D, so that gcc can find the _stub.h file
1620 -- \#included from the .hc file when compiling via C (i.e. unregisterised
1621 -- builds).
1622 setDumpDir f d = d{ dumpDir = Just f}
1623 setOutputDir f = setObjectDir f . setHiDir f . setStubDir f . setDumpDir f
1624 setDylibInstallName f d = d{ dylibInstallName = Just f}
1625
1626 setObjectSuf f d = d{ objectSuf = f}
1627 setDynObjectSuf f d = d{ dynObjectSuf = f}
1628 setHiSuf f d = d{ hiSuf = f}
1629 setDynHiSuf f d = d{ dynHiSuf = f}
1630 setHcSuf f d = d{ hcSuf = f}
1631
1632 setOutputFile f d = d{ outputFile = f}
1633 setDynOutputFile f d = d{ dynOutputFile = f}
1634 setOutputHi f d = d{ outputHi = f}
1635
1636 addPluginModuleName :: String -> DynFlags -> DynFlags
1637 addPluginModuleName name d = d { pluginModNames = (mkModuleName name) : (pluginModNames d) }
1638
1639 addPluginModuleNameOption :: String -> DynFlags -> DynFlags
1640 addPluginModuleNameOption optflag d = d { pluginModNameOpts = (mkModuleName m, option) : (pluginModNameOpts d) }
1641 where (m, rest) = break (== ':') optflag
1642 option = case rest of
1643 [] -> "" -- should probably signal an error
1644 (_:plug_opt) -> plug_opt -- ignore the ':' from break
1645
1646 parseDynLibLoaderMode f d =
1647 case splitAt 8 f of
1648 ("deploy", "") -> d{ dynLibLoader = Deployable }
1649 ("sysdep", "") -> d{ dynLibLoader = SystemDependent }
1650 _ -> throwGhcException (CmdLineError ("Unknown dynlib loader: " ++ f))
1651
1652 setDumpPrefixForce f d = d { dumpPrefixForce = f}
1653
1654 -- XXX HACK: Prelude> words "'does not' work" ===> ["'does","not'","work"]
1655 -- Config.hs should really use Option.
1656 setPgmP f = let (pgm:args) = words f in alterSettings (\s -> s { sPgm_P = (pgm, map Option args)})
1657 addOptl f = alterSettings (\s -> s { sOpt_l = f : sOpt_l s})
1658 addOptc f = alterSettings (\s -> s { sOpt_c = f : sOpt_c s})
1659 addOptP f = alterSettings (\s -> s { sOpt_P = f : sOpt_P s})
1660
1661
1662 setDepMakefile :: FilePath -> DynFlags -> DynFlags
1663 setDepMakefile f d = d { depMakefile = deOptDep f }
1664
1665 setDepIncludePkgDeps :: Bool -> DynFlags -> DynFlags
1666 setDepIncludePkgDeps b d = d { depIncludePkgDeps = b }
1667
1668 addDepExcludeMod :: String -> DynFlags -> DynFlags
1669 addDepExcludeMod m d
1670 = d { depExcludeMods = mkModuleName (deOptDep m) : depExcludeMods d }
1671
1672 addDepSuffix :: FilePath -> DynFlags -> DynFlags
1673 addDepSuffix s d = d { depSuffixes = deOptDep s : depSuffixes d }
1674
1675 -- XXX Legacy code:
1676 -- We used to use "-optdep-flag -optdeparg", so for legacy applications
1677 -- we need to strip the "-optdep" off of the arg
1678 deOptDep :: String -> String
1679 deOptDep x = case stripPrefix "-optdep" x of
1680 Just rest -> rest
1681 Nothing -> x
1682
1683 addCmdlineFramework f d = d{ cmdlineFrameworks = f : cmdlineFrameworks d}
1684
1685 addHaddockOpts f d = d{ haddockOptions = Just f}
1686
1687 addGhciScript f d = d{ ghciScripts = f : ghciScripts d}
1688
1689 setInteractivePrint f d = d{ interactivePrint = Just f}
1690
1691 -- -----------------------------------------------------------------------------
1692 -- Command-line options
1693
1694 -- | When invoking external tools as part of the compilation pipeline, we
1695 -- pass these a sequence of options on the command-line. Rather than
1696 -- just using a list of Strings, we use a type that allows us to distinguish
1697 -- between filepaths and 'other stuff'. The reason for this is that
1698 -- this type gives us a handle on transforming filenames, and filenames only,
1699 -- to whatever format they're expected to be on a particular platform.
1700 data Option
1701 = FileOption -- an entry that _contains_ filename(s) / filepaths.
1702 String -- a non-filepath prefix that shouldn't be
1703 -- transformed (e.g., "/out=")
1704 String -- the filepath/filename portion
1705 | Option String
1706 deriving ( Eq )
1707
1708 showOpt :: Option -> String
1709 showOpt (FileOption pre f) = pre ++ f
1710 showOpt (Option s) = s
1711
1712 -----------------------------------------------------------------------------
1713 -- Setting the optimisation level
1714
1715 updOptLevel :: Int -> DynFlags -> DynFlags
1716 -- ^ Sets the 'DynFlags' to be appropriate to the optimisation level
1717 updOptLevel n dfs
1718 = dfs2{ optLevel = final_n }
1719 where
1720 final_n = max 0 (min 2 n) -- Clamp to 0 <= n <= 2
1721 dfs1 = foldr (flip gopt_unset) dfs remove_gopts
1722 dfs2 = foldr (flip gopt_set) dfs1 extra_gopts
1723
1724 extra_gopts = [ f | (ns,f) <- optLevelFlags, final_n `elem` ns ]
1725 remove_gopts = [ f | (ns,f) <- optLevelFlags, final_n `notElem` ns ]
1726
1727 -- -----------------------------------------------------------------------------
1728 -- StgToDo: abstraction of stg-to-stg passes to run.
1729
1730 data StgToDo
1731 = StgDoMassageForProfiling -- should be (next to) last
1732 -- There's also setStgVarInfo, but its absolute "lastness"
1733 -- is so critical that it is hardwired in (no flag).
1734 | D_stg_stats
1735
1736 getStgToDo :: DynFlags -> [StgToDo]
1737 getStgToDo dflags
1738 = todo2
1739 where
1740 stg_stats = gopt Opt_StgStats dflags
1741
1742 todo1 = if stg_stats then [D_stg_stats] else []
1743
1744 todo2 | WayProf `elem` ways dflags
1745 = StgDoMassageForProfiling : todo1
1746 | otherwise
1747 = todo1
1748
1749 {- **********************************************************************
1750 %* *
1751 DynFlags parser
1752 %* *
1753 %********************************************************************* -}
1754
1755 -- -----------------------------------------------------------------------------
1756 -- Parsing the dynamic flags.
1757
1758
1759 -- | Parse dynamic flags from a list of command line arguments. Returns the
1760 -- the parsed 'DynFlags', the left-over arguments, and a list of warnings.
1761 -- Throws a 'UsageError' if errors occurred during parsing (such as unknown
1762 -- flags or missing arguments).
1763 parseDynamicFlagsCmdLine :: MonadIO m => DynFlags -> [Located String]
1764 -> m (DynFlags, [Located String], [Located String])
1765 -- ^ Updated 'DynFlags', left-over arguments, and
1766 -- list of warnings.
1767 parseDynamicFlagsCmdLine = parseDynamicFlagsFull flagsAll True
1768
1769
1770 -- | Like 'parseDynamicFlagsCmdLine' but does not allow the package flags
1771 -- (-package, -hide-package, -ignore-package, -hide-all-packages, -package-db).
1772 -- Used to parse flags set in a modules pragma.
1773 parseDynamicFilePragma :: MonadIO m => DynFlags -> [Located String]
1774 -> m (DynFlags, [Located String], [Located String])
1775 -- ^ Updated 'DynFlags', left-over arguments, and
1776 -- list of warnings.
1777 parseDynamicFilePragma = parseDynamicFlagsFull flagsDynamic False
1778
1779
1780 -- | Parses the dynamically set flags for GHC. This is the most general form of
1781 -- the dynamic flag parser that the other methods simply wrap. It allows
1782 -- saying which flags are valid flags and indicating if we are parsing
1783 -- arguments from the command line or from a file pragma.
1784 parseDynamicFlagsFull :: MonadIO m
1785 => [Flag (CmdLineP DynFlags)] -- ^ valid flags to match against
1786 -> Bool -- ^ are the arguments from the command line?
1787 -> DynFlags -- ^ current dynamic flags
1788 -> [Located String] -- ^ arguments to parse
1789 -> m (DynFlags, [Located String], [Located String])
1790 parseDynamicFlagsFull activeFlags cmdline dflags0 args = do
1791 -- XXX Legacy support code
1792 -- We used to accept things like
1793 -- optdep-f -optdepdepend
1794 -- optdep-f -optdep depend
1795 -- optdep -f -optdepdepend
1796 -- optdep -f -optdep depend
1797 -- but the spaces trip up proper argument handling. So get rid of them.
1798 let f (L p "-optdep" : L _ x : xs) = (L p ("-optdep" ++ x)) : f xs
1799 f (x : xs) = x : f xs
1800 f xs = xs
1801 args' = f args
1802
1803 let ((leftover, errs, warns), dflags1)
1804 = runCmdLine (processArgs activeFlags args') dflags0
1805 when (not (null errs)) $ liftIO $
1806 throwGhcExceptionIO $ errorsToGhcException errs
1807
1808 -- check for disabled flags in safe haskell
1809 let (dflags2, sh_warns) = safeFlagCheck cmdline dflags1
1810 dflags3 = updateWays dflags2
1811 theWays = ways dflags3
1812
1813 unless (allowed_combination theWays) $ liftIO $
1814 throwGhcExceptionIO (CmdLineError ("combination not supported: " ++
1815 intercalate "/" (map wayDesc theWays)))
1816
1817 -- TODO: This is an ugly hack. Do something better.
1818 -- -fPIC affects the CMM code we generate, so if
1819 -- we are in -dynamic-too mode we need -fPIC to be on during the
1820 -- shared part of the compilation.
1821 let doingDynamicToo = gopt Opt_BuildDynamicToo dflags3
1822 platform = targetPlatform dflags3
1823 dflags4 = if doingDynamicToo
1824 then foldr setGeneralFlag' dflags3
1825 (wayGeneralFlags platform WayDyn)
1826 else dflags3
1827
1828 {-
1829 TODO: This test doesn't quite work: We don't want to give an error
1830 when e.g. compiling a C file, only when compiling Haskell files.
1831 when doingDynamicToo $
1832 unless (isJust (outputFile dflags4) == isJust (dynOutputFile dflags4)) $
1833 liftIO $ throwGhcExceptionIO $ CmdLineError
1834 "With -dynamic-too, must give -dyno iff giving -o"
1835 -}
1836
1837 let (dflags5, consistency_warnings) = makeDynFlagsConsistent dflags4
1838
1839 liftIO $ setUnsafeGlobalDynFlags dflags5
1840
1841 return (dflags5, leftover, consistency_warnings ++ sh_warns ++ warns)
1842
1843 updateWays :: DynFlags -> DynFlags
1844 updateWays dflags
1845 = let theWays = sort $ nub $ ways dflags
1846 theBuildTag = mkBuildTag (filter (not . wayRTSOnly) theWays)
1847 in dflags {
1848 ways = theWays,
1849 buildTag = theBuildTag,
1850 rtsBuildTag = mkBuildTag theWays
1851 }
1852
1853 -- | Check (and potentially disable) any extensions that aren't allowed
1854 -- in safe mode.
1855 --
1856 -- The bool is to indicate if we are parsing command line flags (false means
1857 -- file pragma). This allows us to generate better warnings.
1858 safeFlagCheck :: Bool -> DynFlags -> (DynFlags, [Located String])
1859 safeFlagCheck _ dflags | not (safeLanguageOn dflags || safeInferOn dflags)
1860 = (dflags, [])
1861
1862 -- safe or safe-infer ON
1863 safeFlagCheck cmdl dflags =
1864 case safeLanguageOn dflags of
1865 True -> (dflags', warns)
1866
1867 -- throw error if -fpackage-trust by itself with no safe haskell flag
1868 False | not cmdl && packageTrustOn dflags
1869 -> (gopt_unset dflags' Opt_PackageTrust,
1870 [L (pkgTrustOnLoc dflags') $
1871 "-fpackage-trust ignored;" ++
1872 " must be specified with a Safe Haskell flag"]
1873 )
1874
1875 False | null warns && safeInfOk
1876 -> (dflags', [])
1877
1878 | otherwise
1879 -> (dflags' { safeHaskell = Sf_None }, [])
1880 -- Have we inferred Unsafe?
1881 -- See Note [HscMain . Safe Haskell Inference]
1882 where
1883 -- TODO: Can we do better than this for inference?
1884 safeInfOk = not $ xopt Opt_OverlappingInstances dflags
1885
1886 (dflags', warns) = foldl check_method (dflags, []) unsafeFlags
1887
1888 check_method (df, warns) (str,loc,test,fix)
1889 | test df = (apFix fix df, warns ++ safeFailure (loc dflags) str)
1890 | otherwise = (df, warns)
1891
1892 apFix f = if safeInferOn dflags then id else f
1893
1894 safeFailure loc str
1895 = [L loc $ str ++ " is not allowed in Safe Haskell; ignoring " ++ str]
1896
1897 {- **********************************************************************
1898 %* *
1899 DynFlags specifications
1900 %* *
1901 %********************************************************************* -}
1902
1903 -- | All dynamic flags option strings. These are the user facing strings for
1904 -- enabling and disabling options.
1905 allFlags :: [String]
1906 allFlags = map ('-':) $
1907 [ flagName flag | flag <- dynamic_flags ++ package_flags, ok (flagOptKind flag) ] ++
1908 map ("fno-"++) fflags ++
1909 map ("f"++) fflags ++
1910 map ("X"++) supportedExtensions
1911 where ok (PrefixPred _ _) = False
1912 ok _ = True
1913 fflags = fflags0 ++ fflags1 ++ fflags2
1914 fflags0 = [ name | (name, _, _) <- fFlags ]
1915 fflags1 = [ name | (name, _, _) <- fWarningFlags ]
1916 fflags2 = [ name | (name, _, _) <- fLangFlags ]
1917
1918 {-
1919 - Below we export user facing symbols for GHC dynamic flags for use with the
1920 - GHC API.
1921 -}
1922
1923 -- All dynamic flags present in GHC.
1924 flagsAll :: [Flag (CmdLineP DynFlags)]
1925 flagsAll = package_flags ++ dynamic_flags
1926
1927 -- All dynamic flags, minus package flags, present in GHC.
1928 flagsDynamic :: [Flag (CmdLineP DynFlags)]
1929 flagsDynamic = dynamic_flags
1930
1931 -- ALl package flags present in GHC.
1932 flagsPackage :: [Flag (CmdLineP DynFlags)]
1933 flagsPackage = package_flags
1934
1935 --------------- The main flags themselves ------------------
1936 dynamic_flags :: [Flag (CmdLineP DynFlags)]
1937 dynamic_flags = [
1938 Flag "n" (NoArg (addWarn "The -n flag is deprecated and no longer has any effect"))
1939 , Flag "cpp" (NoArg (setExtensionFlag Opt_Cpp))
1940 , Flag "F" (NoArg (setGeneralFlag Opt_Pp))
1941 , Flag "#include"
1942 (HasArg (\s -> do addCmdlineHCInclude s
1943 addWarn "-#include and INCLUDE pragmas are deprecated: They no longer have any effect"))
1944 , Flag "v" (OptIntSuffix setVerbosity)
1945
1946 ------- ways --------------------------------------------------------
1947 , Flag "prof" (NoArg (addWay WayProf))
1948 , Flag "eventlog" (NoArg (addWay WayEventLog))
1949 , Flag "parallel" (NoArg (addWay WayPar))
1950 , Flag "gransim" (NoArg (addWay WayGran))
1951 , Flag "smp" (NoArg (addWay WayThreaded >> deprecate "Use -threaded instead"))
1952 , Flag "debug" (NoArg (addWay WayDebug))
1953 , Flag "ndp" (NoArg (addWay WayNDP))
1954 , Flag "threaded" (NoArg (addWay WayThreaded))
1955
1956 , Flag "ticky" (NoArg (setGeneralFlag Opt_Ticky >> addWay WayDebug))
1957
1958 -- -ticky enables ticky-ticky code generation, and also implies -debug which
1959 -- is required to get the RTS ticky support.
1960
1961 ----- Linker --------------------------------------------------------
1962 , Flag "static" (NoArg (do setGeneralFlag Opt_Static
1963 removeWay WayDyn))
1964 , Flag "dynamic" (NoArg (do unSetGeneralFlag Opt_Static
1965 addWay WayDyn))
1966 -- ignored for compat w/ gcc:
1967 , Flag "rdynamic" (NoArg (return ()))
1968 , Flag "relative-dynlib-paths" (NoArg (setGeneralFlag Opt_RelativeDynlibPaths))
1969
1970 ------- Specific phases --------------------------------------------
1971 -- need to appear before -pgmL to be parsed as LLVM flags.
1972 , Flag "pgmlo" (hasArg (\f -> alterSettings (\s -> s { sPgm_lo = (f,[])})))
1973 , Flag "pgmlc" (hasArg (\f -> alterSettings (\s -> s { sPgm_lc = (f,[])})))
1974 , Flag "pgmL" (hasArg (\f -> alterSettings (\s -> s { sPgm_L = f})))
1975 , Flag "pgmP" (hasArg setPgmP)
1976 , Flag "pgmF" (hasArg (\f -> alterSettings (\s -> s { sPgm_F = f})))
1977 , Flag "pgmc" (hasArg (\f -> alterSettings (\s -> s { sPgm_c = (f,[])})))
1978 , Flag "pgmm" (HasArg (\_ -> addWarn "The -pgmm flag does nothing; it will be removed in a future GHC release"))
1979 , Flag "pgms" (hasArg (\f -> alterSettings (\s -> s { sPgm_s = (f,[])})))
1980 , Flag "pgma" (hasArg (\f -> alterSettings (\s -> s { sPgm_a = (f,[])})))
1981 , Flag "pgml" (hasArg (\f -> alterSettings (\s -> s { sPgm_l = (f,[])})))
1982 , Flag "pgmdll" (hasArg (\f -> alterSettings (\s -> s { sPgm_dll = (f,[])})))
1983 , Flag "pgmwindres" (hasArg (\f -> alterSettings (\s -> s { sPgm_windres = f})))
1984
1985 -- need to appear before -optl/-opta to be parsed as LLVM flags.
1986 , Flag "optlo" (hasArg (\f -> alterSettings (\s -> s { sOpt_lo = f : sOpt_lo s})))
1987 , Flag "optlc" (hasArg (\f -> alterSettings (\s -> s { sOpt_lc = f : sOpt_lc s})))
1988 , Flag "optL" (hasArg (\f -> alterSettings (\s -> s { sOpt_L = f : sOpt_L s})))
1989 , Flag "optP" (hasArg addOptP)
1990 , Flag "optF" (hasArg (\f -> alterSettings (\s -> s { sOpt_F = f : sOpt_F s})))
1991 , Flag "optc" (hasArg addOptc)
1992 , Flag "optm" (HasArg (\_ -> addWarn "The -optm flag does nothing; it will be removed in a future GHC release"))
1993 , Flag "opta" (hasArg (\f -> alterSettings (\s -> s { sOpt_a = f : sOpt_a s})))
1994 , Flag "optl" (hasArg addOptl)
1995 , Flag "optwindres" (hasArg (\f -> alterSettings (\s -> s { sOpt_windres = f : sOpt_windres s})))
1996
1997 , Flag "split-objs"
1998 (NoArg (if can_split
1999 then setGeneralFlag Opt_SplitObjs
2000 else addWarn "ignoring -fsplit-objs"))
2001
2002 -------- ghc -M -----------------------------------------------------
2003 , Flag "dep-suffix" (hasArg addDepSuffix)
2004 , Flag "optdep-s" (hasArgDF addDepSuffix "Use -dep-suffix instead")
2005 , Flag "dep-makefile" (hasArg setDepMakefile)
2006 , Flag "optdep-f" (hasArgDF setDepMakefile "Use -dep-makefile instead")
2007 , Flag "optdep-w" (NoArg (deprecate "doesn't do anything"))
2008 , Flag "include-pkg-deps" (noArg (setDepIncludePkgDeps True))
2009 , Flag "optdep--include-prelude" (noArgDF (setDepIncludePkgDeps True) "Use -include-pkg-deps instead")
2010 , Flag "optdep--include-pkg-deps" (noArgDF (setDepIncludePkgDeps True) "Use -include-pkg-deps instead")
2011 , Flag "exclude-module" (hasArg addDepExcludeMod)
2012 , Flag "optdep--exclude-module" (hasArgDF addDepExcludeMod "Use -exclude-module instead")
2013 , Flag "optdep-x" (hasArgDF addDepExcludeMod "Use -exclude-module instead")
2014
2015 -------- Linking ----------------------------------------------------
2016 , Flag "no-link" (noArg (\d -> d{ ghcLink=NoLink }))
2017 , Flag "shared" (noArg (\d -> d{ ghcLink=LinkDynLib }))
2018 , Flag "dynload" (hasArg parseDynLibLoaderMode)
2019 , Flag "dylib-install-name" (hasArg setDylibInstallName)
2020
2021 ------- Libraries ---------------------------------------------------
2022 , Flag "L" (Prefix addLibraryPath)
2023 , Flag "l" (hasArg (addOptl . ("-l" ++)))
2024
2025 ------- Frameworks --------------------------------------------------
2026 -- -framework-path should really be -F ...
2027 , Flag "framework-path" (HasArg addFrameworkPath)
2028 , Flag "framework" (hasArg addCmdlineFramework)
2029
2030 ------- Output Redirection ------------------------------------------
2031 , Flag "odir" (hasArg setObjectDir)
2032 , Flag "o" (sepArg (setOutputFile . Just))
2033 , Flag "dyno" (sepArg (setDynOutputFile . Just))
2034 , Flag "ohi" (hasArg (setOutputHi . Just ))
2035 , Flag "osuf" (hasArg setObjectSuf)
2036 , Flag "dynosuf" (hasArg setDynObjectSuf)
2037 , Flag "hcsuf" (hasArg setHcSuf)
2038 , Flag "hisuf" (hasArg setHiSuf)
2039 , Flag "dynhisuf" (hasArg setDynHiSuf)
2040 , Flag "hidir" (hasArg setHiDir)
2041 , Flag "tmpdir" (hasArg setTmpDir)
2042 , Flag "stubdir" (hasArg setStubDir)
2043 , Flag "dumpdir" (hasArg setDumpDir)
2044 , Flag "outputdir" (hasArg setOutputDir)
2045 , Flag "ddump-file-prefix" (hasArg (setDumpPrefixForce . Just))
2046
2047 , Flag "dynamic-too" (NoArg (setGeneralFlag Opt_BuildDynamicToo))
2048
2049 ------- Keeping temporary files -------------------------------------
2050 -- These can be singular (think ghc -c) or plural (think ghc --make)
2051 , Flag "keep-hc-file" (NoArg (setGeneralFlag Opt_KeepHcFiles))
2052 , Flag "keep-hc-files" (NoArg (setGeneralFlag Opt_KeepHcFiles))
2053 , Flag "keep-s-file" (NoArg (setGeneralFlag Opt_KeepSFiles))
2054 , Flag "keep-s-files" (NoArg (setGeneralFlag Opt_KeepSFiles))
2055 , Flag "keep-raw-s-file" (NoArg (addWarn "The -keep-raw-s-file flag does nothing; it will be removed in a future GHC release"))
2056 , Flag "keep-raw-s-files" (NoArg (addWarn "The -keep-raw-s-files flag does nothing; it will be removed in a future GHC release"))
2057 , Flag "keep-llvm-file" (NoArg (do setObjTarget HscLlvm
2058 setGeneralFlag Opt_KeepLlvmFiles))
2059 , Flag "keep-llvm-files" (NoArg (do setObjTarget HscLlvm
2060 setGeneralFlag Opt_KeepLlvmFiles))
2061 -- This only makes sense as plural
2062 , Flag "keep-tmp-files" (NoArg (setGeneralFlag Opt_KeepTmpFiles))
2063
2064 ------- Miscellaneous ----------------------------------------------
2065 , Flag "no-auto-link-packages" (NoArg (unSetGeneralFlag Opt_AutoLinkPackages))
2066 , Flag "no-hs-main" (NoArg (setGeneralFlag Opt_NoHsMain))
2067 , Flag "with-rtsopts" (HasArg setRtsOpts)
2068 , Flag "rtsopts" (NoArg (setRtsOptsEnabled RtsOptsAll))
2069 , Flag "rtsopts=all" (NoArg (setRtsOptsEnabled RtsOptsAll))
2070 , Flag "rtsopts=some" (NoArg (setRtsOptsEnabled RtsOptsSafeOnly))
2071 , Flag "rtsopts=none" (NoArg (setRtsOptsEnabled RtsOptsNone))
2072 , Flag "no-rtsopts" (NoArg (setRtsOptsEnabled RtsOptsNone))
2073 , Flag "main-is" (SepArg setMainIs)
2074 , Flag "haddock" (NoArg (setGeneralFlag Opt_Haddock))
2075 , Flag "haddock-opts" (hasArg addHaddockOpts)
2076 , Flag "hpcdir" (SepArg setOptHpcDir)
2077 , Flag "ghci-script" (hasArg addGhciScript)
2078 , Flag "interactive-print" (hasArg setInteractivePrint)
2079 ------- recompilation checker --------------------------------------
2080 , Flag "recomp" (NoArg (do unSetGeneralFlag Opt_ForceRecomp
2081 deprecate "Use -fno-force-recomp instead"))
2082 , Flag "no-recomp" (NoArg (do setGeneralFlag Opt_ForceRecomp
2083 deprecate "Use -fforce-recomp instead"))
2084
2085 ------ HsCpp opts ---------------------------------------------------
2086 , Flag "D" (AnySuffix (upd . addOptP))
2087 , Flag "U" (AnySuffix (upd . addOptP))
2088
2089 ------- Include/Import Paths ----------------------------------------
2090 , Flag "I" (Prefix addIncludePath)
2091 , Flag "i" (OptPrefix addImportPath)
2092
2093 ------ Output style options -----------------------------------------
2094 , Flag "dppr-user-length" (intSuffix (\n d -> d{ pprUserLength = n }))
2095 , Flag "dppr-cols" (intSuffix (\n d -> d{ pprCols = n }))
2096 , Flag "dtrace-level" (intSuffix (\n d -> d{ traceLevel = n }))
2097 -- Suppress all that is suppressable in core dumps.
2098 -- Except for uniques, as some simplifier phases introduce new varibles that
2099 -- have otherwise identical names.
2100 , Flag "dsuppress-all" (NoArg $ do setGeneralFlag Opt_SuppressCoercions
2101 setGeneralFlag Opt_SuppressVarKinds
2102 setGeneralFlag Opt_SuppressModulePrefixes
2103 setGeneralFlag Opt_SuppressTypeApplications
2104 setGeneralFlag Opt_SuppressIdInfo
2105 setGeneralFlag Opt_SuppressTypeSignatures)
2106
2107 ------ Debugging ----------------------------------------------------
2108 , Flag "dstg-stats" (NoArg (setGeneralFlag Opt_StgStats))
2109
2110 , Flag "ddump-cmm" (setDumpFlag Opt_D_dump_cmm)
2111 , Flag "ddump-cmm-raw" (setDumpFlag Opt_D_dump_cmm_raw)
2112 , Flag "ddump-cmm-cfg" (setDumpFlag Opt_D_dump_cmm_cfg)
2113 , Flag "ddump-cmm-cbe" (setDumpFlag Opt_D_dump_cmm_cbe)
2114 , Flag "ddump-cmm-proc" (setDumpFlag Opt_D_dump_cmm_proc)
2115 , Flag "ddump-cmm-rewrite" (setDumpFlag Opt_D_dump_cmm_rewrite)
2116 , Flag "ddump-cmm-sp" (setDumpFlag Opt_D_dump_cmm_sp)
2117 , Flag "ddump-cmm-procmap" (setDumpFlag Opt_D_dump_cmm_procmap)
2118 , Flag "ddump-cmm-split" (setDumpFlag Opt_D_dump_cmm_split)
2119 , Flag "ddump-cmm-info" (setDumpFlag Opt_D_dump_cmm_info)
2120 , Flag "ddump-cmm-cps" (setDumpFlag Opt_D_dump_cmm_cps)
2121 , Flag "ddump-core-stats" (setDumpFlag Opt_D_dump_core_stats)
2122 , Flag "ddump-asm" (setDumpFlag Opt_D_dump_asm)
2123 , Flag "ddump-asm-native" (setDumpFlag Opt_D_dump_asm_native)
2124 , Flag "ddump-asm-liveness" (setDumpFlag Opt_D_dump_asm_liveness)
2125 , Flag "ddump-asm-regalloc" (setDumpFlag Opt_D_dump_asm_regalloc)
2126 , Flag "ddump-asm-conflicts" (setDumpFlag Opt_D_dump_asm_conflicts)
2127 , Flag "ddump-asm-regalloc-stages" (setDumpFlag Opt_D_dump_asm_regalloc_stages)
2128 , Flag "ddump-asm-stats" (setDumpFlag Opt_D_dump_asm_stats)
2129 , Flag "ddump-asm-expanded" (setDumpFlag Opt_D_dump_asm_expanded)
2130 , Flag "ddump-llvm" (NoArg (do setObjTarget HscLlvm
2131 setDumpFlag' Opt_D_dump_llvm))
2132 , Flag "ddump-deriv" (setDumpFlag Opt_D_dump_deriv)
2133 , Flag "ddump-ds" (setDumpFlag Opt_D_dump_ds)
2134 , Flag "ddump-foreign" (setDumpFlag Opt_D_dump_foreign)
2135 , Flag "ddump-inlinings" (setDumpFlag Opt_D_dump_inlinings)
2136 , Flag "ddump-rule-firings" (setDumpFlag Opt_D_dump_rule_firings)
2137 , Flag "ddump-rule-rewrites" (setDumpFlag Opt_D_dump_rule_rewrites)
2138 , Flag "ddump-simpl-trace" (setDumpFlag Opt_D_dump_simpl_trace)
2139 , Flag "ddump-occur-anal" (setDumpFlag Opt_D_dump_occur_anal)
2140 , Flag "ddump-parsed" (setDumpFlag Opt_D_dump_parsed)
2141 , Flag "ddump-rn" (setDumpFlag Opt_D_dump_rn)
2142 , Flag "ddump-core-pipeline" (setDumpFlag Opt_D_dump_core_pipeline)
2143 , Flag "ddump-simpl" (setDumpFlag Opt_D_dump_simpl)
2144 , Flag "ddump-simpl-iterations" (setDumpFlag Opt_D_dump_simpl_iterations)
2145 , Flag "ddump-simpl-phases" (OptPrefix setDumpSimplPhases)
2146 , Flag "ddump-spec" (setDumpFlag Opt_D_dump_spec)
2147 , Flag "ddump-prep" (setDumpFlag Opt_D_dump_prep)
2148 , Flag "ddump-stg" (setDumpFlag Opt_D_dump_stg)
2149 , Flag "ddump-stranal" (setDumpFlag Opt_D_dump_stranal)
2150 , Flag "ddump-tc" (setDumpFlag Opt_D_dump_tc)
2151 , Flag "ddump-types" (setDumpFlag Opt_D_dump_types)
2152 , Flag "ddump-rules" (setDumpFlag Opt_D_dump_rules)
2153 , Flag "ddump-cse" (setDumpFlag Opt_D_dump_cse)
2154 , Flag "ddump-worker-wrapper" (setDumpFlag Opt_D_dump_worker_wrapper)
2155 , Flag "ddump-rn-trace" (setDumpFlag Opt_D_dump_rn_trace)
2156 , Flag "ddump-if-trace" (setDumpFlag Opt_D_dump_if_trace)
2157 , Flag "ddump-cs-trace" (setDumpFlag Opt_D_dump_cs_trace)
2158 , Flag "ddump-tc-trace" (setDumpFlag Opt_D_dump_tc_trace)
2159 , Flag "ddump-vt-trace" (setDumpFlag Opt_D_dump_vt_trace)
2160 , Flag "ddump-splices" (setDumpFlag Opt_D_dump_splices)
2161 , Flag "ddump-rn-stats" (setDumpFlag Opt_D_dump_rn_stats)
2162 , Flag "ddump-opt-cmm" (setDumpFlag Opt_D_dump_opt_cmm)
2163 , Flag "ddump-simpl-stats" (setDumpFlag Opt_D_dump_simpl_stats)
2164 , Flag "ddump-bcos" (setDumpFlag Opt_D_dump_BCOs)
2165 , Flag "dsource-stats" (setDumpFlag Opt_D_source_stats)
2166 , Flag "dverbose-core2core" (NoArg (do setVerbosity (Just 2)
2167 setVerboseCore2Core))
2168 , Flag "dverbose-stg2stg" (setDumpFlag Opt_D_verbose_stg2stg)
2169 , Flag "ddump-hi" (setDumpFlag Opt_D_dump_hi)
2170 , Flag "ddump-minimal-imports" (NoArg (setGeneralFlag Opt_D_dump_minimal_imports))
2171 , Flag "ddump-vect" (setDumpFlag Opt_D_dump_vect)
2172 , Flag "ddump-hpc" (setDumpFlag Opt_D_dump_ticked) -- back compat
2173 , Flag "ddump-ticked" (setDumpFlag Opt_D_dump_ticked)
2174 , Flag "ddump-mod-cycles" (setDumpFlag Opt_D_dump_mod_cycles)
2175 , Flag "ddump-view-pattern-commoning" (setDumpFlag Opt_D_dump_view_pattern_commoning)
2176 , Flag "ddump-to-file" (NoArg (setGeneralFlag Opt_DumpToFile))
2177 , Flag "ddump-hi-diffs" (setDumpFlag Opt_D_dump_hi_diffs)
2178 , Flag "ddump-rtti" (setDumpFlag Opt_D_dump_rtti)
2179 , Flag "dcore-lint" (NoArg (setGeneralFlag Opt_DoCoreLinting))
2180 , Flag "dstg-lint" (NoArg (setGeneralFlag Opt_DoStgLinting))
2181 , Flag "dcmm-lint" (NoArg (setGeneralFlag Opt_DoCmmLinting))
2182 , Flag "dasm-lint" (NoArg (setGeneralFlag Opt_DoAsmLinting))
2183 , Flag "dshow-passes" (NoArg (do forceRecompile
2184 setVerbosity $ Just 2))
2185 , Flag "dfaststring-stats" (NoArg (setGeneralFlag Opt_D_faststring_stats))
2186 , Flag "dno-llvm-mangler" (NoArg (setGeneralFlag Opt_NoLlvmMangler)) -- hidden flag
2187
2188 ------ Machine dependant (-m<blah>) stuff ---------------------------
2189
2190 , Flag "monly-2-regs" (NoArg (addWarn "The -monly-2-regs flag does nothing; it will be removed in a future GHC release"))
2191 , Flag "monly-3-regs" (NoArg (addWarn "The -monly-3-regs flag does nothing; it will be removed in a future GHC release"))
2192 , Flag "monly-4-regs" (NoArg (addWarn "The -monly-4-regs flag does nothing; it will be removed in a future GHC release"))
2193 , Flag "msse" (versionSuffix (\maj min d -> d{ sseVersion = Just (maj, min) }))
2194
2195 ------ Warning opts -------------------------------------------------
2196 , Flag "W" (NoArg (mapM_ setWarningFlag minusWOpts))
2197 , Flag "Werror" (NoArg (setGeneralFlag Opt_WarnIsError))
2198 , Flag "Wwarn" (NoArg (unSetGeneralFlag Opt_WarnIsError))
2199 , Flag "Wall" (NoArg (mapM_ setWarningFlag minusWallOpts))
2200 , Flag "Wnot" (NoArg (do upd (\dfs -> dfs {warningFlags = IntSet.empty})
2201 deprecate "Use -w instead"))
2202 , Flag "w" (NoArg (upd (\dfs -> dfs {warningFlags = IntSet.empty})))
2203
2204 ------ Plugin flags ------------------------------------------------
2205 , Flag "fplugin-opt" (hasArg addPluginModuleNameOption)
2206 , Flag "fplugin" (hasArg addPluginModuleName)
2207
2208 ------ Optimisation flags ------------------------------------------
2209 , Flag "O" (noArgM (setOptLevel 1))
2210 , Flag "Onot" (noArgM (\dflags -> do deprecate "Use -O0 instead"
2211 setOptLevel 0 dflags))
2212 , Flag "Odph" (noArgM setDPHOpt)
2213 , Flag "O" (optIntSuffixM (\mb_n -> setOptLevel (mb_n `orElse` 1)))
2214 -- If the number is missing, use 1
2215
2216 , Flag "fsimplifier-phases" (intSuffix (\n d -> d{ simplPhases = n }))
2217 , Flag "fmax-simplifier-iterations" (intSuffix (\n d -> d{ maxSimplIterations = n }))
2218 , Flag "fsimpl-tick-factor" (intSuffix (\n d -> d{ simplTickFactor = n }))
2219 , Flag "fspec-constr-threshold" (intSuffix (\n d -> d{ specConstrThreshold = Just n }))
2220 , Flag "fno-spec-constr-threshold" (noArg (\d -> d{ specConstrThreshold = Nothing }))
2221 , Flag "fspec-constr-count" (intSuffix (\n d -> d{ specConstrCount = Just n }))
2222 , Flag "fno-spec-constr-count" (noArg (\d -> d{ specConstrCount = Nothing }))
2223 , Flag "fliberate-case-threshold" (intSuffix (\n d -> d{ liberateCaseThreshold = Just n }))
2224 , Flag "fno-liberate-case-threshold" (noArg (\d -> d{ liberateCaseThreshold = Nothing }))
2225 , Flag "frule-check" (sepArg (\s d -> d{ ruleCheck = Just s }))
2226 , Flag "fcontext-stack" (intSuffix (\n d -> d{ ctxtStkDepth = n }))
2227 , Flag "fstrictness-before" (intSuffix (\n d -> d{ strictnessBefore = n : strictnessBefore d }))
2228 , Flag "ffloat-lam-args" (intSuffix (\n d -> d{ floatLamArgs = Just n }))
2229 , Flag "ffloat-all-lams" (noArg (\d -> d{ floatLamArgs = Nothing }))
2230 , Flag "fhistory-size" (intSuffix (\n d -> d{ historySize = n }))
2231
2232 , Flag "funfolding-creation-threshold" (intSuffix (\n d -> d {ufCreationThreshold = n}))
2233 , Flag "funfolding-use-threshold" (intSuffix (\n d -> d {ufUseThreshold = n}))
2234 , Flag "funfolding-fun-discount" (intSuffix (\n d -> d {ufFunAppDiscount = n}))
2235 , Flag "funfolding-dict-discount" (intSuffix (\n d -> d {ufDictDiscount = n}))
2236 , Flag "funfolding-keeness-factor" (floatSuffix (\n d -> d {ufKeenessFactor = n}))
2237
2238 , Flag "fmax-worker-args" (intSuffix (\n d -> d {maxWorkerArgs = n}))
2239
2240 , Flag "fghci-hist-size" (intSuffix (\n d -> d {ghciHistSize = n}))
2241
2242 ------ Profiling ----------------------------------------------------
2243
2244 -- OLD profiling flags
2245 , Flag "auto-all" (noArg (\d -> d { profAuto = ProfAutoAll } ))
2246 , Flag "no-auto-all" (noArg (\d -> d { profAuto = NoProfAuto } ))
2247 , Flag "auto" (noArg (\d -> d { profAuto = ProfAutoExports } ))
2248 , Flag "no-auto" (noArg (\d -> d { profAuto = NoProfAuto } ))
2249 , Flag "caf-all" (NoArg (setGeneralFlag Opt_AutoSccsOnIndividualCafs))
2250 , Flag "no-caf-all" (NoArg (unSetGeneralFlag Opt_AutoSccsOnIndividualCafs))
2251
2252 -- NEW profiling flags
2253 , Flag "fprof-auto" (noArg (\d -> d { profAuto = ProfAutoAll } ))
2254 , Flag "fprof-auto-top" (noArg (\d -> d { profAuto = ProfAutoTop } ))
2255 , Flag "fprof-auto-exported" (noArg (\d -> d { profAuto = ProfAutoExports } ))
2256 , Flag "fprof-auto-calls" (noArg (\d -> d { profAuto = ProfAutoCalls } ))
2257 , Flag "fno-prof-auto" (noArg (\d -> d { profAuto = NoProfAuto } ))
2258
2259 ------ Compiler flags -----------------------------------------------
2260
2261 , Flag "fasm" (NoArg (setObjTarget HscAsm))
2262 , Flag "fvia-c" (NoArg
2263 (addWarn "The -fvia-c flag does nothing; it will be removed in a future GHC release"))
2264 , Flag "fvia-C" (NoArg
2265 (addWarn "The -fvia-C flag does nothing; it will be removed in a future GHC release"))
2266 , Flag "fllvm" (NoArg (setObjTarget HscLlvm))
2267
2268 , Flag "fno-code" (NoArg (do upd $ \d -> d{ ghcLink=NoLink }
2269 setTarget HscNothing))
2270 , Flag "fbyte-code" (NoArg (setTarget HscInterpreted))
2271 , Flag "fobject-code" (NoArg (setTargetWithPlatform defaultHscTarget))
2272 , Flag "fglasgow-exts" (NoArg (enableGlasgowExts >> deprecate "Use individual extensions instead"))
2273 , Flag "fno-glasgow-exts" (NoArg (disableGlasgowExts >> deprecate "Use individual extensions instead"))
2274
2275 ------ Safe Haskell flags -------------------------------------------
2276 , Flag "fpackage-trust" (NoArg setPackageTrust)
2277 , Flag "fno-safe-infer" (NoArg (setSafeHaskell Sf_None))
2278 , Flag "fPIC" (NoArg (setGeneralFlag Opt_PIC))
2279 , Flag "fno-PIC" (NoArg (unSetGeneralFlag Opt_PIC))
2280 ]
2281 ++ map (mkFlag turnOn "" setGeneralFlag ) negatableFlags
2282 ++ map (mkFlag turnOff "no-" unSetGeneralFlag) negatableFlags
2283 ++ map (mkFlag turnOn "d" setGeneralFlag ) dFlags
2284 ++ map (mkFlag turnOff "dno-" unSetGeneralFlag) dFlags
2285 ++ map (mkFlag turnOn "f" setGeneralFlag ) fFlags
2286 ++ map (mkFlag turnOff "fno-" unSetGeneralFlag) fFlags
2287 ++ map (mkFlag turnOn "f" setWarningFlag ) fWarningFlags
2288 ++ map (mkFlag turnOff "fno-" unSetWarningFlag) fWarningFlags
2289 ++ map (mkFlag turnOn "f" setExtensionFlag ) fLangFlags
2290 ++ map (mkFlag turnOff "fno-" unSetExtensionFlag) fLangFlags
2291 ++ map (mkFlag turnOn "X" setExtensionFlag ) xFlags
2292 ++ map (mkFlag turnOff "XNo" unSetExtensionFlag) xFlags
2293 ++ map (mkFlag turnOn "X" setLanguage) languageFlags
2294 ++ map (mkFlag turnOn "X" setSafeHaskell) safeHaskellFlags
2295 ++ [ Flag "XGenerics" (NoArg (deprecate "it does nothing; look into -XDefaultSignatures and -XDeriveGeneric for generic programming support."))
2296 , Flag "XNoGenerics" (NoArg (deprecate "it does nothing; look into -XDefaultSignatures and -XDeriveGeneric for generic programming support.")) ]
2297
2298 package_flags :: [Flag (CmdLineP DynFlags)]
2299 package_flags = [
2300 ------- Packages ----------------------------------------------------
2301 Flag "package-db" (HasArg (addPkgConfRef . PkgConfFile))
2302 , Flag "clear-package-db" (NoArg clearPkgConf)
2303 , Flag "no-global-package-db" (NoArg removeGlobalPkgConf)
2304 , Flag "no-user-package-db" (NoArg removeUserPkgConf)
2305 , Flag "global-package-db" (NoArg (addPkgConfRef GlobalPkgConf))
2306 , Flag "user-package-db" (NoArg (addPkgConfRef UserPkgConf))
2307
2308 -- backwards compat with GHC<=7.4 :
2309 , Flag "package-conf" (HasArg $ \path -> do
2310 addPkgConfRef (PkgConfFile path)
2311 deprecate "Use -package-db instead")
2312 , Flag "no-user-package-conf" (NoArg $ do
2313 removeUserPkgConf
2314 deprecate "Use -no-user-package-db instead")
2315
2316 , Flag "package-name" (hasArg setPackageName)
2317 , Flag "package-id" (HasArg exposePackageId)
2318 , Flag "package" (HasArg exposePackage)
2319 , Flag "hide-package" (HasArg hidePackage)
2320 , Flag "hide-all-packages" (NoArg (setGeneralFlag Opt_HideAllPackages))
2321 , Flag "ignore-package" (HasArg ignorePackage)
2322 , Flag "syslib" (HasArg (\s -> do exposePackage s
2323 deprecate "Use -package instead"))
2324 , Flag "distrust-all-packages" (NoArg (setGeneralFlag Opt_DistrustAllPackages))
2325 , Flag "trust" (HasArg trustPackage)
2326 , Flag "distrust" (HasArg distrustPackage)
2327 ]
2328
2329 type TurnOnFlag = Bool -- True <=> we are turning the flag on
2330 -- False <=> we are turning the flag off
2331 turnOn :: TurnOnFlag; turnOn = True
2332 turnOff :: TurnOnFlag; turnOff = False
2333
2334 type FlagSpec flag
2335 = ( String -- Flag in string form
2336 , flag -- Flag in internal form
2337 , TurnOnFlag -> DynP ()) -- Extra action to run when the flag is found
2338 -- Typically, emit a warning or error
2339
2340 mkFlag :: TurnOnFlag -- ^ True <=> it should be turned on
2341 -> String -- ^ The flag prefix
2342 -> (flag -> DynP ()) -- ^ What to do when the flag is found
2343 -> FlagSpec flag -- ^ Specification of this particular flag
2344 -> Flag (CmdLineP DynFlags)
2345 mkFlag turn_on flagPrefix f (name, flag, extra_action)
2346 = Flag (flagPrefix ++ name) (NoArg (f flag >> extra_action turn_on))
2347
2348 deprecatedForExtension :: String -> TurnOnFlag -> DynP ()
2349 deprecatedForExtension lang turn_on
2350 = deprecate ("use -X" ++ flag ++ " or pragma {-# LANGUAGE " ++ flag ++ " #-} instead")
2351 where
2352 flag | turn_on = lang
2353 | otherwise = "No"++lang
2354
2355 useInstead :: String -> TurnOnFlag -> DynP ()
2356 useInstead flag turn_on
2357 = deprecate ("Use -f" ++ no ++ flag ++ " instead")
2358 where
2359 no = if turn_on then "" else "no-"
2360
2361 nop :: TurnOnFlag -> DynP ()
2362 nop _ = return ()
2363
2364 -- | These @-f\<blah\>@ flags can all be reversed with @-fno-\<blah\>@
2365 fWarningFlags :: [FlagSpec WarningFlag]
2366 fWarningFlags = [
2367 ( "warn-dodgy-foreign-imports", Opt_WarnDodgyForeignImports, nop ),
2368 ( "warn-dodgy-exports", Opt_WarnDodgyExports, nop ),
2369 ( "warn-dodgy-imports", Opt_WarnDodgyImports, nop ),
2370 ( "warn-duplicate-exports", Opt_WarnDuplicateExports, nop ),
2371 ( "warn-duplicate-constraints", Opt_WarnDuplicateConstraints, nop ),
2372 ( "warn-hi-shadowing", Opt_WarnHiShadows, nop ),
2373 ( "warn-implicit-prelude", Opt_WarnImplicitPrelude, nop ),
2374 ( "warn-incomplete-patterns", Opt_WarnIncompletePatterns, nop ),
2375 ( "warn-incomplete-uni-patterns", Opt_WarnIncompleteUniPatterns, nop ),
2376 ( "warn-incomplete-record-updates", Opt_WarnIncompletePatternsRecUpd, nop ),
2377 ( "warn-missing-fields", Opt_WarnMissingFields, nop ),
2378 ( "warn-missing-import-lists", Opt_WarnMissingImportList, nop ),
2379 ( "warn-missing-methods", Opt_WarnMissingMethods, nop ),
2380 ( "warn-missing-signatures", Opt_WarnMissingSigs, nop ),
2381 ( "warn-missing-local-sigs", Opt_WarnMissingLocalSigs, nop ),
2382 ( "warn-name-shadowing", Opt_WarnNameShadowing, nop ),
2383 ( "warn-overlapping-patterns", Opt_WarnOverlappingPatterns, nop ),
2384 ( "warn-type-defaults", Opt_WarnTypeDefaults, nop ),
2385 ( "warn-monomorphism-restriction", Opt_WarnMonomorphism, nop ),
2386 ( "warn-unused-binds", Opt_WarnUnusedBinds, nop ),
2387 ( "warn-unused-imports", Opt_WarnUnusedImports, nop ),
2388 ( "warn-unused-matches", Opt_WarnUnusedMatches, nop ),
2389 ( "warn-warnings-deprecations", Opt_WarnWarningsDeprecations, nop ),
2390 ( "warn-deprecations", Opt_WarnWarningsDeprecations, nop ),
2391 ( "warn-deprecated-flags", Opt_WarnDeprecatedFlags, nop ),
2392 ( "warn-orphans", Opt_WarnOrphans, nop ),
2393 ( "warn-identities", Opt_WarnIdentities, nop ),
2394 ( "warn-auto-orphans", Opt_WarnAutoOrphans, nop ),
2395 ( "warn-tabs", Opt_WarnTabs, nop ),
2396 ( "warn-unrecognised-pragmas", Opt_WarnUnrecognisedPragmas, nop ),
2397 ( "warn-lazy-unlifted-bindings", Opt_WarnLazyUnliftedBindings, nop ),
2398 ( "warn-unused-do-bind", Opt_WarnUnusedDoBind, nop ),
2399 ( "warn-wrong-do-bind", Opt_WarnWrongDoBind, nop ),
2400 ( "warn-alternative-layout-rule-transitional", Opt_WarnAlternativeLayoutRuleTransitional, nop ),
2401 ( "warn-unsafe", Opt_WarnUnsafe, setWarnUnsafe ),
2402 ( "warn-safe", Opt_WarnSafe, setWarnSafe ),
2403 ( "warn-pointless-pragmas", Opt_WarnPointlessPragmas, nop ),
2404 ( "warn-unsupported-calling-conventions", Opt_WarnUnsupportedCallingConventions, nop ),
2405 ( "warn-inline-rule-shadowing", Opt_WarnInlineRuleShadowing, nop ),
2406 ( "warn-unsupported-llvm-version", Opt_WarnUnsupportedLlvmVersion, nop ),
2407 ( "warn-typeable-instances", Opt_WarnTypeableInstances, nop ) ]
2408
2409 -- | These @-\<blah\>@ flags can all be reversed with @-no-\<blah\>@
2410 negatableFlags :: [FlagSpec GeneralFlag]
2411 negatableFlags = [
2412 ( "ignore-dot-ghci", Opt_IgnoreDotGhci, nop ) ]
2413
2414 -- | These @-d\<blah\>@ flags can all be reversed with @-dno-\<blah\>@
2415 dFlags :: [FlagSpec GeneralFlag]
2416 dFlags = [
2417 ( "suppress-coercions", Opt_SuppressCoercions, nop),
2418 ( "suppress-var-kinds", Opt_SuppressVarKinds, nop),
2419 ( "suppress-module-prefixes", Opt_SuppressModulePrefixes, nop),
2420 ( "suppress-type-applications", Opt_SuppressTypeApplications, nop),
2421 ( "suppress-idinfo", Opt_SuppressIdInfo, nop),
2422 ( "suppress-type-signatures", Opt_SuppressTypeSignatures, nop),
2423 ( "suppress-uniques", Opt_SuppressUniques, nop),
2424 ( "ppr-case-as-let", Opt_PprCaseAsLet, nop)]
2425
2426 -- | These @-f\<blah\>@ flags can all be reversed with @-fno-\<blah\>@
2427 fFlags :: [FlagSpec GeneralFlag]
2428 fFlags = [
2429 ( "error-spans", Opt_ErrorSpans, nop ),
2430 ( "print-explicit-foralls", Opt_PrintExplicitForalls, nop ),
2431 ( "strictness", Opt_Strictness, nop ),
2432 ( "specialise", Opt_Specialise, nop ),
2433 ( "float-in", Opt_FloatIn, nop ),
2434 ( "static-argument-transformation", Opt_StaticArgumentTransformation, nop ),
2435 ( "full-laziness", Opt_FullLaziness, nop ),
2436 ( "liberate-case", Opt_LiberateCase, nop ),
2437 ( "spec-constr", Opt_SpecConstr, nop ),
2438 ( "cse", Opt_CSE, nop ),
2439 ( "pedantic-bottoms", Opt_PedanticBottoms, nop ),
2440 ( "ignore-interface-pragmas", Opt_IgnoreInterfacePragmas, nop ),
2441 ( "omit-interface-pragmas", Opt_OmitInterfacePragmas, nop ),
2442 ( "expose-all-unfoldings", Opt_ExposeAllUnfoldings, nop ),
2443 ( "do-lambda-eta-expansion", Opt_DoLambdaEtaExpansion, nop ),
2444 ( "ignore-asserts", Opt_IgnoreAsserts, nop ),
2445 ( "do-eta-reduction", Opt_DoEtaReduction, nop ),
2446 ( "case-merge", Opt_CaseMerge, nop ),
2447 ( "unbox-strict-fields", Opt_UnboxStrictFields, nop ),
2448 ( "unbox-small-strict-fields", Opt_UnboxSmallStrictFields, nop ),
2449 ( "dicts-cheap", Opt_DictsCheap, nop ),
2450 ( "excess-precision", Opt_ExcessPrecision, nop ),
2451 ( "eager-blackholing", Opt_EagerBlackHoling, nop ),
2452 ( "print-bind-result", Opt_PrintBindResult, nop ),
2453 ( "force-recomp", Opt_ForceRecomp, nop ),
2454 ( "hpc-no-auto", Opt_Hpc_No_Auto, nop ),
2455 ( "rewrite-rules", Opt_EnableRewriteRules, useInstead "enable-rewrite-rules" ),
2456 ( "enable-rewrite-rules", Opt_EnableRewriteRules, nop ),
2457 ( "break-on-exception", Opt_BreakOnException, nop ),
2458 ( "break-on-error", Opt_BreakOnError, nop ),
2459 ( "print-evld-with-show", Opt_PrintEvldWithShow, nop ),
2460 ( "print-bind-contents", Opt_PrintBindContents, nop ),
2461 ( "run-cps", Opt_RunCPS, nop ),
2462 ( "run-cpsz", Opt_RunCPSZ, nop ),
2463 ( "vectorise", Opt_Vectorise, nop ),
2464 ( "vectorisation-avoidance", Opt_VectorisationAvoidance, nop ),
2465 ( "regs-graph", Opt_RegsGraph, nop ),
2466 ( "regs-iterative", Opt_RegsIterative, nop ),
2467 ( "llvm-tbaa", Opt_LlvmTBAA, nop), -- hidden flag
2468 ( "irrefutable-tuples", Opt_IrrefutableTuples, nop ),
2469 ( "cmm-sink", Opt_CmmSink, nop ),
2470 ( "cmm-elim-common-blocks", Opt_CmmElimCommonBlocks, nop ),
2471 ( "omit-yields", Opt_OmitYields, nop ),
2472 ( "simple-list-literals", Opt_SimpleListLiterals, nop ),
2473 ( "gen-manifest", Opt_GenManifest, nop ),
2474 ( "embed-manifest", Opt_EmbedManifest, nop ),
2475 ( "ext-core", Opt_EmitExternalCore, nop ),
2476 ( "shared-implib", Opt_SharedImplib, nop ),
2477 ( "ghci-sandbox", Opt_GhciSandbox, nop ),
2478 ( "ghci-history", Opt_GhciHistory, nop ),
2479 ( "helpful-errors", Opt_HelpfulErrors, nop ),
2480 ( "defer-type-errors", Opt_DeferTypeErrors, nop ),
2481 ( "building-cabal-package", Opt_BuildingCabalPackage, nop ),
2482 ( "implicit-import-qualified", Opt_ImplicitImportQualified, nop ),
2483 ( "prof-count-entries", Opt_ProfCountEntries, nop ),
2484 ( "prof-cafs", Opt_AutoSccsOnIndividualCafs, nop ),
2485 ( "hpc", Opt_Hpc, nop ),
2486 ( "pre-inlining", Opt_SimplPreInlining, nop ),
2487 ( "use-rpaths", Opt_RPath, nop )
2488 ]
2489
2490 -- | These @-f\<blah\>@ flags can all be reversed with @-fno-\<blah\>@
2491 fLangFlags :: [FlagSpec ExtensionFlag]
2492 fLangFlags = [
2493 ( "th", Opt_TemplateHaskell,
2494 \on -> deprecatedForExtension "TemplateHaskell" on
2495 >> checkTemplateHaskellOk on ),
2496 ( "fi", Opt_ForeignFunctionInterface,
2497 deprecatedForExtension "ForeignFunctionInterface" ),
2498 ( "ffi", Opt_ForeignFunctionInterface,
2499 deprecatedForExtension "ForeignFunctionInterface" ),
2500 ( "arrows", Opt_Arrows,
2501 deprecatedForExtension "Arrows" ),
2502 ( "implicit-prelude", Opt_ImplicitPrelude,
2503 deprecatedForExtension "ImplicitPrelude" ),
2504 ( "bang-patterns", Opt_BangPatterns,
2505 deprecatedForExtension "BangPatterns" ),
2506 ( "monomorphism-restriction", Opt_MonomorphismRestriction,
2507 deprecatedForExtension "MonomorphismRestriction" ),
2508 ( "mono-pat-binds", Opt_MonoPatBinds,
2509 deprecatedForExtension "MonoPatBinds" ),
2510 ( "extended-default-rules", Opt_ExtendedDefaultRules,
2511 deprecatedForExtension "ExtendedDefaultRules" ),
2512 ( "implicit-params", Opt_ImplicitParams,
2513 deprecatedForExtension "ImplicitParams" ),
2514 ( "scoped-type-variables", Opt_ScopedTypeVariables,
2515 deprecatedForExtension "ScopedTypeVariables" ),
2516 ( "parr", Opt_ParallelArrays,
2517 deprecatedForExtension "ParallelArrays" ),
2518 ( "PArr", Opt_ParallelArrays,
2519 deprecatedForExtension "ParallelArrays" ),
2520 ( "allow-overlapping-instances", Opt_OverlappingInstances,
2521 deprecatedForExtension "OverlappingInstances" ),
2522 ( "allow-undecidable-instances", Opt_UndecidableInstances,
2523 deprecatedForExtension "UndecidableInstances" ),
2524 ( "allow-incoherent-instances", Opt_IncoherentInstances,
2525 deprecatedForExtension "IncoherentInstances" )
2526 ]
2527
2528 supportedLanguages :: [String]
2529 supportedLanguages = [ name | (name, _, _) <- languageFlags ]
2530
2531 supportedLanguageOverlays :: [String]
2532 supportedLanguageOverlays = [ name | (name, _, _) <- safeHaskellFlags ]
2533
2534 supportedExtensions :: [String]
2535 supportedExtensions = [ name' | (name, _, _) <- xFlags, name' <- [name, "No" ++ name] ]
2536
2537 supportedLanguagesAndExtensions :: [String]
2538 supportedLanguagesAndExtensions =
2539 supportedLanguages ++ supportedLanguageOverlays ++ supportedExtensions
2540
2541 -- | These -X<blah> flags cannot be reversed with -XNo<blah>
2542 languageFlags :: [FlagSpec Language]
2543 languageFlags = [
2544 ( "Haskell98", Haskell98, nop ),
2545 ( "Haskell2010", Haskell2010, nop )
2546 ]
2547
2548 -- | These -X<blah> flags cannot be reversed with -XNo<blah>
2549 -- They are used to place hard requirements on what GHC Haskell language
2550 -- features can be used.
2551 safeHaskellFlags :: [FlagSpec SafeHaskellMode]
2552 safeHaskellFlags = [mkF Sf_Unsafe, mkF Sf_Trustworthy, mkF Sf_Safe]
2553 where mkF flag = (show flag, flag, nop)
2554
2555 -- | These -X<blah> flags can all be reversed with -XNo<blah>
2556 xFlags :: [FlagSpec ExtensionFlag]
2557 xFlags = [
2558 ( "CPP", Opt_Cpp, nop ),
2559 ( "PostfixOperators", Opt_PostfixOperators, nop ),
2560 ( "TupleSections", Opt_TupleSections, nop ),
2561 ( "PatternGuards", Opt_PatternGuards, nop ),
2562 ( "UnicodeSyntax", Opt_UnicodeSyntax, nop ),
2563 ( "MagicHash", Opt_MagicHash, nop ),
2564 ( "ExistentialQuantification", Opt_ExistentialQuantification, nop ),
2565 ( "KindSignatures", Opt_KindSignatures, nop ),
2566 ( "EmptyDataDecls", Opt_EmptyDataDecls, nop ),
2567 ( "ParallelListComp", Opt_ParallelListComp, nop ),
2568 ( "TransformListComp", Opt_TransformListComp, nop ),
2569 ( "MonadComprehensions", Opt_MonadComprehensions, nop),
2570 ( "ForeignFunctionInterface", Opt_ForeignFunctionInterface, nop ),
2571 ( "UnliftedFFITypes", Opt_UnliftedFFITypes, nop ),
2572 ( "InterruptibleFFI", Opt_InterruptibleFFI, nop ),
2573 ( "CApiFFI", Opt_CApiFFI, nop ),
2574 ( "GHCForeignImportPrim", Opt_GHCForeignImportPrim, nop ),
2575 ( "LiberalTypeSynonyms", Opt_LiberalTypeSynonyms, nop ),
2576
2577 ( "PolymorphicComponents", Opt_RankNTypes, nop),
2578 ( "Rank2Types", Opt_RankNTypes, nop),
2579 ( "RankNTypes", Opt_RankNTypes, nop ),
2580
2581 ( "ImpredicativeTypes", Opt_ImpredicativeTypes, nop),
2582 ( "TypeOperators", Opt_TypeOperators, nop ),
2583 ( "ExplicitNamespaces", Opt_ExplicitNamespaces, nop ),
2584 ( "RecursiveDo", Opt_RecursiveDo, nop ), -- Enables 'mdo' and 'rec'
2585 ( "DoRec", Opt_RecursiveDo,
2586 deprecatedForExtension "RecursiveDo" ),
2587 ( "Arrows", Opt_Arrows, nop ),
2588 ( "ParallelArrays", Opt_ParallelArrays, nop ),
2589 ( "TemplateHaskell", Opt_TemplateHaskell, checkTemplateHaskellOk ),
2590 ( "QuasiQuotes", Opt_QuasiQuotes, nop ),
2591 ( "ImplicitPrelude", Opt_ImplicitPrelude, nop ),
2592 ( "RecordWildCards", Opt_RecordWildCards, nop ),
2593 ( "NamedFieldPuns", Opt_RecordPuns, nop ),
2594 ( "RecordPuns", Opt_RecordPuns,
2595 deprecatedForExtension "NamedFieldPuns" ),
2596 ( "DisambiguateRecordFields", Opt_DisambiguateRecordFields, nop ),
2597 ( "OverloadedStrings", Opt_OverloadedStrings, nop ),
2598 ( "OverloadedLists", Opt_OverloadedLists, nop),
2599 ( "GADTs", Opt_GADTs, nop ),
2600 ( "GADTSyntax", Opt_GADTSyntax, nop ),
2601 ( "ViewPatterns", Opt_ViewPatterns, nop ),
2602 ( "TypeFamilies", Opt_TypeFamilies, nop ),
2603 ( "BangPatterns", Opt_BangPatterns, nop ),
2604 ( "MonomorphismRestriction", Opt_MonomorphismRestriction, nop ),
2605 ( "NPlusKPatterns", Opt_NPlusKPatterns, nop ),
2606 ( "DoAndIfThenElse", Opt_DoAndIfThenElse, nop ),
2607 ( "RebindableSyntax", Opt_RebindableSyntax, nop ),
2608 ( "ConstraintKinds", Opt_ConstraintKinds, nop ),
2609 ( "PolyKinds", Opt_PolyKinds, nop ),
2610 ( "DataKinds", Opt_DataKinds, nop ),
2611 ( "InstanceSigs", Opt_InstanceSigs, nop ),
2612 ( "MonoPatBinds", Opt_MonoPatBinds,
2613 \ turn_on -> when turn_on $ deprecate "Experimental feature now removed; has no effect" ),
2614 ( "ExplicitForAll", Opt_ExplicitForAll, nop ),
2615 ( "AlternativeLayoutRule", Opt_AlternativeLayoutRule, nop ),
2616 ( "AlternativeLayoutRuleTransitional",Opt_AlternativeLayoutRuleTransitional, nop ),
2617 ( "DatatypeContexts", Opt_DatatypeContexts,
2618 \ turn_on -> when turn_on $ deprecate "It was widely considered a misfeature, and has been removed from the Haskell language." ),
2619 ( "NondecreasingIndentation", Opt_NondecreasingIndentation, nop ),
2620 ( "RelaxedLayout", Opt_RelaxedLayout, nop ),
2621 ( "TraditionalRecordSyntax", Opt_TraditionalRecordSyntax, nop ),
2622 ( "LambdaCase", Opt_LambdaCase, nop ),
2623 ( "MultiWayIf", Opt_MultiWayIf, nop ),
2624 ( "MonoLocalBinds", Opt_MonoLocalBinds, nop ),
2625 ( "RelaxedPolyRec", Opt_RelaxedPolyRec,
2626 \ turn_on -> unless turn_on
2627 $ deprecate "You can't turn off RelaxedPolyRec any more" ),
2628 ( "ExtendedDefaultRules", Opt_ExtendedDefaultRules, nop ),
2629 ( "ImplicitParams", Opt_ImplicitParams, nop ),
2630 ( "ScopedTypeVariables", Opt_ScopedTypeVariables, nop ),
2631 ( "AllowAmbiguousTypes", Opt_AllowAmbiguousTypes, nop),
2632
2633 ( "PatternSignatures", Opt_ScopedTypeVariables,
2634 deprecatedForExtension "ScopedTypeVariables" ),
2635
2636 ( "UnboxedTuples", Opt_UnboxedTuples, nop ),
2637 ( "StandaloneDeriving", Opt_StandaloneDeriving, nop ),
2638 ( "DeriveDataTypeable", Opt_DeriveDataTypeable, nop ),
2639 ( "AutoDeriveTypeable", Opt_AutoDeriveTypeable, nop ),
2640 ( "DeriveFunctor", Opt_DeriveFunctor, nop ),
2641 ( "DeriveTraversable", Opt_DeriveTraversable, nop ),
2642 ( "DeriveFoldable", Opt_DeriveFoldable, nop ),
2643 ( "DeriveGeneric", Opt_DeriveGeneric, nop ),
2644 ( "DefaultSignatures", Opt_DefaultSignatures, nop ),
2645 ( "TypeSynonymInstances", Opt_TypeSynonymInstances, nop ),
2646 ( "FlexibleContexts", Opt_FlexibleContexts, nop ),
2647 ( "FlexibleInstances", Opt_FlexibleInstances, nop ),
2648 ( "ConstrainedClassMethods", Opt_ConstrainedClassMethods, nop ),
2649 ( "MultiParamTypeClasses", Opt_MultiParamTypeClasses, nop ),
2650 ( "FunctionalDependencies", Opt_FunctionalDependencies, nop ),
2651 ( "GeneralizedNewtypeDeriving", Opt_GeneralizedNewtypeDeriving, setGenDeriving ),
2652 ( "OverlappingInstances", Opt_OverlappingInstances, nop ),
2653 ( "UndecidableInstances", Opt_UndecidableInstances, nop ),
2654 ( "IncoherentInstances", Opt_IncoherentInstances, nop ),
2655 ( "PackageImports", Opt_PackageImports, nop ),
2656 ( "TypeHoles", Opt_TypeHoles, nop ),
2657 ( "EmptyCase", Opt_EmptyCase, nop )
2658 ]
2659
2660 defaultFlags :: Settings -> [GeneralFlag]
2661 defaultFlags settings
2662 = [ Opt_AutoLinkPackages,
2663
2664 Opt_SharedImplib,
2665
2666 Opt_OmitYields,
2667
2668 Opt_GenManifest,
2669 Opt_EmbedManifest,
2670 Opt_PrintBindContents,
2671 Opt_GhciSandbox,
2672 Opt_GhciHistory,
2673 Opt_HelpfulErrors,
2674 Opt_ProfCountEntries,
2675 Opt_SimplPreInlining,
2676 Opt_RPath
2677 ]
2678
2679 ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns]
2680 -- The default -O0 options
2681
2682 ++ default_PIC platform
2683
2684 ++ (if pc_DYNAMIC_BY_DEFAULT (sPlatformConstants settings)
2685 then wayGeneralFlags platform WayDyn
2686 else [Opt_Static])
2687
2688 where platform = sTargetPlatform settings
2689
2690 default_PIC :: Platform -> [GeneralFlag]
2691 default_PIC platform =
2692 case (platformOS platform, platformArch platform) of
2693 (OSDarwin, ArchX86_64) -> [Opt_PIC]
2694 _ -> []
2695
2696 impliedFlags :: [(ExtensionFlag, TurnOnFlag, ExtensionFlag)]
2697 impliedFlags
2698 = [ (Opt_RankNTypes, turnOn, Opt_ExplicitForAll)
2699 , (Opt_ScopedTypeVariables, turnOn, Opt_ExplicitForAll)
2700 , (Opt_LiberalTypeSynonyms, turnOn, Opt_ExplicitForAll)
2701 , (Opt_ExistentialQuantification, turnOn, Opt_ExplicitForAll)
2702 , (Opt_FlexibleInstances, turnOn, Opt_TypeSynonymInstances)
2703 , (Opt_FunctionalDependencies, turnOn, Opt_MultiParamTypeClasses)
2704
2705 , (Opt_RebindableSyntax, turnOff, Opt_ImplicitPrelude) -- NB: turn off!
2706
2707 , (Opt_GADTs, turnOn, Opt_GADTSyntax)
2708 , (Opt_GADTs, turnOn, Opt_MonoLocalBinds)
2709 , (Opt_TypeFamilies, turnOn, Opt_MonoLocalBinds)
2710
2711 , (Opt_TypeFamilies, turnOn, Opt_KindSignatures) -- Type families use kind signatures
2712 , (Opt_PolyKinds, turnOn, Opt_KindSignatures) -- Ditto polymorphic kinds
2713
2714 -- We turn this on so that we can export associated type
2715 -- type synonyms in subordinates (e.g. MyClass(type AssocType))
2716 , (Opt_TypeFamilies, turnOn, Opt_ExplicitNamespaces)
2717 , (Opt_TypeOperators, turnOn, Opt_ExplicitNamespaces)
2718
2719 , (Opt_ImpredicativeTypes, turnOn, Opt_RankNTypes)
2720
2721 -- Record wild-cards implies field disambiguation
2722 -- Otherwise if you write (C {..}) you may well get
2723 -- stuff like " 'a' not in scope ", which is a bit silly
2724 -- if the compiler has just filled in field 'a' of constructor 'C'
2725 , (Opt_RecordWildCards, turnOn, Opt_DisambiguateRecordFields)
2726
2727 , (Opt_ParallelArrays, turnOn, Opt_ParallelListComp)
2728
2729 -- An implicit parameter constraint, `?x::Int`, is desugared into
2730 -- `IP "x" Int`, which requires a flexible context/instance.
2731 , (Opt_ImplicitParams, turnOn, Opt_FlexibleContexts)
2732 , (Opt_ImplicitParams, turnOn, Opt_FlexibleInstances)
2733 ]
2734
2735 optLevelFlags :: [([Int], GeneralFlag)]
2736 optLevelFlags
2737 = [ ([0], Opt_IgnoreInterfacePragmas)
2738 , ([0], Opt_OmitInterfacePragmas)
2739
2740 , ([1,2], Opt_IgnoreAsserts)
2741 , ([1,2], Opt_EnableRewriteRules) -- Off for -O0; see Note [Scoping for Builtin rules]
2742 -- in PrelRules
2743 , ([1,2], Opt_DoEtaReduction)
2744 , ([1,2], Opt_CaseMerge)
2745 , ([1,2], Opt_Strictness)
2746 , ([1,2], Opt_CSE)
2747 , ([1,2], Opt_FullLaziness)
2748 , ([1,2], Opt_Specialise)
2749 , ([1,2], Opt_FloatIn)
2750
2751 , ([2], Opt_LiberateCase)
2752 , ([2], Opt_SpecConstr)
2753 -- XXX disabled, see #7192
2754 -- , ([2], Opt_RegsGraph)
2755 , ([0,1,2], Opt_LlvmTBAA)
2756 , ([1,2], Opt_CmmSink)
2757 , ([1,2], Opt_CmmElimCommonBlocks)
2758
2759 -- , ([2], Opt_StaticArgumentTransformation)
2760 -- Max writes: I think it's probably best not to enable SAT with -O2 for the
2761 -- 6.10 release. The version of SAT in HEAD at the moment doesn't incorporate
2762 -- several improvements to the heuristics, and I'm concerned that without
2763 -- those changes SAT will interfere with some attempts to write "high
2764 -- performance Haskell", as we saw in some posts on Haskell-Cafe earlier
2765 -- this year. In particular, the version in HEAD lacks the tail call
2766 -- criterion, so many things that look like reasonable loops will be
2767 -- turned into functions with extra (unneccesary) thunk creation.
2768
2769 , ([0,1,2], Opt_DoLambdaEtaExpansion)
2770 -- This one is important for a tiresome reason:
2771 -- we want to make sure that the bindings for data
2772 -- constructors are eta-expanded. This is probably
2773 -- a good thing anyway, but it seems fragile.
2774 , ([0,1,2], Opt_VectorisationAvoidance)
2775 ]
2776
2777 -- -----------------------------------------------------------------------------
2778 -- Standard sets of warning options
2779
2780 standardWarnings :: [WarningFlag]
2781 standardWarnings
2782 = [ Opt_WarnWarningsDeprecations,
2783 Opt_WarnDeprecatedFlags,
2784 Opt_WarnUnrecognisedPragmas,
2785 Opt_WarnOverlappingPatterns,
2786 Opt_WarnMissingFields,
2787 Opt_WarnMissingMethods,
2788 Opt_WarnDuplicateExports,
2789 Opt_WarnLazyUnliftedBindings,
2790 Opt_WarnDodgyForeignImports,
2791 Opt_WarnWrongDoBind,
2792 Opt_WarnAlternativeLayoutRuleTransitional,
2793 Opt_WarnPointlessPragmas,
2794 Opt_WarnUnsupportedCallingConventions,
2795 Opt_WarnUnsupportedLlvmVersion,
2796 Opt_WarnInlineRuleShadowing,
2797 Opt_WarnDuplicateConstraints,
2798 Opt_WarnInlineRuleShadowing,
2799 Opt_WarnTypeableInstances
2800 ]
2801
2802 minusWOpts :: [WarningFlag]
2803 -- Things you get with -W
2804 minusWOpts
2805 = standardWarnings ++
2806 [ Opt_WarnUnusedBinds,
2807 Opt_WarnUnusedMatches,
2808 Opt_WarnUnusedImports,
2809 Opt_WarnIncompletePatterns,
2810 Opt_WarnDodgyExports,
2811 Opt_WarnDodgyImports
2812 ]
2813
2814 minusWallOpts :: [WarningFlag]
2815 -- Things you get with -Wall
2816 minusWallOpts
2817 = minusWOpts ++
2818 [ Opt_WarnTypeDefaults,
2819 Opt_WarnNameShadowing,
2820 Opt_WarnMissingSigs,
2821 Opt_WarnHiShadows,
2822 Opt_WarnOrphans,
2823 Opt_WarnUnusedDoBind
2824 ]
2825
2826 enableGlasgowExts :: DynP ()
2827 enableGlasgowExts = do setGeneralFlag Opt_PrintExplicitForalls
2828 mapM_ setExtensionFlag glasgowExtsFlags
2829
2830 disableGlasgowExts :: DynP ()
2831 disableGlasgowExts = do unSetGeneralFlag Opt_PrintExplicitForalls
2832 mapM_ unSetExtensionFlag glasgowExtsFlags
2833
2834 glasgowExtsFlags :: [ExtensionFlag]
2835 glasgowExtsFlags = [
2836 Opt_ForeignFunctionInterface
2837 , Opt_UnliftedFFITypes
2838 , Opt_ImplicitParams
2839 , Opt_ScopedTypeVariables
2840 , Opt_UnboxedTuples
2841 , Opt_TypeSynonymInstances
2842 , Opt_StandaloneDeriving
2843 , Opt_DeriveDataTypeable
2844 , Opt_DeriveFunctor
2845 , Opt_DeriveFoldable
2846 , Opt_DeriveTraversable
2847 , Opt_DeriveGeneric
2848 , Opt_FlexibleContexts
2849 , Opt_FlexibleInstances
2850 , Opt_ConstrainedClassMethods
2851 , Opt_MultiParamTypeClasses
2852 , Opt_FunctionalDependencies
2853 , Opt_MagicHash
2854 , Opt_ExistentialQuantification
2855 , Opt_UnicodeSyntax
2856 , Opt_PostfixOperators
2857 , Opt_PatternGuards
2858 , Opt_LiberalTypeSynonyms
2859 , Opt_RankNTypes
2860 , Opt_TypeOperators
2861 , Opt_ExplicitNamespaces
2862 , Opt_RecursiveDo
2863 , Opt_ParallelListComp
2864 , Opt_EmptyDataDecls
2865 , Opt_KindSignatures
2866 , Opt_GeneralizedNewtypeDeriving ]
2867
2868 #ifdef GHCI
2869 -- Consult the RTS to find whether GHC itself has been built profiled
2870 -- If so, you can't use Template Haskell
2871 foreign import ccall unsafe "rts_isProfiled" rtsIsProfiledIO :: IO CInt
2872
2873 rtsIsProfiled :: Bool
2874 rtsIsProfiled = unsafePerformIO rtsIsProfiledIO /= 0
2875 #endif
2876
2877 setWarnSafe :: Bool -> DynP ()
2878 setWarnSafe True = getCurLoc >>= \l -> upd (\d -> d { warnSafeOnLoc = l })
2879 setWarnSafe False = return ()
2880
2881 setWarnUnsafe :: Bool -> DynP ()
2882 setWarnUnsafe True = getCurLoc >>= \l -> upd (\d -> d { warnUnsafeOnLoc = l })
2883 setWarnUnsafe False = return ()
2884
2885 setPackageTrust :: DynP ()
2886 setPackageTrust = do
2887 setGeneralFlag Opt_PackageTrust
2888 l <- getCurLoc
2889 upd $ \d -> d { pkgTrustOnLoc = l }
2890
2891 setGenDeriving :: TurnOnFlag -> DynP ()
2892 setGenDeriving True = getCurLoc >>= \l -> upd (\d -> d { newDerivOnLoc = l })
2893 setGenDeriving False = return ()
2894
2895 checkTemplateHaskellOk :: TurnOnFlag -> DynP ()
2896 #ifdef GHCI
2897 checkTemplateHaskellOk turn_on
2898 | turn_on && rtsIsProfiled
2899 = addErr "You can't use Template Haskell with a profiled compiler"
2900 | otherwise
2901 = getCurLoc >>= \l -> upd (\d -> d { thOnLoc = l })
2902 #else
2903 -- In stage 1 we don't know that the RTS has rts_isProfiled,
2904 -- so we simply say "ok". It doesn't matter because TH isn't
2905 -- available in stage 1 anyway.
2906 checkTemplateHaskellOk _ = return ()
2907 #endif
2908
2909 {- **********************************************************************
2910 %* *
2911 DynFlags constructors
2912 %* *
2913 %********************************************************************* -}
2914
2915 type DynP = EwM (CmdLineP DynFlags)
2916
2917 upd :: (DynFlags -> DynFlags) -> DynP ()
2918 upd f = liftEwM (do dflags <- getCmdLineState
2919 putCmdLineState $! f dflags)
2920
2921 updM :: (DynFlags -> DynP DynFlags) -> DynP ()
2922 updM f = do dflags <- liftEwM getCmdLineState
2923 dflags' <- f dflags
2924 liftEwM $ putCmdLineState $! dflags'
2925
2926 --------------- Constructor functions for OptKind -----------------
2927 noArg :: (DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags)
2928 noArg fn = NoArg (upd fn)
2929
2930 noArgM :: (DynFlags -> DynP DynFlags) -> OptKind (CmdLineP DynFlags)
2931 noArgM fn = NoArg (updM fn)
2932
2933 noArgDF :: (DynFlags -> DynFlags) -> String -> OptKind (CmdLineP DynFlags)
2934 noArgDF fn deprec = NoArg (upd fn >> deprecate deprec)
2935
2936 hasArg :: (String -> DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags)
2937 hasArg fn = HasArg (upd . fn)
2938
2939 hasArgDF :: (String -> DynFlags -> DynFlags) -> String -> OptKind (CmdLineP DynFlags)
2940 hasArgDF fn deprec = HasArg (\s -> do upd (fn s)
2941 deprecate deprec)
2942
2943 sepArg :: (String -> DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags)
2944 sepArg fn = SepArg (upd . fn)
2945
2946 intSuffix :: (Int -> DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags)
2947 intSuffix fn = IntSuffix (\n -> upd (fn n))
2948
2949 floatSuffix :: (Float -> DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags)
2950 floatSuffix fn = FloatSuffix (\n -> upd (fn n))
2951
2952 optIntSuffixM :: (Maybe Int -> DynFlags -> DynP DynFlags)
2953 -> OptKind (CmdLineP DynFlags)
2954 optIntSuffixM fn = OptIntSuffix (\mi -> updM (fn mi))
2955
2956 versionSuffix :: (Int -> Int -> DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags)
2957 versionSuffix fn = VersionSuffix (\maj min -> upd (fn maj min))
2958
2959 setDumpFlag :: DumpFlag -> OptKind (CmdLineP DynFlags)
2960 setDumpFlag dump_flag = NoArg (setDumpFlag' dump_flag)
2961
2962 --------------------------
2963 addWay :: Way -> DynP ()
2964 addWay w = upd (addWay' w)
2965
2966 addWay' :: Way -> DynFlags -> DynFlags
2967 addWay' w dflags0 = let platform = targetPlatform dflags0
2968 dflags1 = dflags0 { ways = w : ways dflags0 }
2969 dflags2 = wayExtras platform w dflags1
2970 dflags3 = foldr setGeneralFlag' dflags2 (wayGeneralFlags platform w)
2971 in dflags3
2972
2973 removeWay :: Way -> DynP ()
2974 removeWay w = do
2975 upd (\dfs -> dfs { ways = filter (w /=) (ways dfs) })
2976 dfs <- liftEwM getCmdLineState
2977 let platform = targetPlatform dfs
2978 -- XXX: wayExtras?
2979 mapM_ unSetGeneralFlag $ wayGeneralFlags platform w
2980 -- turn Opt_PIC back on if necessary for this platform:
2981 mapM_ setGeneralFlag $ default_PIC platform
2982
2983 --------------------------
2984 setGeneralFlag, unSetGeneralFlag :: GeneralFlag -> DynP ()
2985 setGeneralFlag f = upd (setGeneralFlag' f)
2986 unSetGeneralFlag f = upd (unSetGeneralFlag' f)
2987
2988 setGeneralFlag' :: GeneralFlag -> DynFlags -> DynFlags
2989 setGeneralFlag' f dflags = gopt_set dflags f
2990 unSetGeneralFlag' :: GeneralFlag -> DynFlags -> DynFlags
2991 unSetGeneralFlag' f dflags = gopt_unset dflags f
2992
2993 --------------------------
2994 setWarningFlag, unSetWarningFlag :: WarningFlag -> DynP ()
2995 setWarningFlag f = upd (\dfs -> wopt_set dfs f)
2996 unSetWarningFlag f = upd (\dfs -> wopt_unset dfs f)
2997
2998 --------------------------
2999 setExtensionFlag, unSetExtensionFlag :: ExtensionFlag -> DynP ()
3000 setExtensionFlag f = upd (setExtensionFlag' f)
3001 unSetExtensionFlag f = upd (unSetExtensionFlag' f)
3002
3003 setExtensionFlag', unSetExtensionFlag' :: ExtensionFlag -> DynFlags -> DynFlags
3004 setExtensionFlag' f dflags = foldr ($) (xopt_set dflags f) deps
3005 where
3006 deps = [ if turn_on then setExtensionFlag' d
3007 else unSetExtensionFlag' d
3008 | (f', turn_on, d) <- impliedFlags, f' == f ]
3009 -- When you set f, set the ones it implies
3010 -- NB: use setExtensionFlag recursively, in case the implied flags
3011 -- implies further flags
3012
3013 unSetExtensionFlag' f dflags = xopt_unset dflags f
3014 -- When you un-set f, however, we don't un-set the things it implies
3015 -- (except for -fno-glasgow-exts, which is treated specially)
3016
3017 --------------------------
3018 alterSettings :: (Settings -> Settings) -> DynFlags -> DynFlags
3019 alterSettings f dflags = dflags { settings = f (settings dflags) }
3020
3021 --------------------------
3022 setDumpFlag' :: DumpFlag -> DynP ()
3023 setDumpFlag' dump_flag
3024 = do upd (\dfs -> dopt_set dfs dump_flag)
3025 when want_recomp forceRecompile
3026 where -- Certain dumpy-things are really interested in what's going
3027 -- on during recompilation checking, so in those cases we
3028 -- don't want to turn it off.
3029 want_recomp = dump_flag `notElem` [Opt_D_dump_if_trace,
3030 Opt_D_dump_hi_diffs]
3031
3032 forceRecompile :: DynP ()
3033 -- Whenver we -ddump, force recompilation (by switching off the
3034 -- recompilation checker), else you don't see the dump! However,
3035 -- don't switch it off in --make mode, else *everything* gets
3036 -- recompiled which probably isn't what you want
3037 forceRecompile = do dfs <- liftEwM getCmdLineState
3038 when (force_recomp dfs) (setGeneralFlag Opt_ForceRecomp)
3039 where
3040 force_recomp dfs = isOneShot (ghcMode dfs)
3041
3042 setVerboseCore2Core :: DynP ()
3043 setVerboseCore2Core = do setDumpFlag' Opt_D_verbose_core2core
3044 upd (\dfs -> dfs { shouldDumpSimplPhase = Nothing })
3045
3046 setDumpSimplPhases :: String -> DynP ()
3047 setDumpSimplPhases s = do forceRecompile
3048 upd (\dfs -> dfs { shouldDumpSimplPhase = Just spec })
3049 where
3050 spec = case s of { ('=' : s') -> s'; _ -> s }
3051
3052 setVerbosity :: Maybe Int -> DynP ()
3053 setVerbosity mb_n = upd (\dfs -> dfs{ verbosity = mb_n `orElse` 3 })
3054
3055 addCmdlineHCInclude :: String -> DynP ()
3056 addCmdlineHCInclude a = upd (\s -> s{cmdlineHcIncludes = a : cmdlineHcIncludes s})
3057
3058 data PkgConfRef
3059 = GlobalPkgConf
3060 | UserPkgConf
3061 | PkgConfFile FilePath
3062
3063 addPkgConfRef :: PkgConfRef -> DynP ()
3064 addPkgConfRef p = upd $ \s -> s { extraPkgConfs = (p:) . extraPkgConfs s }
3065
3066 removeUserPkgConf :: DynP ()
3067 removeUserPkgConf = upd $ \s -> s { extraPkgConfs = filter isNotUser . extraPkgConfs s }
3068 where
3069 isNotUser UserPkgConf = False
3070 isNotUser _ = True
3071
3072 removeGlobalPkgConf :: DynP ()
3073 removeGlobalPkgConf = upd $ \s -> s { extraPkgConfs = filter isNotGlobal . extraPkgConfs s }
3074 where
3075 isNotGlobal GlobalPkgConf = False
3076 isNotGlobal _ = True
3077
3078 clearPkgConf :: DynP ()
3079 clearPkgConf = upd $ \s -> s { extraPkgConfs = const [] }
3080
3081 exposePackage, exposePackageId, hidePackage, ignorePackage,
3082 trustPackage, distrustPackage :: String -> DynP ()
3083 exposePackage p = upd (exposePackage' p)
3084 exposePackageId p =
3085 upd (\s -> s{ packageFlags = ExposePackageId p : packageFlags s })
3086 hidePackage p =
3087 upd (\s -> s{ packageFlags = HidePackage p : packageFlags s })
3088 ignorePackage p =
3089 upd (\s -> s{ packageFlags = IgnorePackage p : packageFlags s })
3090 trustPackage p = exposePackage p >> -- both trust and distrust also expose a package
3091 upd (\s -> s{ packageFlags = TrustPackage p : packageFlags s })
3092 distrustPackage p = exposePackage p >>
3093 upd (\s -> s{ packageFlags = DistrustPackage p : packageFlags s })
3094
3095 exposePackage' :: String -> DynFlags -> DynFlags
3096 exposePackage' p dflags
3097 = dflags { packageFlags = ExposePackage p : packageFlags dflags }
3098
3099 setPackageName :: String -> DynFlags -> DynFlags
3100 setPackageName p s = s{ thisPackage = stringToPackageId p }
3101
3102 -- If we're linking a binary, then only targets that produce object
3103 -- code are allowed (requests for other target types are ignored).
3104 setTarget :: HscTarget -> DynP ()
3105 setTarget l = setTargetWithPlatform (const l)
3106
3107 setTargetWithPlatform :: (Platform -> HscTarget) -> DynP ()
3108 setTargetWithPlatform f = upd set
3109 where
3110 set dfs = let l = f (targetPlatform dfs)
3111 in if ghcLink dfs /= LinkBinary || isObjectTarget l
3112 then dfs{ hscTarget = l }
3113 else dfs
3114
3115 -- Changes the target only if we're compiling object code. This is
3116 -- used by -fasm and -fllvm, which switch from one to the other, but
3117 -- not from bytecode to object-code. The idea is that -fasm/-fllvm
3118 -- can be safely used in an OPTIONS_GHC pragma.
3119 setObjTarget :: HscTarget -> DynP ()
3120 setObjTarget l = updM set
3121 where
3122 set dflags
3123 | isObjectTarget (hscTarget dflags)
3124 = return $ dflags { hscTarget = l }
3125 | otherwise = return dflags
3126
3127 setOptLevel :: Int -> DynFlags -> DynP DynFlags
3128 setOptLevel n dflags
3129 | hscTarget dflags == HscInterpreted && n > 0
3130 = do addWarn "-O conflicts with --interactive; -O ignored."
3131 return dflags
3132 | otherwise
3133 = return (updOptLevel n dflags)
3134
3135
3136 -- -Odph is equivalent to
3137 --
3138 -- -O2 optimise as much as possible
3139 -- -fmax-simplifier-iterations20 this is necessary sometimes
3140 -- -fsimplifier-phases=3 we use an additional simplifier phase for fusion
3141 --
3142 setDPHOpt :: DynFlags -> DynP DynFlags
3143 setDPHOpt dflags = setOptLevel 2 (dflags { maxSimplIterations = 20
3144 , simplPhases = 3
3145 })
3146
3147 setMainIs :: String -> DynP ()
3148 setMainIs arg
3149 | not (null main_fn) && isLower (head main_fn)
3150 -- The arg looked like "Foo.Bar.baz"
3151 = upd $ \d -> d{ mainFunIs = Just main_fn,
3152 mainModIs = mkModule mainPackageId (mkModuleName main_mod) }
3153
3154 | isUpper (head arg) -- The arg looked like "Foo" or "Foo.Bar"
3155 = upd $ \d -> d{ mainModIs = mkModule mainPackageId (mkModuleName arg) }
3156
3157 | otherwise -- The arg looked like "baz"
3158 = upd $ \d -> d{ mainFunIs = Just arg }
3159 where
3160 (main_mod, main_fn) = splitLongestPrefix arg (== '.')
3161
3162 -----------------------------------------------------------------------------
3163 -- Paths & Libraries
3164
3165 addImportPath, addLibraryPath, addIncludePath, addFrameworkPath :: FilePath -> DynP ()
3166
3167 -- -i on its own deletes the import paths
3168 addImportPath "" = upd (\s -> s{importPaths = []})
3169 addImportPath p = upd (\s -> s{importPaths = importPaths s ++ splitPathList p})
3170
3171 addLibraryPath p =
3172 upd (\s -> s{libraryPaths = libraryPaths s ++ splitPathList p})
3173
3174 addIncludePath p =
3175 upd (\s -> s{includePaths = includePaths s ++ splitPathList p})
3176
3177 addFrameworkPath p =
3178 upd (\s -> s{frameworkPaths = frameworkPaths s ++ splitPathList p})
3179
3180 #ifndef mingw32_TARGET_OS
3181 split_marker :: Char
3182 split_marker = ':' -- not configurable (ToDo)
3183 #endif
3184
3185 splitPathList :: String -> [String]
3186 splitPathList s = filter notNull (splitUp s)
3187 -- empty paths are ignored: there might be a trailing
3188 -- ':' in the initial list, for example. Empty paths can
3189 -- cause confusion when they are translated into -I options
3190 -- for passing to gcc.
3191 where
3192 #ifndef mingw32_TARGET_OS
3193 splitUp xs = split split_marker xs
3194 #else
3195 -- Windows: 'hybrid' support for DOS-style paths in directory lists.
3196 --
3197 -- That is, if "foo:bar:baz" is used, this interpreted as
3198 -- consisting of three entries, 'foo', 'bar', 'baz'.
3199 -- However, with "c:/foo:c:\\foo;x:/bar", this is interpreted
3200 -- as 3 elts, "c:/foo", "c:\\foo", "x:/bar"
3201 --
3202 -- Notice that no attempt is made to fully replace the 'standard'
3203 -- split marker ':' with the Windows / DOS one, ';'. The reason being
3204 -- that this will cause too much breakage for users & ':' will
3205 -- work fine even with DOS paths, if you're not insisting on being silly.
3206 -- So, use either.
3207 splitUp [] = []
3208 splitUp (x:':':div:xs) | div `elem` dir_markers
3209 = ((x:':':div:p): splitUp rs)
3210 where
3211 (p,rs) = findNextPath xs
3212 -- we used to check for existence of the path here, but that
3213 -- required the IO monad to be threaded through the command-line
3214 -- parser which is quite inconvenient. The
3215 splitUp xs = cons p (splitUp rs)
3216 where
3217 (p,rs) = findNextPath xs
3218
3219 cons "" xs = xs
3220 cons x xs = x:xs
3221
3222 -- will be called either when we've consumed nought or the
3223 -- "<Drive>:/" part of a DOS path, so splitting is just a Q of
3224 -- finding the next split marker.
3225 findNextPath xs =
3226 case break (`elem` split_markers) xs of
3227 (p, _:ds) -> (p, ds)
3228 (p, xs) -> (p, xs)
3229
3230 split_markers :: [Char]
3231 split_markers = [':', ';']
3232
3233 dir_markers :: [Char]
3234 dir_markers = ['/', '\\']
3235 #endif
3236
3237 -- -----------------------------------------------------------------------------
3238 -- tmpDir, where we store temporary files.
3239
3240 setTmpDir :: FilePath -> DynFlags -> DynFlags
3241 setTmpDir dir = alterSettings (\s -> s { sTmpDir = normalise dir })
3242 -- we used to fix /cygdrive/c/.. on Windows, but this doesn't
3243 -- seem necessary now --SDM 7/2/2008
3244
3245 -----------------------------------------------------------------------------
3246 -- RTS opts
3247
3248 setRtsOpts :: String -> DynP ()
3249 setRtsOpts arg = upd $ \ d -> d {rtsOpts = Just arg}
3250
3251 setRtsOptsEnabled :: RtsOptsEnabled -> DynP ()
3252 setRtsOptsEnabled arg = upd $ \ d -> d {rtsOptsEnabled = arg}
3253
3254 -----------------------------------------------------------------------------
3255 -- Hpc stuff
3256
3257 setOptHpcDir :: String -> DynP ()
3258 setOptHpcDir arg = upd $ \ d -> d{hpcDir = arg}
3259
3260 -----------------------------------------------------------------------------
3261 -- Via-C compilation stuff
3262
3263 -- There are some options that we need to pass to gcc when compiling
3264 -- Haskell code via C, but are only supported by recent versions of
3265 -- gcc. The configure script decides which of these options we need,
3266 -- and puts them in the "settings" file in $topdir. The advantage of
3267 -- having these in a separate file is that the file can be created at
3268 -- install-time depending on the available gcc version, and even
3269 -- re-generated later if gcc is upgraded.
3270 --
3271 -- The options below are not dependent on the version of gcc, only the
3272 -- platform.
3273
3274 picCCOpts :: DynFlags -> [String]
3275 picCCOpts dflags
3276 = case platformOS (targetPlatform dflags) of
3277 OSDarwin
3278 -- Apple prefers to do things the other way round.
3279 -- PIC is on by default.
3280 -- -mdynamic-no-pic:
3281 -- Turn off PIC code generation.
3282 -- -fno-common:
3283 -- Don't generate "common" symbols - these are unwanted
3284 -- in dynamic libraries.
3285
3286 | gopt Opt_PIC dflags -> ["-fno-common", "-U __PIC__", "-D__PIC__"]
3287 | otherwise -> ["-mdynamic-no-pic"]
3288 OSMinGW32 -- no -fPIC for Windows
3289 | gopt Opt_PIC dflags -> ["-U __PIC__", "-D__PIC__"]
3290 | otherwise -> []
3291 _
3292 -- we need -fPIC for C files when we are compiling with -dynamic,
3293 -- otherwise things like stub.c files don't get compiled
3294 -- correctly. They need to reference data in the Haskell
3295 -- objects, but can't without -fPIC. See
3296 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/PositionIndependentCode
3297 | gopt Opt_PIC dflags || not (gopt Opt_Static dflags) ->
3298 ["-fPIC", "-U __PIC__", "-D__PIC__"]
3299 | otherwise -> []
3300
3301 picPOpts :: DynFlags -> [String]
3302 picPOpts dflags
3303 | gopt Opt_PIC dflags = ["-U __PIC__", "-D__PIC__"]
3304 | otherwise = []
3305
3306 -- -----------------------------------------------------------------------------
3307 -- Splitting
3308
3309 can_split :: Bool
3310 can_split = cSupportsSplitObjs == "YES"
3311
3312 -- -----------------------------------------------------------------------------
3313 -- Compiler Info
3314
3315 compilerInfo :: DynFlags -> [(String, String)]
3316 compilerInfo dflags
3317 = -- We always make "Project name" be first to keep parsing in
3318 -- other languages simple, i.e. when looking for other fields,
3319 -- you don't have to worry whether there is a leading '[' or not
3320 ("Project name", cProjectName)
3321 -- Next come the settings, so anything else can be overridden
3322 -- in the settings file (as "lookup" uses the first match for the
3323 -- key)
3324 : rawSettings dflags
3325 ++ [("Project version", cProjectVersion),
3326 ("Booter version", cBooterVersion),
3327 ("Stage", cStage),
3328 ("Build platform", cBuildPlatformString),
3329 ("Host platform", cHostPlatformString),
3330 ("Target platform", cTargetPlatformString),
3331 ("Have interpreter", cGhcWithInterpreter),
3332 ("Object splitting supported", cSupportsSplitObjs),
3333 ("Have native code generator", cGhcWithNativeCodeGen),
3334 ("Support SMP", cGhcWithSMP),
3335 ("Tables next to code", cGhcEnableTablesNextToCode),
3336 ("RTS ways", cGhcRTSWays),
3337 ("Dynamic by default", if dYNAMIC_BY_DEFAULT dflags
3338 then "YES" else "NO"),
3339 ("Leading underscore", cLeadingUnderscore),
3340 ("Debug on", show debugIsOn),
3341 ("LibDir", topDir dflags),
3342 ("Global Package DB", systemPackageConfig dflags)
3343 ]
3344
3345 #include "../includes/dist-derivedconstants/header/GHCConstantsHaskellWrappers.hs"
3346
3347 bLOCK_SIZE_W :: DynFlags -> Int
3348 bLOCK_SIZE_W dflags = bLOCK_SIZE dflags `quot` wORD_SIZE dflags
3349
3350 wORD_SIZE_IN_BITS :: DynFlags -> Int
3351 wORD_SIZE_IN_BITS dflags = wORD_SIZE dflags * 8
3352
3353 tAG_MASK :: DynFlags -> Int
3354 tAG_MASK dflags = (1 `shiftL` tAG_BITS dflags) - 1
3355
3356 mAX_PTR_TAG :: DynFlags -> Int
3357 mAX_PTR_TAG = tAG_MASK
3358
3359 -- Might be worth caching these in targetPlatform?
3360 tARGET_MIN_INT, tARGET_MAX_INT, tARGET_MAX_WORD :: DynFlags -> Integer
3361 tARGET_MIN_INT dflags
3362 = case platformWordSize (targetPlatform dflags) of
3363 4 -> toInteger (minBound :: Int32)
3364 8 -> toInteger (minBound :: Int64)
3365 w -> panic ("tARGET_MIN_INT: Unknown platformWordSize: " ++ show w)
3366 tARGET_MAX_INT dflags
3367 = case platformWordSize (targetPlatform dflags) of
3368 4 -> toInteger (maxBound :: Int32)
3369 8 -> toInteger (maxBound :: Int64)
3370 w -> panic ("tARGET_MAX_INT: Unknown platformWordSize: " ++ show w)
3371 tARGET_MAX_WORD dflags
3372 = case platformWordSize (targetPlatform dflags) of
3373 4 -> toInteger (maxBound :: Word32)
3374 8 -> toInteger (maxBound :: Word64)
3375 w -> panic ("tARGET_MAX_WORD: Unknown platformWordSize: " ++ show w)
3376
3377 -- Whenever makeDynFlagsConsistent does anything, it starts over, to
3378 -- ensure that a later change doesn't invalidate an earlier check.
3379 -- Be careful not to introduce potential loops!
3380 makeDynFlagsConsistent :: DynFlags -> (DynFlags, [Located String])
3381 makeDynFlagsConsistent dflags
3382 | hscTarget dflags == HscC &&
3383 not (platformUnregisterised (targetPlatform dflags))
3384 = if cGhcWithNativeCodeGen == "YES"
3385 then let dflags' = dflags { hscTarget = HscAsm }
3386 warn = "Compiler not unregisterised, so using native code generator rather than compiling via C"
3387 in loop dflags' warn
3388 else let dflags' = dflags { hscTarget = HscLlvm }
3389 warn = "Compiler not unregisterised, so using LLVM rather than compiling via C"
3390 in loop dflags' warn
3391 | hscTarget dflags /= HscC && hscTarget dflags /= HscLlvm &&
3392 platformUnregisterised (targetPlatform dflags)
3393 = loop (dflags { hscTarget = HscC })
3394 "Compiler unregisterised, so compiling via C"
3395 | hscTarget dflags == HscAsm &&
3396 cGhcWithNativeCodeGen /= "YES"
3397 = let dflags' = dflags { hscTarget = HscLlvm }
3398 warn = "No native code generator, so using LLVM"
3399 in loop dflags' warn
3400 | hscTarget dflags == HscLlvm &&
3401 not ((arch == ArchX86_64) && (os == OSLinux || os == OSDarwin)) &&
3402 (not (gopt Opt_Static dflags) || gopt Opt_PIC dflags)
3403 = if cGhcWithNativeCodeGen == "YES"
3404 then let dflags' = dflags { hscTarget = HscAsm }
3405 warn = "Using native code generator rather than LLVM, as LLVM is incompatible with -fPIC and -dynamic on this platform"
3406 in loop dflags' warn
3407 else throwGhcException $ CmdLineError "Can't use -fPIC or -dynamic on this platform"
3408 | os == OSDarwin &&
3409 arch == ArchX86_64 &&
3410 not (gopt Opt_PIC dflags)
3411 = loop (gopt_set dflags Opt_PIC)
3412 "Enabling -fPIC as it is always on for this platform"
3413 | otherwise = (dflags, [])
3414 where loc = mkGeneralSrcSpan (fsLit "when making flags consistent")
3415 loop updated_dflags warning
3416 = case makeDynFlagsConsistent updated_dflags of
3417 (dflags', ws) -> (dflags', L loc warning : ws)
3418 platform = targetPlatform dflags
3419 arch = platformArch platform
3420 os = platformOS platform
3421
3422 --------------------------------------------------------------------------
3423 -- Do not use unsafeGlobalDynFlags!
3424 --
3425 -- unsafeGlobalDynFlags is a hack, necessary because we need to be able
3426 -- to show SDocs when tracing, but we don't always have DynFlags
3427 -- available.
3428 --
3429 -- Do not use it if you can help it. You may get the wrong value!
3430
3431 GLOBAL_VAR(v_unsafeGlobalDynFlags, panic "v_unsafeGlobalDynFlags: not initialised", DynFlags)
3432
3433 unsafeGlobalDynFlags :: DynFlags
3434 unsafeGlobalDynFlags = unsafePerformIO $ readIORef v_unsafeGlobalDynFlags
3435
3436 setUnsafeGlobalDynFlags :: DynFlags -> IO ()
3437 setUnsafeGlobalDynFlags = writeIORef v_unsafeGlobalDynFlags
3438
3439 -- -----------------------------------------------------------------------------
3440 -- SSE
3441
3442 -- TODO: Instead of using a separate predicate (i.e. isSse2Enabled) to
3443 -- check if SSE is enabled, we might have x86-64 imply the -msse2
3444 -- flag.
3445
3446 isSse2Enabled :: DynFlags -> Bool
3447 isSse2Enabled dflags = case platformArch (targetPlatform dflags) of
3448 ArchX86_64 -> -- SSE2 is fixed on for x86_64. It would be
3449 -- possible to make it optional, but we'd need to
3450 -- fix at least the foreign call code where the
3451 -- calling convention specifies the use of xmm regs,
3452 -- and possibly other places.
3453 True
3454 ArchX86 -> sseVersion dflags >= Just (2,0)
3455 _ -> False
3456
3457 isSse4_2Enabled :: DynFlags -> Bool
3458 isSse4_2Enabled dflags = sseVersion dflags >= Just (4,2)