projects
/
ghc-hetmet.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
e82f1ba
)
Make SysTools warning-free
author
Ian Lynagh
<igloo@earth.li>
Thu, 12 Jun 2008 14:17:38 +0000
(14:17 +0000)
committer
Ian Lynagh
<igloo@earth.li>
Thu, 12 Jun 2008 14:17:38 +0000
(14:17 +0000)
compiler/main/SysTools.lhs
patch
|
blob
|
history
diff --git
a/compiler/main/SysTools.lhs
b/compiler/main/SysTools.lhs
index
9fccdc7
..
96833c8
100644
(file)
--- a/
compiler/main/SysTools.lhs
+++ b/
compiler/main/SysTools.lhs
@@
-7,13
+7,6
@@
-----------------------------------------------------------------------------
\begin{code}
-----------------------------------------------------------------------------
\begin{code}
-{-# OPTIONS -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
--- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
-
module SysTools (
-- Initialisation
initSysTools,
module SysTools (
-- Initialisation
initSysTools,
@@
-73,7
+66,7
@@
import CString ( CString, peekCString )
#endif
import System.Process ( runInteractiveProcess, getProcessExitCode )
#endif
import System.Process ( runInteractiveProcess, getProcessExitCode )
-import Control.Concurrent( forkIO, newChan, readChan, writeChan )
+import Control.Concurrent
import FastString
import SrcLoc ( SrcLoc, mkSrcLoc, noSrcSpan, mkSrcSpan )
\end{code}
import FastString
import SrcLoc ( SrcLoc, mkSrcLoc, noSrcSpan, mkSrcSpan )
\end{code}
@@
-156,7
+149,7
@@
initSysTools :: Maybe String -- Maybe TopDir path (without the '-B' prefix)
-- (c) the GHC usage message
-- (c) the GHC usage message
-initSysTools mbMinusB dflags
+initSysTools mbMinusB _
= do { (am_installed, top_dir) <- findTopDir mbMinusB
-- top_dir
-- for "installed" this is the root of GHC's support files
= do { (am_installed, top_dir) <- findTopDir mbMinusB
-- top_dir
-- for "installed" this is the root of GHC's support files
@@
-276,10
+269,6
@@
initSysTools mbMinusB dflags
; let cpp_path = (gcc_prog, gcc_args ++
(Option "-E"):(map Option (words cRAWCPP_FLAGS)))
; let cpp_path = (gcc_prog, gcc_args ++
(Option "-E"):(map Option (words cRAWCPP_FLAGS)))
- -- For all systems, copy and remove are provided by the host
- -- system; architecture-specific stuff is done when building Config.hs
- ; let cp_path = cGHC_CP
-
-- Other things being equal, as and ld are simply gcc
; let (as_prog,as_args) = (gcc_prog,gcc_args)
(ld_prog,ld_args) = (gcc_prog,gcc_args)
-- Other things being equal, as and ld are simply gcc
; let (as_prog,as_args) = (gcc_prog,gcc_args)
(ld_prog,ld_args) = (gcc_prog,gcc_args)
@@
-706,8
+695,9
@@
runSomethingFiltered dflags filter_fn phase_name pgm args mb_env = do
(_, ExitSuccess) -> return ()
_ -> throwDyn (PhaseFailed phase_name exit_code)
(_, ExitSuccess) -> return ()
_ -> throwDyn (PhaseFailed phase_name exit_code)
-
-
+builderMainLoop :: DynFlags -> (String -> String) -> FilePath
+ -> [String] -> Maybe [(String, String)]
+ -> IO ExitCode
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 603
builderMainLoop dflags filter_fn pgm real_args mb_env = do
rawSystem pgm real_args
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 603
builderMainLoop dflags filter_fn pgm real_args mb_env = do
rawSystem pgm real_args
@@
-736,7
+726,7
@@
builderMainLoop dflags filter_fn pgm real_args mb_env = do
-- for all of these to happen (status==3).
-- ToDo: we should really have a contingency plan in case any of
-- the threads dies, such as a timeout.
-- for all of these to happen (status==3).
-- ToDo: we should really have a contingency plan in case any of
-- the threads dies, such as a timeout.
- loop chan hProcess 0 0 exitcode = return exitcode
+ loop _ _ 0 0 exitcode = return exitcode
loop chan hProcess t p exitcode = do
mb_code <- if p > 0
then getProcessExitCode hProcess
loop chan hProcess t p exitcode = do
mb_code <- if p > 0
then getProcessExitCode hProcess
@@
-757,6
+747,7
@@
builderMainLoop dflags filter_fn pgm real_args mb_env = do
loop chan hProcess (t-1) p exitcode
| otherwise -> loop chan hProcess t p exitcode
loop chan hProcess (t-1) p exitcode
| otherwise -> loop chan hProcess t p exitcode
+readerProc :: Chan BuildMessage -> Handle -> (String -> String) -> IO ()
readerProc chan hdl filter_fn =
(do str <- hGetContents hdl
loop (linesPlatform (filter_fn str)) Nothing)
readerProc chan hdl filter_fn =
(do str <- hGetContents hdl
loop (linesPlatform (filter_fn str)) Nothing)
@@
-778,6
+769,7
@@
readerProc chan hdl filter_fn =
checkError l ls
Nothing -> do
checkError l ls
checkError l ls
Nothing -> do
checkError l ls
+ _ -> panic "readerProc/loop"
checkError l ls
= case parseError l of
checkError l ls
= case parseError l of
@@
-822,6
+814,7
@@
data BuildMessage
| EOF
#endif
| EOF
#endif
+showOpt :: Option -> String
showOpt (FileOption pre f) = pre ++ f
showOpt (Option s) = s
showOpt (FileOption pre f) = pre ++ f
showOpt (Option s) = s
@@
-841,9
+834,9
@@
traceCmd dflags phase_name cmd_line action
; action `IO.catch` handle_exn verb
}}
where
; action `IO.catch` handle_exn verb
}}
where
- handle_exn verb exn = do { debugTraceMsg dflags 2 (char '\n')
- ; debugTraceMsg dflags 2 (ptext (sLit "Failed:") <+> text cmd_line <+> text (show exn))
- ; throwDyn (PhaseFailed phase_name (ExitFailure 1)) }
+ handle_exn _verb exn = do { debugTraceMsg dflags 2 (char '\n')
+ ; debugTraceMsg dflags 2 (ptext (sLit "Failed:") <+> text cmd_line <+> text (show exn))
+ ; throwDyn (PhaseFailed phase_name (ExitFailure 1)) }
\end{code}
%************************************************************************
\end{code}
%************************************************************************