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