projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
[project @ 2003-07-21 15:14:18 by ross]
[ghc-hetmet.git]
/
ghc
/
compiler
/
main
/
Main.hs
diff --git
a/ghc/compiler/main/Main.hs
b/ghc/compiler/main/Main.hs
index
f6175e7
..
7da0074
100644
(file)
--- a/
ghc/compiler/main/Main.hs
+++ b/
ghc/compiler/main/Main.hs
@@
-1,7
+1,7
@@
{-# OPTIONS -fno-warn-incomplete-patterns -optc-DNON_POSIX_SOURCE #-}
-----------------------------------------------------------------------------
{-# OPTIONS -fno-warn-incomplete-patterns -optc-DNON_POSIX_SOURCE #-}
-----------------------------------------------------------------------------
--- $Id: Main.hs,v 1.125 2003/06/10 17:54:56 sof Exp $
+-- $Id: Main.hs,v 1.131 2003/07/21 15:14:18 ross Exp $
--
-- GHC Driver program
--
--
-- GHC Driver program
--
@@
-97,7
+97,7
@@
main =
hFlush stdout
case exception of
-- an IO exception probably isn't our fault, so don't panic
hFlush stdout
case exception of
-- an IO exception probably isn't our fault, so don't panic
- IOException _ -> hPutStr stderr (show exception)
+ IOException _ -> hPutStrLn stderr (show exception)
AsyncException StackOverflow ->
hPutStrLn stderr "stack overflow: use +RTS -K<size> \
\to increase it"
AsyncException StackOverflow ->
hPutStrLn stderr "stack overflow: use +RTS -K<size> \
\to increase it"
@@
-160,7
+160,7
@@
main =
extra_non_static <- processArgs static_flags
(unreg_opts ++ way_opts ++ pkg_extra_opts) []
extra_non_static <- processArgs static_flags
(unreg_opts ++ way_opts ++ pkg_extra_opts) []
- -- give the static flags to hsc
+ -- Give the static flags to hsc
static_opts <- buildStaticHscOpts
writeIORef v_Static_hsc_opts static_opts
static_opts <- buildStaticHscOpts
writeIORef v_Static_hsc_opts static_opts
@@
-219,12
+219,11
@@
main =
|| looksLikeModuleName m
|| '.' `notElem` m
|| looksLikeModuleName m
|| '.' `notElem` m
- (raw_srcs, objs) = partition looks_like_an_input fileish_args
-
- -- To simplify the handling of filepaths, we normalise all source file
- -- paths right away - e.g., for win32 platforms, backslashes are converted
+ -- To simplify the handling of filepaths, we normalise all filepaths right
+ -- away - e.g., for win32 platforms, backslashes are converted
-- into forward slashes.
-- into forward slashes.
- srcs = map normalisePath raw_srcs
+ normal_fileish_paths = map normalisePath fileish_args
+ (srcs, objs) = partition looks_like_an_input normal_fileish_paths
mapM_ (add v_Ld_inputs) objs
mapM_ (add v_Ld_inputs) objs
@@
-234,6
+233,12
@@
main =
---------------- Final sanity checking -----------
checkOptions mode srcs objs
---------------- Final sanity checking -----------
checkOptions mode srcs objs
+ -- We always link in the base package in
+ -- one-shot linking. Any other packages
+ -- required must be given using -package
+ -- options on the command-line.
+ let def_hs_pkgs = [basePackage, haskell98Package]
+
---------------- Do the business -----------
case mode of
DoMake -> doMake srcs
---------------- Do the business -----------
case mode of
DoMake -> doMake srcs
@@
-243,16
+248,11
@@
main =
endMkDependHS }
StopBefore p -> do { compileFiles mode srcs; return () }
DoMkDLL -> do { o_files <- compileFiles mode srcs;
endMkDependHS }
StopBefore p -> do { compileFiles mode srcs; return () }
DoMkDLL -> do { o_files <- compileFiles mode srcs;
- doMkDLL o_files }
+ doMkDLL o_files def_hs_pkgs }
DoLink -> do { o_files <- compileFiles mode srcs;
omit_linking <- readIORef v_NoLink;
when (not omit_linking)
DoLink -> do { o_files <- compileFiles mode srcs;
omit_linking <- readIORef v_NoLink;
when (not omit_linking)
- (staticLink o_files
- [basePackage, haskell98Package]) }
- -- We always link in the base package in
- -- one-shot linking. Any other packages
- -- required must be given using -package
- -- options on the command-line.
+ (staticLink o_files def_hs_pkgs) }
#ifndef GHCI
DoInteractive -> throwDyn (CmdLineError "not built for interactive use")
#ifndef GHCI
DoInteractive -> throwDyn (CmdLineError "not built for interactive use")
@@
-266,6
+266,10
@@
main =
checkOptions :: GhcMode -> [String] -> [String] -> IO ()
-- Final sanity checking before kicking off a compilation (pipeline).
checkOptions mode srcs objs = do
checkOptions :: GhcMode -> [String] -> [String] -> IO ()
-- Final sanity checking before kicking off a compilation (pipeline).
checkOptions mode srcs objs = do
+ -- Complain about any unknown flags
+ let unknown_opts = [ f | f@('-':_) <- srcs ]
+ when (notNull unknown_opts) (unknownFlagsErr unknown_opts)
+
-- -ohi sanity check
ohi <- readIORef v_Output_hi
if (isJust ohi &&
-- -ohi sanity check
ohi <- readIORef v_Output_hi
if (isJust ohi &&
@@
-285,10
+289,6
@@
checkOptions mode srcs objs = do
then throwDyn (UsageError "no input files")
else do
then throwDyn (UsageError "no input files")
else do
- -- Complain about any unknown flags
- let unknown_opts = [ f | f@('-':_) <- srcs ]
- when (notNull unknown_opts) (unknownFlagsErr unknown_opts)
-
-- Verify that output files point somewhere sensible.
verifyOutputFiles
-- Verify that output files point somewhere sensible.
verifyOutputFiles
@@
-318,7
+318,7
@@
compileFile mode stop_flag src = do
| mode==DoLink || mode==DoMkDLL = Nothing
| otherwise = o_file
| mode==DoLink || mode==DoMkDLL = Nothing
| otherwise = o_file
- runPipeline mode stop_flag True maybe_o_file src
+ runPipeline mode stop_flag True maybe_o_file src Nothing{-no ModLocation-}
-- ----------------------------------------------------------------------------
-- ----------------------------------------------------------------------------