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