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