1{-# LANGUAGE DeriveGeneric #-} 2{-# LANGUAGE FlexibleContexts #-} 3{-# LANGUAGE RankNTypes #-} 4{-# LANGUAGE RecordWildCards #-} 5{-# LANGUAGE ScopedTypeVariables #-} 6 7module Distribution.Simple.Program.GHC ( 8 GhcOptions(..), 9 GhcMode(..), 10 GhcOptimisation(..), 11 GhcDynLinkMode(..), 12 GhcProfAuto(..), 13 14 ghcInvocation, 15 renderGhcOptions, 16 17 runGHC, 18 19 packageDbArgsDb, 20 normaliseGhcArgs 21 22 ) where 23 24import Prelude () 25import Distribution.Compat.Prelude 26 27import Distribution.Backpack 28import Distribution.Compat.Semigroup (First'(..), Last'(..), Option'(..)) 29import Distribution.Simple.GHC.ImplInfo 30import Distribution.PackageDescription 31import Distribution.ModuleName 32import Distribution.Simple.Compiler 33import Distribution.Simple.Flag 34import Distribution.Simple.Program.Types 35import Distribution.Simple.Program.Run 36import Distribution.System 37import Distribution.Pretty 38import Distribution.Types.ComponentId 39import Distribution.Verbosity 40import Distribution.Version 41import Distribution.Utils.NubList 42import Language.Haskell.Extension 43 44import Data.List (stripPrefix) 45import qualified Data.Map as Map 46import Data.Monoid (All(..), Any(..), Endo(..)) 47import qualified Data.Set as Set 48 49normaliseGhcArgs :: Maybe Version -> PackageDescription -> [String] -> [String] 50normaliseGhcArgs (Just ghcVersion) PackageDescription{..} ghcArgs 51 | ghcVersion `withinRange` supportedGHCVersions 52 = argumentFilters . filter simpleFilters . filterRtsOpts $ ghcArgs 53 where 54 supportedGHCVersions :: VersionRange 55 supportedGHCVersions = intersectVersionRanges 56 (orLaterVersion (mkVersion [8,0])) 57 (earlierVersion (mkVersion [9,1])) 58 59 from :: Monoid m => [Int] -> m -> m 60 from version flags 61 | ghcVersion `withinRange` orLaterVersion (mkVersion version) = flags 62 | otherwise = mempty 63 64 to :: Monoid m => [Int] -> m -> m 65 to version flags 66 | ghcVersion `withinRange` earlierVersion (mkVersion version) = flags 67 | otherwise = mempty 68 69 checkGhcFlags :: forall m . Monoid m => ([String] -> m) -> m 70 checkGhcFlags fun = mconcat 71 [ fun ghcArgs 72 , checkComponentFlags libBuildInfo pkgLibs 73 , checkComponentFlags buildInfo executables 74 , checkComponentFlags testBuildInfo testSuites 75 , checkComponentFlags benchmarkBuildInfo benchmarks 76 ] 77 where 78 pkgLibs = maybeToList library ++ subLibraries 79 80 checkComponentFlags :: (a -> BuildInfo) -> [a] -> m 81 checkComponentFlags getInfo = foldMap (checkComponent . getInfo) 82 where 83 checkComponent :: BuildInfo -> m 84 checkComponent = foldMap fun . filterGhcOptions . allGhcOptions 85 86 allGhcOptions :: BuildInfo -> [(CompilerFlavor, [String])] 87 allGhcOptions = foldMap (perCompilerFlavorToList .) 88 [options, profOptions, sharedOptions, staticOptions] 89 90 filterGhcOptions :: [(CompilerFlavor, [String])] -> [[String]] 91 filterGhcOptions l = [opts | (GHC, opts) <- l] 92 93 safeToFilterWarnings :: Bool 94 safeToFilterWarnings = getAll $ checkGhcFlags checkWarnings 95 where 96 checkWarnings :: [String] -> All 97 checkWarnings = All . Set.null . foldr alter Set.empty 98 99 alter :: String -> Set String -> Set String 100 alter flag = appEndo $ mconcat 101 [ \s -> Endo $ if s == "-Werror" then Set.insert s else id 102 , \s -> Endo $ if s == "-Wwarn" then const Set.empty else id 103 , \s -> from [8,6] . Endo $ 104 if s == "-Werror=compat" 105 then Set.union compatWarningSet else id 106 , \s -> from [8,6] . Endo $ 107 if s == "-Wno-error=compat" 108 then (`Set.difference` compatWarningSet) else id 109 , \s -> from [8,6] . Endo $ 110 if s == "-Wwarn=compat" 111 then (`Set.difference` compatWarningSet) else id 112 , from [8,4] $ markFlag "-Werror=" Set.insert 113 , from [8,4] $ markFlag "-Wwarn=" Set.delete 114 , from [8,4] $ markFlag "-Wno-error=" Set.delete 115 ] flag 116 117 markFlag 118 :: String 119 -> (String -> Set String -> Set String) 120 -> String 121 -> Endo (Set String) 122 markFlag name update flag = Endo $ case stripPrefix name flag of 123 Just rest | not (null rest) && rest /= "compat" -> update rest 124 _ -> id 125 126 flagArgumentFilter :: [String] -> [String] -> [String] 127 flagArgumentFilter flags = go 128 where 129 makeFilter :: String -> String -> Option' (First' ([String] -> [String])) 130 makeFilter flag arg = Option' $ First' . filterRest <$> stripPrefix flag arg 131 where 132 filterRest leftOver = case dropEq leftOver of 133 [] -> drop 1 134 _ -> id 135 136 checkFilter :: String -> Maybe ([String] -> [String]) 137 checkFilter = fmap getFirst' . getOption' . foldMap makeFilter flags 138 139 go :: [String] -> [String] 140 go [] = [] 141 go (arg:args) = case checkFilter arg of 142 Just f -> go (f args) 143 Nothing -> arg : go args 144 145 argumentFilters :: [String] -> [String] 146 argumentFilters = flagArgumentFilter 147 ["-ghci-script", "-H", "-interactive-print"] 148 149 filterRtsOpts :: [String] -> [String] 150 filterRtsOpts = go False 151 where 152 go :: Bool -> [String] -> [String] 153 go _ [] = [] 154 go _ ("+RTS":opts) = go True opts 155 go _ ("-RTS":opts) = go False opts 156 go isRTSopts (opt:opts) = addOpt $ go isRTSopts opts 157 where 158 addOpt | isRTSopts = id 159 | otherwise = (opt:) 160 161 simpleFilters :: String -> Bool 162 simpleFilters = not . getAny . mconcat 163 [ flagIn simpleFlags 164 , Any . isPrefixOf "-ddump-" 165 , Any . isPrefixOf "-dsuppress-" 166 , Any . isPrefixOf "-dno-suppress-" 167 , flagIn $ invertibleFlagSet "-" ["ignore-dot-ghci"] 168 , flagIn . invertibleFlagSet "-f" . mconcat $ 169 [ [ "reverse-errors", "warn-unused-binds", "break-on-error" 170 , "break-on-exception", "print-bind-result" 171 , "print-bind-contents", "print-evld-with-show" 172 , "implicit-import-qualified", "error-spans" 173 ] 174 , from [7,8] 175 [ "print-explicit-foralls" -- maybe also earlier, but GHC-7.6 doesn't have --show-options 176 , "print-explicit-kinds" 177 ] 178 , from [8,0] 179 [ "print-explicit-coercions" 180 , "print-explicit-runtime-reps" 181 , "print-equality-relations" 182 , "print-unicode-syntax" 183 , "print-expanded-synonyms" 184 , "print-potential-instances" 185 , "print-typechecker-elaboration" 186 ] 187 , from [8,2] 188 [ "diagnostics-show-caret", "local-ghci-history" 189 , "show-warning-groups", "hide-source-paths" 190 , "show-hole-constraints" 191 ] 192 , from [8,4] ["show-loaded-modules"] 193 , from [8,6] [ "ghci-leak-check", "no-it" ] 194 , from [8,10] 195 [ "defer-diagnostics" -- affects printing of diagnostics 196 , "keep-going" -- try harder, the build will still fail if it's erroneous 197 , "print-axiom-incomps" -- print more debug info for closed type families 198 ] 199 ] 200 , flagIn . invertibleFlagSet "-d" $ [ "ppr-case-as-let", "ppr-ticks" ] 201 , isOptIntFlag 202 , isIntFlag 203 , if safeToFilterWarnings 204 then isWarning <> (Any . ("-w"==)) 205 else mempty 206 , from [8,6] $ 207 if safeToFilterHoles 208 then isTypedHoleFlag 209 else mempty 210 ] 211 212 flagIn :: Set String -> String -> Any 213 flagIn set flag = Any $ Set.member flag set 214 215 isWarning :: String -> Any 216 isWarning = mconcat $ map ((Any .) . isPrefixOf) 217 ["-fwarn-", "-fno-warn-", "-W", "-Wno-"] 218 219 simpleFlags :: Set String 220 simpleFlags = Set.fromList . mconcat $ 221 [ [ "-n", "-#include", "-Rghc-timing", "-dstg-stats" 222 , "-dth-dec-file", "-dsource-stats", "-dverbose-core2core" 223 , "-dverbose-stg2stg", "-dcore-lint", "-dstg-lint", "-dcmm-lint" 224 , "-dasm-lint", "-dannot-lint", "-dshow-passes", "-dfaststring-stats" 225 , "-fno-max-relevant-binds", "-recomp", "-no-recomp", "-fforce-recomp" 226 , "-fno-force-recomp" 227 ] 228 229 , from [8,2] 230 [ "-fno-max-errors", "-fdiagnostics-color=auto" 231 , "-fdiagnostics-color=always", "-fdiagnostics-color=never" 232 , "-dppr-debug", "-dno-debug-output" 233 ] 234 235 , from [8,4] [ "-ddebug-output" ] 236 , from [8,4] $ to [8,6] [ "-fno-max-valid-substitutions" ] 237 , from [8,6] [ "-dhex-word-literals" ] 238 , from [8,8] [ "-fshow-docs-of-hole-fits", "-fno-show-docs-of-hole-fits" ] 239 , from [9,0] [ "-dlinear-core-lint" ] 240 ] 241 242 isOptIntFlag :: String -> Any 243 isOptIntFlag = mconcat . map (dropIntFlag True) $ ["-v", "-j"] 244 245 isIntFlag :: String -> Any 246 isIntFlag = mconcat . map (dropIntFlag False) . mconcat $ 247 [ [ "-fmax-relevant-binds", "-ddpr-user-length", "-ddpr-cols" 248 , "-dtrace-level", "-fghci-hist-size" ] 249 , from [8,2] ["-fmax-uncovered-patterns", "-fmax-errors"] 250 , from [8,4] $ to [8,6] ["-fmax-valid-substitutions"] 251 ] 252 253 dropIntFlag :: Bool -> String -> String -> Any 254 dropIntFlag isOpt flag input = Any $ case stripPrefix flag input of 255 Nothing -> False 256 Just rest | isOpt && null rest -> True 257 | otherwise -> case parseInt rest of 258 Just _ -> True 259 Nothing -> False 260 where 261 parseInt :: String -> Maybe Int 262 parseInt = readMaybe . dropEq 263 264 dropEq :: String -> String 265 dropEq ('=':s) = s 266 dropEq s = s 267 268 invertibleFlagSet :: String -> [String] -> Set String 269 invertibleFlagSet prefix flagNames = 270 Set.fromList $ (++) <$> [prefix, prefix ++ "no-"] <*> flagNames 271 272 compatWarningSet :: Set String 273 compatWarningSet = Set.fromList $ mconcat 274 [ from [8,6] 275 [ "missing-monadfail-instances", "semigroup" 276 , "noncanonical-monoid-instances", "implicit-kind-vars" ] 277 ] 278 279 safeToFilterHoles :: Bool 280 safeToFilterHoles = getAll . checkGhcFlags $ 281 All . fromMaybe True . fmap getLast' . getOption' . foldMap notDeferred 282 where 283 notDeferred :: String -> Option' (Last' Bool) 284 notDeferred "-fdefer-typed-holes" = Option' . Just . Last' $ False 285 notDeferred "-fno-defer-typed-holes" = Option' . Just . Last' $ True 286 notDeferred _ = Option' Nothing 287 288 isTypedHoleFlag :: String -> Any 289 isTypedHoleFlag = mconcat 290 [ flagIn . invertibleFlagSet "-f" $ 291 [ "show-hole-constraints", "show-valid-substitutions" 292 , "show-valid-hole-fits", "sort-valid-hole-fits" 293 , "sort-by-size-hole-fits", "sort-by-subsumption-hole-fits" 294 , "abstract-refinement-hole-fits", "show-provenance-of-hole-fits" 295 , "show-hole-matches-of-hole-fits", "show-type-of-hole-fits" 296 , "show-type-app-of-hole-fits", "show-type-app-vars-of-hole-fits" 297 , "unclutter-valid-hole-fits" 298 ] 299 , flagIn . Set.fromList $ 300 [ "-fno-max-valid-hole-fits", "-fno-max-refinement-hole-fits" 301 , "-fno-refinement-level-hole-fits" ] 302 , mconcat . map (dropIntFlag False) $ 303 [ "-fmax-valid-hole-fits", "-fmax-refinement-hole-fits" 304 , "-frefinement-level-hole-fits" ] 305 ] 306 307normaliseGhcArgs _ _ args = args 308 309-- | A structured set of GHC options/flags 310-- 311-- Note that options containing lists fall into two categories: 312-- 313-- * options that can be safely deduplicated, e.g. input modules or 314-- enabled extensions; 315-- * options that cannot be deduplicated in general without changing 316-- semantics, e.g. extra ghc options or linking options. 317data GhcOptions = GhcOptions { 318 319 -- | The major mode for the ghc invocation. 320 ghcOptMode :: Flag GhcMode, 321 322 -- | Any extra options to pass directly to ghc. These go at the end and hence 323 -- override other stuff. 324 ghcOptExtra :: [String], 325 326 -- | Extra default flags to pass directly to ghc. These go at the beginning 327 -- and so can be overridden by other stuff. 328 ghcOptExtraDefault :: [String], 329 330 ----------------------- 331 -- Inputs and outputs 332 333 -- | The main input files; could be .hs, .hi, .c, .o, depending on mode. 334 ghcOptInputFiles :: NubListR FilePath, 335 336 -- | The names of input Haskell modules, mainly for @--make@ mode. 337 ghcOptInputModules :: NubListR ModuleName, 338 339 -- | Location for output file; the @ghc -o@ flag. 340 ghcOptOutputFile :: Flag FilePath, 341 342 -- | Location for dynamic output file in 'GhcStaticAndDynamic' mode; 343 -- the @ghc -dyno@ flag. 344 ghcOptOutputDynFile :: Flag FilePath, 345 346 -- | Start with an empty search path for Haskell source files; 347 -- the @ghc -i@ flag (@-i@ on its own with no path argument). 348 ghcOptSourcePathClear :: Flag Bool, 349 350 -- | Search path for Haskell source files; the @ghc -i@ flag. 351 ghcOptSourcePath :: NubListR FilePath, 352 353 ------------- 354 -- Packages 355 356 -- | The unit ID the modules will belong to; the @ghc -this-unit-id@ 357 -- flag (or @-this-package-key@ or @-package-name@ on older 358 -- versions of GHC). This is a 'String' because we assume you've 359 -- already figured out what the correct format for this string is 360 -- (we need to handle backwards compatibility.) 361 ghcOptThisUnitId :: Flag String, 362 363 -- | GHC doesn't make any assumptions about the format of 364 -- definite unit ids, so when we are instantiating a package it 365 -- needs to be told explicitly what the component being instantiated 366 -- is. This only gets set when 'ghcOptInstantiatedWith' is non-empty 367 ghcOptThisComponentId :: Flag ComponentId, 368 369 -- | How the requirements of the package being compiled are to 370 -- be filled. When typechecking an indefinite package, the 'OpenModule' 371 -- is always a 'OpenModuleVar'; otherwise, it specifies the installed module 372 -- that instantiates a package. 373 ghcOptInstantiatedWith :: [(ModuleName, OpenModule)], 374 375 -- | No code? (But we turn on interface writing 376 ghcOptNoCode :: Flag Bool, 377 378 -- | GHC package databases to use, the @ghc -package-conf@ flag. 379 ghcOptPackageDBs :: PackageDBStack, 380 381 -- | The GHC packages to bring into scope when compiling, 382 -- the @ghc -package-id@ flags. 383 ghcOptPackages :: 384 NubListR (OpenUnitId, ModuleRenaming), 385 386 -- | Start with a clean package set; the @ghc -hide-all-packages@ flag 387 ghcOptHideAllPackages :: Flag Bool, 388 389 -- | Warn about modules, not listed in command line 390 ghcOptWarnMissingHomeModules :: Flag Bool, 391 392 -- | Don't automatically link in Haskell98 etc; the @ghc 393 -- -no-auto-link-packages@ flag. 394 ghcOptNoAutoLinkPackages :: Flag Bool, 395 396 ----------------- 397 -- Linker stuff 398 399 -- | Names of libraries to link in; the @ghc -l@ flag. 400 ghcOptLinkLibs :: [FilePath], 401 402 -- | Search path for libraries to link in; the @ghc -L@ flag. 403 ghcOptLinkLibPath :: NubListR FilePath, 404 405 -- | Options to pass through to the linker; the @ghc -optl@ flag. 406 ghcOptLinkOptions :: [String], 407 408 -- | OSX only: frameworks to link in; the @ghc -framework@ flag. 409 ghcOptLinkFrameworks :: NubListR String, 410 411 -- | OSX only: Search path for frameworks to link in; the 412 -- @ghc -framework-path@ flag. 413 ghcOptLinkFrameworkDirs :: NubListR String, 414 415 -- | Don't do the link step, useful in make mode; the @ghc -no-link@ flag. 416 ghcOptNoLink :: Flag Bool, 417 418 -- | Don't link in the normal RTS @main@ entry point; the @ghc -no-hs-main@ 419 -- flag. 420 ghcOptLinkNoHsMain :: Flag Bool, 421 422 -- | Module definition files (Windows specific) 423 ghcOptLinkModDefFiles :: NubListR FilePath, 424 425 -------------------- 426 -- C and CPP stuff 427 428 -- | Options to pass through to the C compiler; the @ghc -optc@ flag. 429 ghcOptCcOptions :: [String], 430 431 -- | Options to pass through to the C++ compiler. 432 ghcOptCxxOptions :: [String], 433 434 -- | Options to pass through to the Assembler. 435 ghcOptAsmOptions :: [String], 436 437 -- | Options to pass through to CPP; the @ghc -optP@ flag. 438 ghcOptCppOptions :: [String], 439 440 -- | Search path for CPP includes like header files; the @ghc -I@ flag. 441 ghcOptCppIncludePath :: NubListR FilePath, 442 443 -- | Extra header files to include at CPP stage; the @ghc -optP-include@ flag. 444 ghcOptCppIncludes :: NubListR FilePath, 445 446 -- | Extra header files to include for old-style FFI; the @ghc -#include@ flag. 447 ghcOptFfiIncludes :: NubListR FilePath, 448 449 ---------------------------- 450 -- Language and extensions 451 452 -- | The base language; the @ghc -XHaskell98@ or @-XHaskell2010@ flag. 453 ghcOptLanguage :: Flag Language, 454 455 -- | The language extensions; the @ghc -X@ flag. 456 ghcOptExtensions :: NubListR Extension, 457 458 -- | A GHC version-dependent mapping of extensions to flags. This must be 459 -- set to be able to make use of the 'ghcOptExtensions'. 460 ghcOptExtensionMap :: Map Extension (Maybe CompilerFlag), 461 462 ---------------- 463 -- Compilation 464 465 -- | What optimisation level to use; the @ghc -O@ flag. 466 ghcOptOptimisation :: Flag GhcOptimisation, 467 468 -- | Emit debug info; the @ghc -g@ flag. 469 ghcOptDebugInfo :: Flag DebugInfoLevel, 470 471 -- | Compile in profiling mode; the @ghc -prof@ flag. 472 ghcOptProfilingMode :: Flag Bool, 473 474 -- | Automatically add profiling cost centers; the @ghc -fprof-auto*@ flags. 475 ghcOptProfilingAuto :: Flag GhcProfAuto, 476 477 -- | Use the \"split sections\" feature; the @ghc -split-sections@ flag. 478 ghcOptSplitSections :: Flag Bool, 479 480 -- | Use the \"split object files\" feature; the @ghc -split-objs@ flag. 481 ghcOptSplitObjs :: Flag Bool, 482 483 -- | Run N jobs simultaneously (if possible). 484 ghcOptNumJobs :: Flag (Maybe Int), 485 486 -- | Enable coverage analysis; the @ghc -fhpc -hpcdir@ flags. 487 ghcOptHPCDir :: Flag FilePath, 488 489 ---------------- 490 -- GHCi 491 492 -- | Extra GHCi startup scripts; the @-ghci-script@ flag 493 ghcOptGHCiScripts :: [FilePath], 494 495 ------------------------ 496 -- Redirecting outputs 497 498 ghcOptHiSuffix :: Flag String, 499 ghcOptObjSuffix :: Flag String, 500 ghcOptDynHiSuffix :: Flag String, -- ^ only in 'GhcStaticAndDynamic' mode 501 ghcOptDynObjSuffix :: Flag String, -- ^ only in 'GhcStaticAndDynamic' mode 502 ghcOptHiDir :: Flag FilePath, 503 ghcOptObjDir :: Flag FilePath, 504 ghcOptOutputDir :: Flag FilePath, 505 ghcOptStubDir :: Flag FilePath, 506 507 -------------------- 508 -- Creating libraries 509 510 ghcOptDynLinkMode :: Flag GhcDynLinkMode, 511 ghcOptStaticLib :: Flag Bool, 512 ghcOptShared :: Flag Bool, 513 ghcOptFPic :: Flag Bool, 514 ghcOptDylibName :: Flag String, 515 ghcOptRPaths :: NubListR FilePath, 516 517 --------------- 518 -- Misc flags 519 520 -- | Get GHC to be quiet or verbose with what it's doing; the @ghc -v@ flag. 521 ghcOptVerbosity :: Flag Verbosity, 522 523 -- | Put the extra folders in the PATH environment variable we invoke 524 -- GHC with 525 ghcOptExtraPath :: NubListR FilePath, 526 527 -- | Let GHC know that it is Cabal that's calling it. 528 -- Modifies some of the GHC error messages. 529 ghcOptCabal :: Flag Bool 530 531} deriving (Show, Generic) 532 533 534data GhcMode = GhcModeCompile -- ^ @ghc -c@ 535 | GhcModeLink -- ^ @ghc@ 536 | GhcModeMake -- ^ @ghc --make@ 537 | GhcModeInteractive -- ^ @ghci@ \/ @ghc --interactive@ 538 | GhcModeAbiHash -- ^ @ghc --abi-hash@ 539-- | GhcModeDepAnalysis -- ^ @ghc -M@ 540-- | GhcModeEvaluate -- ^ @ghc -e@ 541 deriving (Show, Eq) 542 543data GhcOptimisation = GhcNoOptimisation -- ^ @-O0@ 544 | GhcNormalOptimisation -- ^ @-O@ 545 | GhcMaximumOptimisation -- ^ @-O2@ 546 | GhcSpecialOptimisation String -- ^ e.g. @-Odph@ 547 deriving (Show, Eq) 548 549data GhcDynLinkMode = GhcStaticOnly -- ^ @-static@ 550 | GhcDynamicOnly -- ^ @-dynamic@ 551 | GhcStaticAndDynamic -- ^ @-static -dynamic-too@ 552 deriving (Show, Eq) 553 554data GhcProfAuto = GhcProfAutoAll -- ^ @-fprof-auto@ 555 | GhcProfAutoToplevel -- ^ @-fprof-auto-top@ 556 | GhcProfAutoExported -- ^ @-fprof-auto-exported@ 557 deriving (Show, Eq) 558 559runGHC :: Verbosity -> ConfiguredProgram -> Compiler -> Platform -> GhcOptions 560 -> IO () 561runGHC verbosity ghcProg comp platform opts = do 562 runProgramInvocation verbosity (ghcInvocation ghcProg comp platform opts) 563 564 565ghcInvocation :: ConfiguredProgram -> Compiler -> Platform -> GhcOptions 566 -> ProgramInvocation 567ghcInvocation prog comp platform opts = 568 (programInvocation prog (renderGhcOptions comp platform opts)) { 569 progInvokePathEnv = fromNubListR (ghcOptExtraPath opts) 570 } 571 572renderGhcOptions :: Compiler -> Platform -> GhcOptions -> [String] 573renderGhcOptions comp _platform@(Platform _arch os) opts 574 | compilerFlavor comp `notElem` [GHC, GHCJS] = 575 error $ "Distribution.Simple.Program.GHC.renderGhcOptions: " 576 ++ "compiler flavor must be 'GHC' or 'GHCJS'!" 577 | otherwise = 578 concat 579 [ case flagToMaybe (ghcOptMode opts) of 580 Nothing -> [] 581 Just GhcModeCompile -> ["-c"] 582 Just GhcModeLink -> [] 583 Just GhcModeMake -> ["--make"] 584 Just GhcModeInteractive -> ["--interactive"] 585 Just GhcModeAbiHash -> ["--abi-hash"] 586-- Just GhcModeDepAnalysis -> ["-M"] 587-- Just GhcModeEvaluate -> ["-e", expr] 588 589 , ghcOptExtraDefault opts 590 591 , [ "-no-link" | flagBool ghcOptNoLink ] 592 593 --------------- 594 -- Misc flags 595 596 , maybe [] verbosityOpts (flagToMaybe (ghcOptVerbosity opts)) 597 598 , [ "-fbuilding-cabal-package" | flagBool ghcOptCabal ] 599 600 ---------------- 601 -- Compilation 602 603 , case flagToMaybe (ghcOptOptimisation opts) of 604 Nothing -> [] 605 Just GhcNoOptimisation -> ["-O0"] 606 Just GhcNormalOptimisation -> ["-O"] 607 Just GhcMaximumOptimisation -> ["-O2"] 608 Just (GhcSpecialOptimisation s) -> ["-O" ++ s] -- eg -Odph 609 610 , case flagToMaybe (ghcOptDebugInfo opts) of 611 Nothing -> [] 612 Just NoDebugInfo -> [] 613 Just MinimalDebugInfo -> ["-g1"] 614 Just NormalDebugInfo -> ["-g2"] 615 Just MaximalDebugInfo -> ["-g3"] 616 617 , [ "-prof" | flagBool ghcOptProfilingMode ] 618 619 , case flagToMaybe (ghcOptProfilingAuto opts) of 620 _ | not (flagBool ghcOptProfilingMode) 621 -> [] 622 Nothing -> [] 623 Just GhcProfAutoAll 624 | flagProfAuto implInfo -> ["-fprof-auto"] 625 | otherwise -> ["-auto-all"] -- not the same, but close 626 Just GhcProfAutoToplevel 627 | flagProfAuto implInfo -> ["-fprof-auto-top"] 628 | otherwise -> ["-auto-all"] 629 Just GhcProfAutoExported 630 | flagProfAuto implInfo -> ["-fprof-auto-exported"] 631 | otherwise -> ["-auto"] 632 633 , [ "-split-sections" | flagBool ghcOptSplitSections ] 634 , [ "-split-objs" | flagBool ghcOptSplitObjs ] 635 636 , case flagToMaybe (ghcOptHPCDir opts) of 637 Nothing -> [] 638 Just hpcdir -> ["-fhpc", "-hpcdir", hpcdir] 639 640 , if parmakeSupported comp 641 then case ghcOptNumJobs opts of 642 NoFlag -> [] 643 Flag n -> ["-j" ++ maybe "" show n] 644 else [] 645 646 -------------------- 647 -- Creating libraries 648 649 , [ "-staticlib" | flagBool ghcOptStaticLib ] 650 , [ "-shared" | flagBool ghcOptShared ] 651 , case flagToMaybe (ghcOptDynLinkMode opts) of 652 Nothing -> [] 653 Just GhcStaticOnly -> ["-static"] 654 Just GhcDynamicOnly -> ["-dynamic"] 655 Just GhcStaticAndDynamic -> ["-static", "-dynamic-too"] 656 , [ "-fPIC" | flagBool ghcOptFPic ] 657 658 , concat [ ["-dylib-install-name", libname] | libname <- flag ghcOptDylibName ] 659 660 ------------------------ 661 -- Redirecting outputs 662 663 , concat [ ["-osuf", suf] | suf <- flag ghcOptObjSuffix ] 664 , concat [ ["-hisuf", suf] | suf <- flag ghcOptHiSuffix ] 665 , concat [ ["-dynosuf", suf] | suf <- flag ghcOptDynObjSuffix ] 666 , concat [ ["-dynhisuf",suf] | suf <- flag ghcOptDynHiSuffix ] 667 , concat [ ["-outputdir", dir] | dir <- flag ghcOptOutputDir ] 668 , concat [ ["-odir", dir] | dir <- flag ghcOptObjDir ] 669 , concat [ ["-hidir", dir] | dir <- flag ghcOptHiDir ] 670 , concat [ ["-stubdir", dir] | dir <- flag ghcOptStubDir ] 671 672 ----------------------- 673 -- Source search path 674 675 , [ "-i" | flagBool ghcOptSourcePathClear ] 676 , [ "-i" ++ dir | dir <- flags ghcOptSourcePath ] 677 678 -------------------- 679 680 -------------------- 681 -- CPP, C, and C++ stuff 682 683 , [ "-I" ++ dir | dir <- flags ghcOptCppIncludePath ] 684 , [ "-optP" ++ opt | opt <- ghcOptCppOptions opts] 685 , concat [ [ "-optP-include", "-optP" ++ inc] 686 | inc <- flags ghcOptCppIncludes ] 687 , [ "-optc" ++ opt | opt <- ghcOptCcOptions opts] 688 , -- C++ compiler options: GHC >= 8.10 requires -optcxx, older requires -optc 689 let cxxflag = case compilerCompatVersion GHC comp of 690 Just v | v >= mkVersion [8, 10] -> "-optcxx" 691 _ -> "-optc" 692 in [ cxxflag ++ opt | opt <- ghcOptCxxOptions opts] 693 , [ "-opta" ++ opt | opt <- ghcOptAsmOptions opts] 694 695 ----------------- 696 -- Linker stuff 697 698 , [ "-optl" ++ opt | opt <- ghcOptLinkOptions opts] 699 , ["-l" ++ lib | lib <- ghcOptLinkLibs opts] 700 , ["-L" ++ dir | dir <- flags ghcOptLinkLibPath ] 701 , if isOSX 702 then concat [ ["-framework", fmwk] 703 | fmwk <- flags ghcOptLinkFrameworks ] 704 else [] 705 , if isOSX 706 then concat [ ["-framework-path", path] 707 | path <- flags ghcOptLinkFrameworkDirs ] 708 else [] 709 , [ "-no-hs-main" | flagBool ghcOptLinkNoHsMain ] 710 , [ "-dynload deploy" | not (null (flags ghcOptRPaths)) ] 711 , concat [ [ "-optl-Wl,-rpath," ++ dir] 712 | dir <- flags ghcOptRPaths ] 713 , [ modDefFile | modDefFile <- flags ghcOptLinkModDefFiles ] 714 715 ------------- 716 -- Packages 717 718 , concat [ [ case () of 719 _ | unitIdSupported comp -> "-this-unit-id" 720 | packageKeySupported comp -> "-this-package-key" 721 | otherwise -> "-package-name" 722 , this_arg ] 723 | this_arg <- flag ghcOptThisUnitId ] 724 725 , concat [ ["-this-component-id", prettyShow this_cid ] 726 | this_cid <- flag ghcOptThisComponentId ] 727 728 , if null (ghcOptInstantiatedWith opts) 729 then [] 730 else "-instantiated-with" 731 : intercalate "," (map (\(n,m) -> prettyShow n ++ "=" 732 ++ prettyShow m) 733 (ghcOptInstantiatedWith opts)) 734 : [] 735 736 , concat [ ["-fno-code", "-fwrite-interface"] | flagBool ghcOptNoCode ] 737 738 , [ "-hide-all-packages" | flagBool ghcOptHideAllPackages ] 739 , [ "-Wmissing-home-modules" | flagBool ghcOptWarnMissingHomeModules ] 740 , [ "-no-auto-link-packages" | flagBool ghcOptNoAutoLinkPackages ] 741 742 , packageDbArgs implInfo (ghcOptPackageDBs opts) 743 744 , concat $ let space "" = "" 745 space xs = ' ' : xs 746 in [ ["-package-id", prettyShow ipkgid ++ space (prettyShow rns)] 747 | (ipkgid,rns) <- flags ghcOptPackages ] 748 749 ---------------------------- 750 -- Language and extensions 751 752 , if supportsHaskell2010 implInfo 753 then [ "-X" ++ prettyShow lang | lang <- flag ghcOptLanguage ] 754 else [] 755 756 , [ ext' 757 | ext <- flags ghcOptExtensions 758 , ext' <- case Map.lookup ext (ghcOptExtensionMap opts) of 759 Just (Just arg) -> [arg] 760 Just Nothing -> [] 761 Nothing -> 762 error $ "Distribution.Simple.Program.GHC.renderGhcOptions: " 763 ++ prettyShow ext ++ " not present in ghcOptExtensionMap." 764 ] 765 766 ---------------- 767 -- GHCi 768 769 , concat [ [ "-ghci-script", script ] | script <- ghcOptGHCiScripts opts 770 , flagGhciScript implInfo ] 771 772 --------------- 773 -- Inputs 774 775 -- Specify the input file(s) first, so that in ghci the `main-is` module is 776 -- in scope instead of the first module defined in `other-modules`. 777 , flags ghcOptInputFiles 778 , [ prettyShow modu | modu <- flags ghcOptInputModules ] 779 780 , concat [ [ "-o", out] | out <- flag ghcOptOutputFile ] 781 , concat [ [ "-dyno", out] | out <- flag ghcOptOutputDynFile ] 782 783 --------------- 784 -- Extra 785 786 , ghcOptExtra opts 787 788 ] 789 790 791 where 792 implInfo = getImplInfo comp 793 isOSX = os == OSX 794 flag flg = flagToList (flg opts) 795 flags flg = fromNubListR . flg $ opts 796 flagBool flg = fromFlagOrDefault False (flg opts) 797 798verbosityOpts :: Verbosity -> [String] 799verbosityOpts verbosity 800 | verbosity >= deafening = ["-v"] 801 | verbosity >= normal = [] 802 | otherwise = ["-w", "-v0"] 803 804 805-- | GHC <7.6 uses '-package-conf' instead of '-package-db'. 806packageDbArgsConf :: PackageDBStack -> [String] 807packageDbArgsConf dbstack = case dbstack of 808 (GlobalPackageDB:UserPackageDB:dbs) -> concatMap specific dbs 809 (GlobalPackageDB:dbs) -> ("-no-user-package-conf") 810 : concatMap specific dbs 811 _ -> ierror 812 where 813 specific (SpecificPackageDB db) = [ "-package-conf", db ] 814 specific _ = ierror 815 ierror = error $ "internal error: unexpected package db stack: " 816 ++ show dbstack 817 818-- | GHC >= 7.6 uses the '-package-db' flag. See 819-- https://gitlab.haskell.org/ghc/ghc/-/issues/5977. 820packageDbArgsDb :: PackageDBStack -> [String] 821-- special cases to make arguments prettier in common scenarios 822packageDbArgsDb dbstack = case dbstack of 823 (GlobalPackageDB:UserPackageDB:dbs) 824 | all isSpecific dbs -> concatMap single dbs 825 (GlobalPackageDB:dbs) 826 | all isSpecific dbs -> "-no-user-package-db" 827 : concatMap single dbs 828 dbs -> "-clear-package-db" 829 : concatMap single dbs 830 where 831 single (SpecificPackageDB db) = [ "-package-db", db ] 832 single GlobalPackageDB = [ "-global-package-db" ] 833 single UserPackageDB = [ "-user-package-db" ] 834 isSpecific (SpecificPackageDB _) = True 835 isSpecific _ = False 836 837packageDbArgs :: GhcImplInfo -> PackageDBStack -> [String] 838packageDbArgs implInfo 839 | flagPackageConf implInfo = packageDbArgsConf 840 | otherwise = packageDbArgsDb 841 842-- ----------------------------------------------------------------------------- 843-- Boilerplate Monoid instance for GhcOptions 844 845instance Monoid GhcOptions where 846 mempty = gmempty 847 mappend = (<>) 848 849instance Semigroup GhcOptions where 850 (<>) = gmappend 851