Skip to content

Comparing changes

Choose two branches to see what’s changed or to start a new pull request. If you need to, you can also compare across forks.

Open a pull request

Create a new pull request by comparing changes across two branches. If you need to, you can also compare across forks.
...
  • 2 commits
  • 10 files changed
  • 0 commit comments
  • 1 contributor
View
2 EHC/src/ehc/Config.chs.in
@@ -17,7 +17,7 @@
%%[8 import({%{EH}Opts.CommandLine})
%%]
-%%[8 import({%{EH}ConfigDefines}, {%{EH}Opts}) export(module {%{EH}ConfigDefines})
+%%[8 import({%{EH}ConfigDefines}, {%{EH}Opts.Base}) export(module {%{EH}ConfigDefines})
%%]
%%[8 import({%{EH}EHC.Environment})
View
2 EHC/src/ehc/ConfigDefines.chs.in
@@ -4,7 +4,7 @@
%%[8 module {%{EH}ConfigDefines}
%%]
-%%[8 import({%{EH}Opts})
+%%[8 import({%{EH}Opts.Base})
%%]
%%[50 import(Data.Word, Data.Char)
%%]
View
13 EHC/src/ehc/EHC/Common.chs
@@ -166,12 +166,15 @@ data FinalCompileHow
%%% Shell command construction
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%[8 export(mkShellCmd,mkShellCmd')
-mkShellCmd' :: [Cmd] -> String -> CmdLineOpts -> String
-mkShellCmd' forCmds cmdStr o = concat $ intersperse " " [cmdStr, showCmdLineOpts' forCmds o]
+%%[8 export(mkShellCmd,mkShellCmd',showShellCmd)
+mkShellCmd' :: [Cmd] -> FilePath -> CmdLineOpts -> (FilePath,[String])
+mkShellCmd' forCmds cmdStr o = (cmdStr, showCmdLineOpts' forCmds o)
-mkShellCmd :: [String] -> String
-mkShellCmd = concat . intersperse " "
+mkShellCmd :: [String] -> (FilePath,[String])
+mkShellCmd (cmd:args) = (cmd,args)
+
+showShellCmd :: (FilePath,[String]) -> String
+showShellCmd (cmd,args) = concat $ intersperse " " $ [cmd] ++ args
%%]
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
View
25 EHC/src/ehc/EHC/CompilePhase/CompileC.chs
@@ -14,6 +14,8 @@ C + CPP compilation
-- general imports
%%[8 import(Data.Char,Data.Maybe)
%%]
+%%[8 import(qualified Data.Map as Map)
+%%]
%%[8 import({%{EH}EHC.Common})
%%]
%%[8 import({%{EH}EHC.CompileUnit})
@@ -81,7 +83,7 @@ cpCompileWithGCC how othModNmL modNm
fpO m f = mkPerModuleOutputFPath opts False m f "o"
fpExec = mkPerExecOutputFPath opts modNm fp Cfg.mbSuffixExec
variant= Cfg.installVariant opts
- (fpTarg,targOpt,linkOpts,linkLibOpt,dotOFilesOpt,genOFiles)
+ (fpTarg,targOpt,linkOpts,linkLibOpt,dotOFilesOpt,genOFiles,pgmExec)
= case how of
FinalCompile_Exec
-> ( fpExec
@@ -106,6 +108,7 @@ cpCompileWithGCC how othModNmL modNm
%%]]
[ 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
@@ -122,7 +125,7 @@ cpCompileWithGCC how othModNmL modNm
-}
%%]]
FinalCompile_Module
- -> (o, Cfg.gccOpts ++ [gccOptF "c", gccOptOutput $ fpathToStr o ], Cfg.ehcGccOptsStatic', [], [], [o])
+ -> (o, Cfg.gccOpts ++ [gccOptF "c", gccOptOutput $ fpathToStr o ], Cfg.ehcGccOptsStatic', [], [], [o], PgmExec_C)
where o = fpO modNm fp
%%[[8
pkgKeyL = [] :: [String]
@@ -133,7 +136,7 @@ cpCompileWithGCC how othModNmL modNm
%%]]
; when (targetIsC (ehcOptTarget opts))
(do { let compileC
- = mkShellCmd' [Cmd_CPP, Cmd_C] Cfg.shellCmdGcc
+ = 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 "" ]
@@ -151,7 +154,7 @@ cpCompileWithGCC how othModNmL modNm
)
; when (ehcOptVerbosity opts >= VerboseALot)
(do { cpMsg' modNm VerboseALot "GCC" Nothing fpTarg
- ; lift $ putStrLn compileC
+ ; lift $ putStrLn $ showShellCmd compileC
})
; when (ehcOptVerbosity opts >= VerboseDebug)
(do { lift $ putStrLn ("pkgs : " ++ show pkgKeyL)
@@ -160,7 +163,7 @@ cpCompileWithGCC how othModNmL modNm
%%]]
; lift $ putStrLn ("other: " ++ show othModNmL2)
})
- ; cpSeq [ cpSystem compileC
+ ; cpSeq [ cpSystem' Nothing compileC
%%[[99
, cpUpdCU modNm (ecuStoreGenCodeFiles genOFiles)
%%]]
@@ -178,14 +181,16 @@ cpPreprocessWithCPP pkgKeyDirL modNm
; {- when ( ehcOptCPP opts
|| modNm == hsnModIntlBase -- 20080211, AD: builtin hack to preprocess EHC.Prelude with cpp, for now, to avoid implementation of pragmas
) -}
- (do { let preCPP = mkShellCmd' [Cmd_CPP,Cmd_CPP_Preprocessing] (Cfg.shellCmdOverride opts Cfg.shellCmdCpp PgmExec_CPP)
+ (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 [ {- "traditional-cpp", -} {- "std=gnu99", -} "fno-show-column", "P" ]
+ ++ map cppOptF shellCmdCppOpts -- [ {- "traditional-cpp", -} {- "std=gnu99", -} "fno-show-column", "P" ]
%%[[(99 codegen)
++ [ cppOptI d | d <- gccInclDirs opts pkgKeyDirL ]
%%]]
++ ehcOptCmdLineOpts opts
- ++ map (cppArg . fpathToStr) [ fp, fpCPP ]
+ ++ map (cppArg . fpathToStr) [ fp ] -- , fpCPP ]
)
; when (ehcOptVerbosity opts >= VerboseALot)
(do { cpMsg modNm VerboseALot "CPP"
@@ -193,11 +198,11 @@ cpPreprocessWithCPP pkgKeyDirL modNm
-- ; lift $ putStrLn ("pkg srch filter: " ++ (show $ ehcOptPackageSearchFilter opts))
-- ; lift $ putStrLn ("exposed pkgs: " ++ show (pkgExposedPackages $ ehcOptPkgDb opts))
-- ; lift $ putStrLn ("pkgKeyDirL: " ++ show pkgKeyDirL)
- ; lift $ putStrLn preCPP
+ ; lift $ putStrLn $ showShellCmd preCPP
})
; when (crModCanCompile modNm cr)
(do { lift $ fpathEnsureExists fpCPP
- ; cpSystem preCPP
+ ; cpSystem' (Just $ fpathToStr fpCPP) preCPP
%%[[99
; cpRegisterFilesToRm [fpCPP]
%%]]
View
6 EHC/src/ehc/EHC/CompilePhase/CompileJavaScript.chs
@@ -39,9 +39,9 @@ cpJavaScript :: String -> [String] -> EHCompilePhase ()
cpJavaScript archive files
= do { cr <- get
; let (_,opts) = crBaseInfo' cr
- cmd = mkShellCmd $ [Cfg.shellCmdCat] ++ files ++ [">", archive]
- ; when (ehcOptVerbosity opts >= VerboseALot) (lift $ putStrLn cmd)
- ; cpSystem cmd
+ cmd = mkShellCmd $ [Cfg.shellCmdCat] ++ files -- ++ [">", archive]
+ ; when (ehcOptVerbosity opts >= VerboseALot) (lift $ putStrLn $ showShellCmd cmd)
+ ; cpSystem' (Just archive) cmd
}
%%]
View
2 EHC/src/ehc/EHC/CompilePhase/Link.chs
@@ -40,7 +40,7 @@ cpLinkO modNmL pkgNm
where l = mkFPath $ Cfg.mkCLibFilename "" pkgNm
linkCode = map mkShellCmd $ Cfg.mkShellCmdLibtool (fpathToStr libFile) codeFiles
; when (ehcOptVerbosity opts >= VerboseALot)
- (do { lift $ mapM_ putStrLn linkCode
+ (do { lift $ mapM_ (putStrLn . showShellCmd) linkCode
})
; unless (null codeFiles)
(cpSeq [ cpSystem c | c <- linkCode ])
View
31 EHC/src/ehc/EHC/CompileRun.chs
@@ -339,18 +339,35 @@ cpSetUID u
%%% Compile actions: shell/system/cmdline invocation
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%[8 export(cpSystem)
-cpSystem :: String -> EHCompilePhase ()
-cpSystem cmd
- = do { exitCode <- lift $ system cmd
+%%[8 export(cpSystem',cpSystem)
+cpSystem' :: Maybe FilePath -> (FilePath,[String]) -> EHCompilePhase ()
+cpSystem' mbStdOut (cmd,args)
+ = do { exitCode <- lift $ system $ showShellCmd $ (cmd,args ++ (maybe [] (\o -> [">", o]) mbStdOut))
; case exitCode of
ExitSuccess -> return ()
_ -> cpSetFail
}
+
+cpSystem :: (FilePath,[String]) -> EHCompilePhase ()
+cpSystem = cpSystem' Nothing
%%]
- _ -> do { lift $ putStrLn ("cpSystem ERR: " ++ show exitCode)
- ; cpSetFail
- }
+cpSystem' :: (FilePath,[String]) -> Maybe FilePath -> EHCompilePhase ()
+cpSystem' (cmd,args) mbStdOut
+ = do { exitcode <- lift $ do
+ proc <- runProcess cmd args Nothing Nothing Nothing Nothing Nothing
+ waitForProcess proc
+ ; case exitCode of
+ ExitSuccess -> return ()
+ _ -> cpSetFail
+ }
+
+cpSystem' :: (FilePath,[String]) -> Maybe FilePath -> EHCompilePhase ()
+cpSystem' (cmd,args) mbStdOut
+ = do { exitCode <- lift $ system cmd
+ ; case exitCode of
+ ExitSuccess -> return ()
+ _ -> cpSetFail
+ }
%%[8 export(cpSystemRaw)
cpSystemRaw :: String -> [String] -> EHCompilePhase ()
View
17 EHC/src/ehc/Opts.chs
@@ -52,7 +52,7 @@
%%[(93 hmtyinfer) import({%{EH}Error})
%%]
-%%[99 import(qualified {%{EH}ConfigInstall} as Cfg)
+%%[99 import(qualified {%{EH}Config} as Cfg)
%%]
%%[99 import({%{EH}Base.Pragma}, {%{EH}Opts.CommandLine}, {%{EH}Base.Parser}, {%{EH}Base.Parser2})
@@ -149,6 +149,8 @@ tycoreOptMp
%%[99
instance Show PgmExec where
show PgmExec_CPP = "P"
+ show PgmExec_C = "c"
+ show PgmExec_Linker = "l"
pgmExecMp :: Map.Map String PgmExec
pgmExecMp = optMp
@@ -194,15 +196,6 @@ ehcOptErrAboutBytecode = targetIsGrinBytecode . ehcOptTarget
%%]]
%%]
-%%[(8 codegen grin) export(ehcOptEmitExecBytecode, ehcOptEmitBytecode)
--- generate bytecode
-ehcOptEmitExecBytecode :: EHCOpts -> Bool
-ehcOptEmitExecBytecode = targetIsGrinBytecode . ehcOptTarget
-
-ehcOptEmitBytecode :: EHCOpts -> Bool
-ehcOptEmitBytecode = ehcOptEmitExecBytecode
-%%]
-
%%[(8 codegen grin) export(ehcOptEmitC)
-- generate C
ehcOptEmitC :: EHCOpts -> Bool
@@ -258,6 +251,10 @@ ehcOptOptimizes o opts = o `Set.member` ehcOptOptimizations opts
%%[1.defaultEHCOpts export(defaultEHCOpts)
defaultEHCOpts
= emptyEHCOpts
+ { ehcOptExecOptsMp = ehcOptExecOptsMp emptyEHCOpts `Map.union` Map.fromList
+ [ (Cfg.shellCmdCpp, [ExecOpt_Plain "fno-show-column", ExecOpt_Plain "P"])
+ ]
+ }
%%]
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
View
24 EHC/src/ehc/Opts/Base.chs
@@ -123,9 +123,21 @@ data TyCoreOpt
-- | Pgm (internal program used) options, in particular alternate internal shell commands
data PgmExec
= PgmExec_CPP -- alternate CPP
+ | PgmExec_C -- alternate C compiler
+ | PgmExec_Linker -- alternate linker
deriving (Eq,Ord,Enum,Bounded)
%%]
+%%[99 export(ExecOpt(..),execOptsPlain)
+-- | Wrapper around options, adding semantics for adapting cmd specific behavior
+data ExecOpt
+ = ExecOpt_Plain String -- ^ plain option
+ | ExecOpt_Output (String -> String) -- ^ output file
+
+execOptsPlain :: [ExecOpt] -> [String]
+execOptsPlain o = [ s | ExecOpt_Plain s <- o ]
+%%]
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% Compiler options
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -266,6 +278,8 @@ data EHCOpts
:: Bool -- allow overloaded strings
, ehcOptPgmExecMp :: Map.Map PgmExec FilePath
-- alternate executables for program
+ , ehcOptExecOptsMp :: Map.Map FilePath [ExecOpt]
+ -- default options for commands
%%]]
}
%%]
@@ -415,6 +429,7 @@ emptyEHCOpts
= False
, ehcOptOverloadedStrings= False
, ehcOptPgmExecMp = Map.empty
+ , ehcOptExecOptsMp = Map.empty
%%]]
}
%%]
@@ -465,6 +480,15 @@ ehcOptCoreSysFCheckOnlyVal opts = ehcOptCoreSysFCheck opts
%%]]
%%]
+%%[(8 codegen grin) export(ehcOptEmitExecBytecode, ehcOptEmitBytecode)
+-- generate bytecode
+ehcOptEmitExecBytecode :: EHCOpts -> Bool
+ehcOptEmitExecBytecode = targetIsGrinBytecode . ehcOptTarget
+
+ehcOptEmitBytecode :: EHCOpts -> Bool
+ehcOptEmitBytecode = ehcOptEmitExecBytecode
+%%]
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% Getting a builtin name via EHCOpts
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
View
6 EHC/src/ehc/Opts/CommandLine.chs
@@ -95,11 +95,11 @@ gccOptLib = gccOpt . CmdFlag_Lib
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%[8 export(showCmdLineOpts,showCmdLineOpts')
-showCmdLineOpts' :: [Cmd] -> CmdLineOpts -> String
-showCmdLineOpts' forCmds opts = concat $ intersperse " " $ map show $ filter (\o -> cloptForCmd o `elem` forCmds) opts
+showCmdLineOpts' :: [Cmd] -> CmdLineOpts -> [String]
+showCmdLineOpts' forCmds opts = map show $ filter (\o -> cloptForCmd o `elem` forCmds) opts
showCmdLineOpts :: CmdLineOpts -> String
-showCmdLineOpts = showCmdLineOpts' [minBound::Cmd .. maxBound]
+showCmdLineOpts = concat . intersperse " " . showCmdLineOpts' [minBound::Cmd .. maxBound]
-- | Show key + value
kv :: String -> String -> Maybe String -> String

No commit comments for this range

Something went wrong with that request. Please try again.