module UHC.Light.Compiler.EHC.CompilePhase.CompileC ( gccDefs , cpCompileWithGCC , gccInclDirs , cpPreprocessWithCPP ) where import Data.Char import Data.Maybe import Control.Monad.State import qualified Data.Map as Map import UHC.Light.Compiler.EHC.Common import UHC.Light.Compiler.EHC.CompileUnit import UHC.Light.Compiler.EHC.CompileRun.Base import UHC.Light.Compiler.Opts.CommandLine import qualified UHC.Light.Compiler.Config as Cfg import UHC.Light.Compiler.EHC.Environment import UHC.Light.Compiler.Base.Target import UHC.Light.Compiler.Base.FileSearchLocation import UHC.Light.Compiler.Base.PackageDatabase {-# LINE 50 "src/ehc/EHC/CompilePhase/CompileC.chs" #-} gccDefs :: EHCOpts -> [String] -> CmdLineOpts gccDefs opts builds = map (\(d,mbval) -> cppOpt $ CmdFlag_Define ("__UHC" ++ d ++ "__") mbval) $ [ ("" , Just (Cfg.verAsNumber Cfg.version)) , ("_TARGET_" ++ (map toUpper $ show $ ehcOptTarget opts), Nothing ) ] ++ map (\x -> ("_BUILDS_" ++ x, Nothing)) builds ++ map (\x -> (x,Nothing)) [ "_" ++ map (\c -> case c of {'.' -> '_'; c -> c}) (Cfg.verFull Cfg.version) ] {-# LINE 64 "src/ehc/EHC/CompilePhase/CompileC.chs" #-} gccInclDirs :: EHCOpts -> [PkgModulePartition] -> [FilePath] gccInclDirs opts pkgKeyDirL = ds ++ (map fst $ Map.elems pdmp) where (ds,pdmp) = pkgPartInclDirs opts pkgKeyDirL {-# LINE 77 "src/ehc/EHC/CompilePhase/CompileC.chs" #-} cpCompileWithGCC :: EHCCompileRunner m => FinalCompileHow -> [HsName] -> HsName -> EHCompilePhaseT m () cpCompileWithGCC how othModNmL modNm = do { cr <- get ; let (ecu,crsi,opts,fp) = crBaseInfo modNm cr fpC = case ecuStateToKind $ ecuState ecu of EHCUKind_C -> fp _ -> mkOutputFPath opts modNm fp "c" fpO m f = mkPerModuleOutputFPath opts False m f "o" fpExec = mkPerExecOutputFPath opts modNm fp (fmap (flip (,) False) Cfg.mbSuffixExec) variant= Cfg.installVariant opts (fpTarg,targOpt,linkOpts,linkLibOpt,dotOFilesOpt,genOFiles ,pgmExec ) = case how of FinalCompile_Exec -> ( fpExec , ( if ehcOptOptimizationLevel opts >= OptimizationLevel_Much then [gccOptF "O2"] else if ehcOptOptimizationLevel opts >= OptimizationLevel_Normal then [gccOptF "O1"] else [] ) ++ Cfg.gccOpts ++ [gccOptOutput $ fpathToStr fpExec] , Cfg.ehcGccOptsStatic' , map (mkl2 Cfg.INST_LIB_PKG2) (if ehcOptWholeProgOptimizationScope opts then [] else map tup123to12 pkgKeyDirL) ++ map (mkl Cfg.INST_LIB) Cfg.libnamesRts ++ map (\l -> gccArg $ Cfg.mkInstallFilePrefix opts Cfg.INST_LIB_SHARED variant "" ++ Cfg.mkCLibFilename "" l) (Cfg.libnamesGcc opts) ++ map gccOptLib Cfg.libnamesGccEhcExtraExternalLibs , if ehcOptWholeProgOptimizationScope opts then [ ] else [ gccArg $ fpathToStr $ fpO m fp | m <- othModNmL2, let (_,_,_,fp) = crBaseInfo m cr ] , [] , PgmExec_Linker ) where -- mkl how l = Cfg.mkCLibFilename (Cfg.mkInstallFilePrefix opts how variant l) l mkl how l = gccArg $ Cfg.mkInstalledRts opts Cfg.mkCLibFilename how variant l mkl2 how (l,d) = gccArg $ Cfg.mkCLibFilename (d ++ "/") (showPkgKey l) {- = Cfg.mkCLibFilename (Cfg.mkInstallFilePrefix opts how variant (showPkgKey l) ++ "/" ++ mkInternalPkgFileBase l (Cfg.installVariant opts) (ehcOptTarget opts) (ehcOptTargetFlavor opts) ++ "/") (showPkgKey l) -} FinalCompile_Module -> (o, Cfg.gccOpts ++ [gccOptF "c", gccOptOutput $ fpathToStr o ], Cfg.ehcGccOptsStatic', [], [], [o] , PgmExec_C ) where o = fpO modNm fp (pkgKeyDirL,othModNmL2) = crPartitionIntoPkgAndOthers cr othModNmL pkgKeyL = map tup123to1 pkgKeyDirL ; when (targetIsC (ehcOptTarget opts)) (do { let compileC = mkShellCmd' [Cmd_CPP, Cmd_C] (Cfg.shellCmdOverride opts Cfg.shellCmdGcc pgmExec) ( gccDefs opts ["O"] ++ [ cppOptI $ Cfg.mkInstallFilePrefix opts Cfg.INST_INCLUDE variant "" ] ++ [ cppOptI $ Cfg.mkInstallFilePrefix opts Cfg.INST_INCLUDE_SHARED variant "" ] ++ [ cppOptI d | d <- gccInclDirs opts pkgKeyDirL ] ++ linkOpts ++ targOpt ++ ehcOptCmdLineOpts opts ++ dotOFilesOpt ++ [ gccArg $ fpathToStr fpC ] ++ linkLibOpt ) ; when (ehcOptVerbosity opts >= VerboseALot) (do { cpMsg' modNm VerboseALot "GCC" Nothing fpTarg ; liftIO $ putStrLn $ showShellCmd compileC }) ; when (ehcOptVerbosity opts >= VerboseDebug) (do { liftIO $ putStrLn ("pkgs : " ++ show pkgKeyL) ; liftIO $ putStrLn ("pkgdirs : " ++ show pkgKeyDirL) ; liftIO $ putStrLn ("other: " ++ show othModNmL2) }) ; cpSeq [ cpSystem' Nothing compileC , cpUpdCU modNm (ecuStoreGenCodeFiles genOFiles) ] }) } {-# LINE 196 "src/ehc/EHC/CompilePhase/CompileC.chs" #-} cpPreprocessWithCPP :: EHCCompileRunner m => [PkgModulePartition] -> HsName -> EHCompilePhaseT m FPath cpPreprocessWithCPP pkgKeyDirL modNm = do { cr <- get ; let (ecu,crsi,opts,fp) = crBaseInfo modNm cr fpCPP = fpathSetSuff {- mkOutputFPath opts modNm fp -} (maybe "" (\s -> s ++ "-") (fpathMbSuff fp) ++ "cpp") fp -- fpCPP = fpathSetBase {- mkOutputFPath opts modNm fp -} (fpathBase fp ++ "-cpp") fp ; {- when ( ehcOptCPP opts || modNm == hsnModIntlBase -- 20080211, AD: builtin hack to preprocess EHC.Prelude with cpp, for now, to avoid implementation of pragmas ) -} (do { let shellCmdCpp = Cfg.shellCmdOverride opts Cfg.shellCmdCpp PgmExec_CPP shellCmdCppOpts = execOptsPlain $ Map.findWithDefault [] shellCmdCpp $ ehcOptExecOptsMp opts preCPP = mkShellCmd' [Cmd_CPP,Cmd_CPP_Preprocessing] shellCmdCpp ( Cfg.cppOpts ++ gccDefs opts ["CPP"] ++ map cppOptF shellCmdCppOpts -- [ {- "traditional-cpp", -} {- "std=gnu99", -} "fno-show-column", "P" ] ++ [ cppOptI d | d <- gccInclDirs opts pkgKeyDirL ] ++ ehcOptCmdLineOpts opts ++ map (cppArg . fpathToStr) [ fp ] -- , fpCPP ] ) ; when (ehcOptVerbosity opts >= VerboseALot) (do { cpMsg modNm VerboseALot "CPP" -- ; liftIO $ putStrLn ("pkg db: " ++ show (ehcOptPkgDb opts)) -- ; liftIO $ putStrLn ("pkg srch filter: " ++ (show $ ehcOptPackageSearchFilter opts)) -- ; liftIO $ putStrLn ("exposed pkgs: " ++ show (pkgExposedPackages $ ehcOptPkgDb opts)) -- ; liftIO $ putStrLn ("pkgKeyDirL: " ++ show pkgKeyDirL) ; liftIO $ putStrLn $ showShellCmd preCPP }) ; when (ecuCanCompile ecu) (do { liftIO $ fpathEnsureExists fpCPP ; cpSystem' (Just $ fpathToStr fpCPP) preCPP ; cpRegisterFilesToRm [fpCPP] }) -- ; cpUpdCU modNm (ecuStoreSrcFilePath fpCPP) ; cpUpdCU modNm (ecuStoreCppFilePath fpCPP) ; return fpCPP }) }