uhc-light-1.1.9.1: src/UHC/Light/Compiler/EHC/CompilePhase/CompileC.hs
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
})
}