1{-# LANGUAGE FlexibleContexts #-} 2{-# LANGUAGE RankNTypes #-} 3 4----------------------------------------------------------------------------- 5-- | 6-- Module : Distribution.Simple.PreProcess 7-- Copyright : (c) 2003-2005, Isaac Jones, Malcolm Wallace 8-- License : BSD3 9-- 10-- Maintainer : cabal-devel@haskell.org 11-- Portability : portable 12-- 13-- This defines a 'PreProcessor' abstraction which represents a pre-processor 14-- that can transform one kind of file into another. There is also a 15-- 'PPSuffixHandler' which is a combination of a file extension and a function 16-- for configuring a 'PreProcessor'. It defines a bunch of known built-in 17-- preprocessors like @cpp@, @cpphs@, @c2hs@, @hsc2hs@, @happy@, @alex@ etc and 18-- lists them in 'knownSuffixHandlers'. On top of this it provides a function 19-- for actually preprocessing some sources given a bunch of known suffix 20-- handlers. This module is not as good as it could be, it could really do with 21-- a rewrite to address some of the problems we have with pre-processors. 22 23module Distribution.Simple.PreProcess (preprocessComponent, preprocessExtras, 24 knownSuffixHandlers, ppSuffixes, 25 PPSuffixHandler, PreProcessor(..), 26 mkSimplePreProcessor, runSimplePreProcessor, 27 ppCpp, ppCpp', ppGreenCard, ppC2hs, ppHsc2hs, 28 ppHappy, ppAlex, ppUnlit, platformDefines 29 ) 30 where 31 32import Prelude () 33import Distribution.Compat.Prelude 34import Distribution.Compat.Stack 35 36import Distribution.Simple.PreProcess.Unlit 37import Distribution.Backpack.DescribeUnitId 38import Distribution.Package 39import qualified Distribution.ModuleName as ModuleName 40import Distribution.ModuleName (ModuleName) 41import Distribution.PackageDescription as PD 42import qualified Distribution.InstalledPackageInfo as Installed 43import qualified Distribution.Simple.PackageIndex as PackageIndex 44import Distribution.Simple.CCompiler 45import Distribution.Simple.Compiler 46import Distribution.Simple.LocalBuildInfo 47import Distribution.Simple.BuildPaths 48import Distribution.Simple.Utils 49import Distribution.Simple.Program 50import Distribution.Simple.Program.ResponseFile 51import Distribution.Simple.Test.LibV09 52import Distribution.System 53import Distribution.Pretty 54import Distribution.Version 55import Distribution.Verbosity 56 57import System.Directory (doesFileExist) 58import System.Info (os, arch) 59import System.FilePath (splitExtension, dropExtensions, (</>), (<.>), 60 takeDirectory, normalise, replaceExtension, 61 takeExtensions) 62 63-- |The interface to a preprocessor, which may be implemented using an 64-- external program, but need not be. The arguments are the name of 65-- the input file, the name of the output file and a verbosity level. 66-- Here is a simple example that merely prepends a comment to the given 67-- source file: 68-- 69-- > ppTestHandler :: PreProcessor 70-- > ppTestHandler = 71-- > PreProcessor { 72-- > platformIndependent = True, 73-- > runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbosity -> 74-- > do info verbosity (inFile++" has been preprocessed to "++outFile) 75-- > stuff <- readFile inFile 76-- > writeFile outFile ("-- preprocessed as a test\n\n" ++ stuff) 77-- > return ExitSuccess 78-- 79-- We split the input and output file names into a base directory and the 80-- rest of the file name. The input base dir is the path in the list of search 81-- dirs that this file was found in. The output base dir is the build dir where 82-- all the generated source files are put. 83-- 84-- The reason for splitting it up this way is that some pre-processors don't 85-- simply generate one output .hs file from one input file but have 86-- dependencies on other generated files (notably c2hs, where building one 87-- .hs file may require reading other .chi files, and then compiling the .hs 88-- file may require reading a generated .h file). In these cases the generated 89-- files need to embed relative path names to each other (eg the generated .hs 90-- file mentions the .h file in the FFI imports). This path must be relative to 91-- the base directory where the generated files are located, it cannot be 92-- relative to the top level of the build tree because the compilers do not 93-- look for .h files relative to there, ie we do not use \"-I .\", instead we 94-- use \"-I dist\/build\" (or whatever dist dir has been set by the user) 95-- 96-- Most pre-processors do not care of course, so mkSimplePreProcessor and 97-- runSimplePreProcessor functions handle the simple case. 98-- 99data PreProcessor = PreProcessor { 100 101 -- Is the output of the pre-processor platform independent? eg happy output 102 -- is portable haskell but c2hs's output is platform dependent. 103 -- This matters since only platform independent generated code can be 104 -- included into a source tarball. 105 platformIndependent :: Bool, 106 107 -- TODO: deal with pre-processors that have implementation dependent output 108 -- eg alex and happy have --ghc flags. However we can't really include 109 -- ghc-specific code into supposedly portable source tarballs. 110 111 runPreProcessor :: (FilePath, FilePath) -- Location of the source file relative to a base dir 112 -> (FilePath, FilePath) -- Output file name, relative to an output base dir 113 -> Verbosity -- verbosity 114 -> IO () -- Should exit if the preprocessor fails 115 } 116 117-- | Function to determine paths to possible extra C sources for a 118-- preprocessor: just takes the path to the build directory and uses 119-- this to search for C sources with names that match the 120-- preprocessor's output name format. 121type PreProcessorExtras = FilePath -> IO [FilePath] 122 123 124mkSimplePreProcessor :: (FilePath -> FilePath -> Verbosity -> IO ()) 125 -> (FilePath, FilePath) 126 -> (FilePath, FilePath) -> Verbosity -> IO () 127mkSimplePreProcessor simplePP 128 (inBaseDir, inRelativeFile) 129 (outBaseDir, outRelativeFile) verbosity = simplePP inFile outFile verbosity 130 where inFile = normalise (inBaseDir </> inRelativeFile) 131 outFile = normalise (outBaseDir </> outRelativeFile) 132 133runSimplePreProcessor :: PreProcessor -> FilePath -> FilePath -> Verbosity 134 -> IO () 135runSimplePreProcessor pp inFile outFile verbosity = 136 runPreProcessor pp (".", inFile) (".", outFile) verbosity 137 138-- |A preprocessor for turning non-Haskell files with the given extension 139-- into plain Haskell source files. 140type PPSuffixHandler 141 = (String, BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor) 142 143-- | Apply preprocessors to the sources from 'hsSourceDirs' for a given 144-- component (lib, exe, or test suite). 145preprocessComponent :: PackageDescription 146 -> Component 147 -> LocalBuildInfo 148 -> ComponentLocalBuildInfo 149 -> Bool 150 -> Verbosity 151 -> [PPSuffixHandler] 152 -> IO () 153preprocessComponent pd comp lbi clbi isSrcDist verbosity handlers = do 154 -- NB: never report instantiation here; we'll report it properly when 155 -- building. 156 setupMessage' verbosity "Preprocessing" (packageId pd) 157 (componentLocalName clbi) (Nothing :: Maybe [(ModuleName, Module)]) 158 case comp of 159 (CLib lib@Library{ libBuildInfo = bi }) -> do 160 let dirs = hsSourceDirs bi ++ [autogenComponentModulesDir lbi clbi 161 ,autogenPackageModulesDir lbi] 162 for_ (map ModuleName.toFilePath $ allLibModules lib clbi) $ 163 pre dirs (componentBuildDir lbi clbi) (localHandlers bi) 164 (CFLib flib@ForeignLib { foreignLibBuildInfo = bi, foreignLibName = nm }) -> do 165 let nm' = unUnqualComponentName nm 166 let flibDir = buildDir lbi </> nm' </> nm' ++ "-tmp" 167 dirs = hsSourceDirs bi ++ [autogenComponentModulesDir lbi clbi 168 ,autogenPackageModulesDir lbi] 169 for_ (map ModuleName.toFilePath $ foreignLibModules flib) $ 170 pre dirs flibDir (localHandlers bi) 171 (CExe exe@Executable { buildInfo = bi, exeName = nm }) -> do 172 let nm' = unUnqualComponentName nm 173 let exeDir = buildDir lbi </> nm' </> nm' ++ "-tmp" 174 dirs = hsSourceDirs bi ++ [autogenComponentModulesDir lbi clbi 175 ,autogenPackageModulesDir lbi] 176 for_ (map ModuleName.toFilePath $ otherModules bi) $ 177 pre dirs exeDir (localHandlers bi) 178 pre (hsSourceDirs bi) exeDir (localHandlers bi) $ 179 dropExtensions (modulePath exe) 180 CTest test@TestSuite{ testName = nm } -> do 181 let nm' = unUnqualComponentName nm 182 case testInterface test of 183 TestSuiteExeV10 _ f -> 184 preProcessTest test f $ buildDir lbi </> nm' </> nm' ++ "-tmp" 185 TestSuiteLibV09 _ _ -> do 186 let testDir = buildDir lbi </> stubName test 187 </> stubName test ++ "-tmp" 188 writeSimpleTestStub test testDir 189 preProcessTest test (stubFilePath test) testDir 190 TestSuiteUnsupported tt -> 191 die' verbosity $ "No support for preprocessing test " 192 ++ "suite type " ++ prettyShow tt 193 CBench bm@Benchmark{ benchmarkName = nm } -> do 194 let nm' = unUnqualComponentName nm 195 case benchmarkInterface bm of 196 BenchmarkExeV10 _ f -> 197 preProcessBench bm f $ buildDir lbi </> nm' </> nm' ++ "-tmp" 198 BenchmarkUnsupported tt -> 199 die' verbosity $ "No support for preprocessing benchmark " 200 ++ "type " ++ prettyShow tt 201 where 202 builtinHaskellSuffixes = ["hs", "lhs", "hsig", "lhsig"] 203 builtinCSuffixes = cSourceExtensions 204 builtinSuffixes = builtinHaskellSuffixes ++ builtinCSuffixes 205 localHandlers bi = [(ext, h bi lbi clbi) | (ext, h) <- handlers] 206 pre dirs dir lhndlrs fp = 207 preprocessFile dirs dir isSrcDist fp verbosity builtinSuffixes lhndlrs 208 preProcessTest test = preProcessComponent (testBuildInfo test) 209 (testModules test) 210 preProcessBench bm = preProcessComponent (benchmarkBuildInfo bm) 211 (benchmarkModules bm) 212 preProcessComponent bi modules exePath dir = do 213 let biHandlers = localHandlers bi 214 sourceDirs = hsSourceDirs bi ++ [ autogenComponentModulesDir lbi clbi 215 , autogenPackageModulesDir lbi ] 216 sequence_ [ preprocessFile sourceDirs dir isSrcDist 217 (ModuleName.toFilePath modu) verbosity builtinSuffixes 218 biHandlers 219 | modu <- modules ] 220 preprocessFile (dir : (hsSourceDirs bi)) dir isSrcDist 221 (dropExtensions $ exePath) verbosity 222 builtinSuffixes biHandlers 223 224--TODO: try to list all the modules that could not be found 225-- not just the first one. It's annoying and slow due to the need 226-- to reconfigure after editing the .cabal file each time. 227 228-- |Find the first extension of the file that exists, and preprocess it 229-- if required. 230preprocessFile 231 :: [FilePath] -- ^source directories 232 -> FilePath -- ^build directory 233 -> Bool -- ^preprocess for sdist 234 -> FilePath -- ^module file name 235 -> Verbosity -- ^verbosity 236 -> [String] -- ^builtin suffixes 237 -> [(String, PreProcessor)] -- ^possible preprocessors 238 -> IO () 239preprocessFile searchLoc buildLoc forSDist baseFile verbosity builtinSuffixes handlers = do 240 -- look for files in the various source dirs with this module name 241 -- and a file extension of a known preprocessor 242 psrcFiles <- findFileWithExtension' (map fst handlers) searchLoc baseFile 243 case psrcFiles of 244 -- no preprocessor file exists, look for an ordinary source file 245 -- just to make sure one actually exists at all for this module. 246 -- Note: by looking in the target/output build dir too, we allow 247 -- source files to appear magically in the target build dir without 248 -- any corresponding "real" source file. This lets custom Setup.hs 249 -- files generate source modules directly into the build dir without 250 -- the rest of the build system being aware of it (somewhat dodgy) 251 Nothing -> do 252 bsrcFiles <- findFileWithExtension builtinSuffixes (buildLoc : searchLoc) baseFile 253 case bsrcFiles of 254 Nothing -> 255 die' verbosity $ "can't find source for " ++ baseFile 256 ++ " in " ++ intercalate ", " searchLoc 257 _ -> return () 258 -- found a pre-processable file in one of the source dirs 259 Just (psrcLoc, psrcRelFile) -> do 260 let (srcStem, ext) = splitExtension psrcRelFile 261 psrcFile = psrcLoc </> psrcRelFile 262 pp = fromMaybe (error "Distribution.Simple.PreProcess: Just expected") 263 (lookup (safeTail ext) handlers) 264 -- Preprocessing files for 'sdist' is different from preprocessing 265 -- for 'build'. When preprocessing for sdist we preprocess to 266 -- avoid that the user has to have the preprocessors available. 267 -- ATM, we don't have a way to specify which files are to be 268 -- preprocessed and which not, so for sdist we only process 269 -- platform independent files and put them into the 'buildLoc' 270 -- (which we assume is set to the temp. directory that will become 271 -- the tarball). 272 --TODO: eliminate sdist variant, just supply different handlers 273 when (not forSDist || forSDist && platformIndependent pp) $ do 274 -- look for existing pre-processed source file in the dest dir to 275 -- see if we really have to re-run the preprocessor. 276 ppsrcFiles <- findFileWithExtension builtinSuffixes [buildLoc] baseFile 277 recomp <- case ppsrcFiles of 278 Nothing -> return True 279 Just ppsrcFile -> 280 psrcFile `moreRecentFile` ppsrcFile 281 when recomp $ do 282 let destDir = buildLoc </> dirName srcStem 283 createDirectoryIfMissingVerbose verbosity True destDir 284 runPreProcessorWithHsBootHack pp 285 (psrcLoc, psrcRelFile) 286 (buildLoc, srcStem <.> "hs") 287 288 where 289 dirName = takeDirectory 290 291 -- FIXME: This is a somewhat nasty hack. GHC requires that hs-boot files 292 -- be in the same place as the hs files, so if we put the hs file in dist/ 293 -- then we need to copy the hs-boot file there too. This should probably be 294 -- done another way. Possibly we should also be looking for .lhs-boot 295 -- files, but I think that preprocessors only produce .hs files. 296 runPreProcessorWithHsBootHack pp 297 (inBaseDir, inRelativeFile) 298 (outBaseDir, outRelativeFile) = do 299 runPreProcessor pp 300 (inBaseDir, inRelativeFile) 301 (outBaseDir, outRelativeFile) verbosity 302 303 exists <- doesFileExist inBoot 304 when exists $ copyFileVerbose verbosity inBoot outBoot 305 306 where 307 inBoot = replaceExtension inFile "hs-boot" 308 outBoot = replaceExtension outFile "hs-boot" 309 310 inFile = normalise (inBaseDir </> inRelativeFile) 311 outFile = normalise (outBaseDir </> outRelativeFile) 312 313-- ------------------------------------------------------------ 314-- * known preprocessors 315-- ------------------------------------------------------------ 316 317ppGreenCard :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor 318ppGreenCard _ lbi _ 319 = PreProcessor { 320 platformIndependent = False, 321 runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbosity -> 322 runDbProgram verbosity greencardProgram (withPrograms lbi) 323 (["-tffi", "-o" ++ outFile, inFile]) 324 } 325 326-- This one is useful for preprocessors that can't handle literate source. 327-- We also need a way to chain preprocessors. 328ppUnlit :: PreProcessor 329ppUnlit = 330 PreProcessor { 331 platformIndependent = True, 332 runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbosity -> 333 withUTF8FileContents inFile $ \contents -> 334 either (writeUTF8File outFile) (die' verbosity) (unlit inFile contents) 335 } 336 337ppCpp :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor 338ppCpp = ppCpp' [] 339 340ppCpp' :: [String] -> BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor 341ppCpp' extraArgs bi lbi clbi = 342 case compilerFlavor (compiler lbi) of 343 GHC -> ppGhcCpp ghcProgram (const True) args bi lbi clbi 344 GHCJS -> ppGhcCpp ghcjsProgram (const True) args bi lbi clbi 345 _ -> ppCpphs args bi lbi clbi 346 where cppArgs = getCppOptions bi lbi 347 args = cppArgs ++ extraArgs 348 349ppGhcCpp :: Program -> (Version -> Bool) 350 -> [String] -> BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor 351ppGhcCpp program xHs extraArgs _bi lbi clbi = 352 PreProcessor { 353 platformIndependent = False, 354 runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbosity -> do 355 (prog, version, _) <- requireProgramVersion verbosity 356 program anyVersion (withPrograms lbi) 357 runProgram verbosity prog $ 358 ["-E", "-cpp"] 359 -- This is a bit of an ugly hack. We're going to 360 -- unlit the file ourselves later on if appropriate, 361 -- so we need GHC not to unlit it now or it'll get 362 -- double-unlitted. In the future we might switch to 363 -- using cpphs --unlit instead. 364 ++ (if xHs version then ["-x", "hs"] else []) 365 ++ [ "-optP-include", "-optP"++ (autogenComponentModulesDir lbi clbi </> cppHeaderName) ] 366 ++ ["-o", outFile, inFile] 367 ++ extraArgs 368 } 369 370ppCpphs :: [String] -> BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor 371ppCpphs extraArgs _bi lbi clbi = 372 PreProcessor { 373 platformIndependent = False, 374 runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbosity -> do 375 (cpphsProg, cpphsVersion, _) <- requireProgramVersion verbosity 376 cpphsProgram anyVersion (withPrograms lbi) 377 runProgram verbosity cpphsProg $ 378 ("-O" ++ outFile) : inFile 379 : "--noline" : "--strip" 380 : (if cpphsVersion >= mkVersion [1,6] 381 then ["--include="++ (autogenComponentModulesDir lbi clbi </> cppHeaderName)] 382 else []) 383 ++ extraArgs 384 } 385 386ppHsc2hs :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor 387ppHsc2hs bi lbi clbi = 388 PreProcessor { 389 platformIndependent = False, 390 runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbosity -> do 391 (gccProg, _) <- requireProgram verbosity gccProgram (withPrograms lbi) 392 (hsc2hsProg, hsc2hsVersion, _) <- requireProgramVersion verbosity 393 hsc2hsProgram anyVersion (withPrograms lbi) 394 -- See Trac #13896 and https://github.com/haskell/cabal/issues/3122. 395 let isCross = hostPlatform lbi /= buildPlatform 396 prependCrossFlags = if isCross then ("-x":) else id 397 let hsc2hsSupportsResponseFiles = hsc2hsVersion >= mkVersion [0,68,4] 398 pureArgs = genPureArgs gccProg inFile outFile 399 if hsc2hsSupportsResponseFiles 400 then withResponseFile 401 verbosity 402 defaultTempFileOptions 403 (takeDirectory outFile) 404 "hsc2hs-response.txt" 405 Nothing 406 pureArgs 407 (\responseFileName -> 408 runProgram verbosity hsc2hsProg (prependCrossFlags ["@"++ responseFileName])) 409 else runProgram verbosity hsc2hsProg (prependCrossFlags pureArgs) 410 } 411 where 412 -- Returns a list of command line arguments that can either be passed 413 -- directly, or via a response file. 414 genPureArgs :: ConfiguredProgram -> String -> String -> [String] 415 genPureArgs gccProg inFile outFile = 416 [ "--cc=" ++ programPath gccProg 417 , "--ld=" ++ programPath gccProg ] 418 419 -- Additional gcc options 420 ++ [ "--cflag=" ++ opt | opt <- programDefaultArgs gccProg 421 ++ programOverrideArgs gccProg ] 422 ++ [ "--lflag=" ++ opt | opt <- programDefaultArgs gccProg 423 ++ programOverrideArgs gccProg ] 424 425 -- OSX frameworks: 426 ++ [ what ++ "=-F" ++ opt 427 | isOSX 428 , opt <- nub (concatMap Installed.frameworkDirs pkgs) 429 , what <- ["--cflag", "--lflag"] ] 430 ++ [ "--lflag=" ++ arg 431 | isOSX 432 , opt <- PD.frameworks bi ++ concatMap Installed.frameworks pkgs 433 , arg <- ["-framework", opt] ] 434 435 -- Note that on ELF systems, wherever we use -L, we must also use -R 436 -- because presumably that -L dir is not on the normal path for the 437 -- system's dynamic linker. This is needed because hsc2hs works by 438 -- compiling a C program and then running it. 439 440 ++ [ "--cflag=" ++ opt | opt <- platformDefines lbi ] 441 442 -- Options from the current package: 443 ++ [ "--cflag=-I" ++ dir | dir <- PD.includeDirs bi ] 444 ++ [ "--cflag=-I" ++ buildDir lbi </> dir | dir <- PD.includeDirs bi ] 445 ++ [ "--cflag=" ++ opt | opt <- PD.ccOptions bi 446 ++ PD.cppOptions bi 447 -- hsc2hs uses the C ABI 448 -- We assume that there are only C sources 449 -- and C++ functions are exported via a C 450 -- interface and wrapped in a C source file. 451 -- Therefore we do not supply C++ flags 452 -- because there will not be C++ sources. 453 -- 454 -- DO NOT add PD.cxxOptions unless this changes! 455 ] 456 ++ [ "--cflag=" ++ opt | opt <- 457 [ "-I" ++ autogenComponentModulesDir lbi clbi, 458 "-I" ++ autogenPackageModulesDir lbi, 459 "-include", autogenComponentModulesDir lbi clbi </> cppHeaderName ] ] 460 ++ [ "--lflag=-L" ++ opt | opt <- PD.extraLibDirs bi ] 461 ++ [ "--lflag=-Wl,-R," ++ opt | isELF 462 , opt <- PD.extraLibDirs bi ] 463 ++ [ "--lflag=-l" ++ opt | opt <- PD.extraLibs bi ] 464 ++ [ "--lflag=" ++ opt | opt <- PD.ldOptions bi ] 465 466 -- Options from dependent packages 467 ++ [ "--cflag=" ++ opt 468 | pkg <- pkgs 469 , opt <- [ "-I" ++ opt | opt <- Installed.includeDirs pkg ] 470 ++ [ opt | opt <- Installed.ccOptions pkg ] ] 471 ++ [ "--lflag=" ++ opt 472 | pkg <- pkgs 473 , opt <- [ "-L" ++ opt | opt <- Installed.libraryDirs pkg ] 474 ++ [ "-Wl,-R," ++ opt | isELF 475 , opt <- Installed.libraryDirs pkg ] 476 ++ [ "-l" ++ opt | opt <- Installed.extraLibraries pkg ] 477 ++ [ opt | opt <- Installed.ldOptions pkg ] ] 478 ++ ["-o", outFile, inFile] 479 480 hacked_index = packageHacks (installedPkgs lbi) 481 -- Look only at the dependencies of the current component 482 -- being built! This relies on 'installedPkgs' maintaining 483 -- 'InstalledPackageInfo' for internal deps too; see #2971. 484 pkgs = PackageIndex.topologicalOrder $ 485 case PackageIndex.dependencyClosure hacked_index 486 (map fst (componentPackageDeps clbi)) of 487 Left index' -> index' 488 Right inf -> 489 error ("ppHsc2hs: broken closure: " ++ show inf) 490 isOSX = case buildOS of OSX -> True; _ -> False 491 isELF = case buildOS of OSX -> False; Windows -> False; AIX -> False; _ -> True; 492 packageHacks = case compilerFlavor (compiler lbi) of 493 GHC -> hackRtsPackage 494 GHCJS -> hackRtsPackage 495 _ -> id 496 -- We don't link in the actual Haskell libraries of our dependencies, so 497 -- the -u flags in the ldOptions of the rts package mean linking fails on 498 -- OS X (its ld is a tad stricter than gnu ld). Thus we remove the 499 -- ldOptions for GHC's rts package: 500 hackRtsPackage index = 501 case PackageIndex.lookupPackageName index (mkPackageName "rts") of 502 [(_, [rts])] 503 -> PackageIndex.insert rts { Installed.ldOptions = [] } index 504 _ -> error "No (or multiple) ghc rts package is registered!!" 505 506ppHsc2hsExtras :: PreProcessorExtras 507ppHsc2hsExtras buildBaseDir = filter ("_hsc.c" `isSuffixOf`) `fmap` 508 getDirectoryContentsRecursive buildBaseDir 509 510ppC2hs :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor 511ppC2hs bi lbi clbi = 512 PreProcessor { 513 platformIndependent = False, 514 runPreProcessor = \(inBaseDir, inRelativeFile) 515 (outBaseDir, outRelativeFile) verbosity -> do 516 (c2hsProg, _, _) <- requireProgramVersion verbosity 517 c2hsProgram (orLaterVersion (mkVersion [0,15])) 518 (withPrograms lbi) 519 (gccProg, _) <- requireProgram verbosity gccProgram (withPrograms lbi) 520 runProgram verbosity c2hsProg $ 521 522 -- Options from the current package: 523 [ "--cpp=" ++ programPath gccProg, "--cppopts=-E" ] 524 ++ [ "--cppopts=" ++ opt | opt <- getCppOptions bi lbi ] 525 ++ [ "--cppopts=-include" ++ (autogenComponentModulesDir lbi clbi </> cppHeaderName) ] 526 ++ [ "--include=" ++ outBaseDir ] 527 528 -- Options from dependent packages 529 ++ [ "--cppopts=" ++ opt 530 | pkg <- pkgs 531 , opt <- [ "-I" ++ opt | opt <- Installed.includeDirs pkg ] 532 ++ [ opt | opt@('-':c:_) <- Installed.ccOptions pkg 533 -- c2hs uses the C ABI 534 -- We assume that there are only C sources 535 -- and C++ functions are exported via a C 536 -- interface and wrapped in a C source file. 537 -- Therefore we do not supply C++ flags 538 -- because there will not be C++ sources. 539 -- 540 -- 541 -- DO NOT add Installed.cxxOptions unless this changes! 542 , c `elem` "DIU" ] ] 543 --TODO: install .chi files for packages, so we can --include 544 -- those dirs here, for the dependencies 545 546 -- input and output files 547 ++ [ "--output-dir=" ++ outBaseDir 548 , "--output=" ++ outRelativeFile 549 , inBaseDir </> inRelativeFile ] 550 } 551 where 552 pkgs = PackageIndex.topologicalOrder (installedPkgs lbi) 553 554ppC2hsExtras :: PreProcessorExtras 555ppC2hsExtras d = filter (\p -> takeExtensions p == ".chs.c") `fmap` 556 getDirectoryContentsRecursive d 557 558--TODO: perhaps use this with hsc2hs too 559--TODO: remove cc-options from cpphs for cabal-version: >= 1.10 560--TODO: Refactor and add separate getCppOptionsForHs, getCppOptionsForCxx, & getCppOptionsForC 561-- instead of combining all these cases in a single function. This blind combination can 562-- potentially lead to compilation inconsistencies. 563getCppOptions :: BuildInfo -> LocalBuildInfo -> [String] 564getCppOptions bi lbi 565 = platformDefines lbi 566 ++ cppOptions bi 567 ++ ["-I" ++ dir | dir <- PD.includeDirs bi] 568 ++ [opt | opt@('-':c:_) <- PD.ccOptions bi ++ PD.cxxOptions bi, c `elem` "DIU"] 569 570platformDefines :: LocalBuildInfo -> [String] 571platformDefines lbi = 572 case compilerFlavor comp of 573 GHC -> 574 ["-D__GLASGOW_HASKELL__=" ++ versionInt version] ++ 575 ["-D" ++ os ++ "_BUILD_OS=1"] ++ 576 ["-D" ++ arch ++ "_BUILD_ARCH=1"] ++ 577 map (\os' -> "-D" ++ os' ++ "_HOST_OS=1") osStr ++ 578 map (\arch' -> "-D" ++ arch' ++ "_HOST_ARCH=1") archStr 579 GHCJS -> 580 compatGlasgowHaskell ++ 581 ["-D__GHCJS__=" ++ versionInt version] ++ 582 ["-D" ++ os ++ "_BUILD_OS=1"] ++ 583 ["-D" ++ arch ++ "_BUILD_ARCH=1"] ++ 584 map (\os' -> "-D" ++ os' ++ "_HOST_OS=1") osStr ++ 585 map (\arch' -> "-D" ++ arch' ++ "_HOST_ARCH=1") archStr 586 HaskellSuite {} -> 587 ["-D__HASKELL_SUITE__"] ++ 588 map (\os' -> "-D" ++ os' ++ "_HOST_OS=1") osStr ++ 589 map (\arch' -> "-D" ++ arch' ++ "_HOST_ARCH=1") archStr 590 _ -> [] 591 where 592 comp = compiler lbi 593 Platform hostArch hostOS = hostPlatform lbi 594 version = compilerVersion comp 595 compatGlasgowHaskell = 596 maybe [] (\v -> ["-D__GLASGOW_HASKELL__=" ++ versionInt v]) 597 (compilerCompatVersion GHC comp) 598 -- TODO: move this into the compiler abstraction 599 -- FIXME: this forces GHC's crazy 4.8.2 -> 408 convention on all 600 -- the other compilers. Check if that's really what they want. 601 versionInt :: Version -> String 602 versionInt v = case versionNumbers v of 603 [] -> "1" 604 [n] -> show n 605 n1:n2:_ -> 606 -- 6.8.x -> 608 607 -- 6.10.x -> 610 608 let s1 = show n1 609 s2 = show n2 610 middle = case s2 of 611 _ : _ : _ -> "" 612 _ -> "0" 613 in s1 ++ middle ++ s2 614 615 osStr = case hostOS of 616 Linux -> ["linux"] 617 Windows -> ["mingw32"] 618 OSX -> ["darwin"] 619 FreeBSD -> ["freebsd"] 620 OpenBSD -> ["openbsd"] 621 NetBSD -> ["netbsd"] 622 DragonFly -> ["dragonfly"] 623 Solaris -> ["solaris2"] 624 AIX -> ["aix"] 625 HPUX -> ["hpux"] 626 IRIX -> ["irix"] 627 HaLVM -> [] 628 IOS -> ["ios"] 629 Android -> ["android"] 630 Ghcjs -> ["ghcjs"] 631 Hurd -> ["hurd"] 632 OtherOS _ -> [] 633 archStr = case hostArch of 634 I386 -> ["i386"] 635 X86_64 -> ["x86_64"] 636 PPC -> ["powerpc"] 637 PPC64 -> ["powerpc64"] 638 Sparc -> ["sparc"] 639 Arm -> ["arm"] 640 AArch64 -> ["aarch64"] 641 Mips -> ["mips"] 642 SH -> [] 643 IA64 -> ["ia64"] 644 S390 -> ["s390"] 645 Alpha -> ["alpha"] 646 Hppa -> ["hppa"] 647 Rs6000 -> ["rs6000"] 648 M68k -> ["m68k"] 649 Vax -> ["vax"] 650 JavaScript -> ["javascript"] 651 OtherArch _ -> [] 652 653ppHappy :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor 654ppHappy _ lbi _ = pp { platformIndependent = True } 655 where pp = standardPP lbi happyProgram (hcFlags hc) 656 hc = compilerFlavor (compiler lbi) 657 hcFlags GHC = ["-agc"] 658 hcFlags GHCJS = ["-agc"] 659 hcFlags _ = [] 660 661ppAlex :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor 662ppAlex _ lbi _ = pp { platformIndependent = True } 663 where pp = standardPP lbi alexProgram (hcFlags hc) 664 hc = compilerFlavor (compiler lbi) 665 hcFlags GHC = ["-g"] 666 hcFlags GHCJS = ["-g"] 667 hcFlags _ = [] 668 669standardPP :: LocalBuildInfo -> Program -> [String] -> PreProcessor 670standardPP lbi prog args = 671 PreProcessor { 672 platformIndependent = False, 673 runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbosity -> 674 runDbProgram verbosity prog (withPrograms lbi) 675 (args ++ ["-o", outFile, inFile]) 676 } 677 678-- |Convenience function; get the suffixes of these preprocessors. 679ppSuffixes :: [ PPSuffixHandler ] -> [String] 680ppSuffixes = map fst 681 682-- |Standard preprocessors: GreenCard, c2hs, hsc2hs, happy, alex and cpphs. 683knownSuffixHandlers :: [ PPSuffixHandler ] 684knownSuffixHandlers = 685 [ ("gc", ppGreenCard) 686 , ("chs", ppC2hs) 687 , ("hsc", ppHsc2hs) 688 , ("x", ppAlex) 689 , ("y", ppHappy) 690 , ("ly", ppHappy) 691 , ("cpphs", ppCpp) 692 ] 693 694-- |Standard preprocessors with possible extra C sources: c2hs, hsc2hs. 695knownExtrasHandlers :: [ PreProcessorExtras ] 696knownExtrasHandlers = [ ppC2hsExtras, ppHsc2hsExtras ] 697 698-- | Find any extra C sources generated by preprocessing that need to 699-- be added to the component (addresses issue #238). 700preprocessExtras :: Verbosity 701 -> Component 702 -> LocalBuildInfo 703 -> IO [FilePath] 704preprocessExtras verbosity comp lbi = case comp of 705 CLib _ -> pp $ buildDir lbi 706 (CExe Executable { exeName = nm }) -> do 707 let nm' = unUnqualComponentName nm 708 pp $ buildDir lbi </> nm' </> nm' ++ "-tmp" 709 (CFLib ForeignLib { foreignLibName = nm }) -> do 710 let nm' = unUnqualComponentName nm 711 pp $ buildDir lbi </> nm' </> nm' ++ "-tmp" 712 CTest test -> do 713 let nm' = unUnqualComponentName $ testName test 714 case testInterface test of 715 TestSuiteExeV10 _ _ -> 716 pp $ buildDir lbi </> nm' </> nm' ++ "-tmp" 717 TestSuiteLibV09 _ _ -> 718 pp $ buildDir lbi </> stubName test </> stubName test ++ "-tmp" 719 TestSuiteUnsupported tt -> 720 die' verbosity $ "No support for preprocessing test suite type " ++ 721 prettyShow tt 722 CBench bm -> do 723 let nm' = unUnqualComponentName $ benchmarkName bm 724 case benchmarkInterface bm of 725 BenchmarkExeV10 _ _ -> 726 pp $ buildDir lbi </> nm' </> nm' ++ "-tmp" 727 BenchmarkUnsupported tt -> 728 die' verbosity $ "No support for preprocessing benchmark " 729 ++ "type " ++ prettyShow tt 730 where 731 pp :: FilePath -> IO [FilePath] 732 pp dir = (map (dir </>) . filter not_sub . concat) 733 <$> for knownExtrasHandlers 734 (withLexicalCallStack (\f -> f dir)) 735 -- TODO: This is a terrible hack to work around #3545 while we don't 736 -- reorganize the directory layout. Basically, for the main 737 -- library, we might accidentally pick up autogenerated sources for 738 -- our subcomponents, because they are all stored as subdirectories 739 -- in dist/build. This is a cheap and cheerful check to prevent 740 -- this from happening. It is not particularly correct; for example 741 -- if a user has a test suite named foobar and puts their C file in 742 -- foobar/foo.c, this test will incorrectly exclude it. But I 743 -- didn't want to break BC... 744 not_sub p = and [ not (pre `isPrefixOf` p) | pre <- component_dirs ] 745 component_dirs = component_names (localPkgDescr lbi) 746 -- TODO: libify me 747 component_names pkg_descr = fmap unUnqualComponentName $ 748 mapMaybe (libraryNameString . libName) (subLibraries pkg_descr) ++ 749 map exeName (executables pkg_descr) ++ 750 map testName (testSuites pkg_descr) ++ 751 map benchmarkName (benchmarks pkg_descr) 752