[project @ 2004-08-13 13:04:50 by simonmar]

[ghc-hetmet.git] / ghc / compiler / main / Main.hs

diff --git a/ghc/compiler/main/Main.hs b/ghc/compiler/main/Main.hs
index 5c66a92..7a2ae0c 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 #-}
 
 -----------------------------------------------------------------------------
--- $Id: Main.hs,v 1.132 2003/09/04 11:08:47 simonmar Exp $
+-- $Id: Main.hs,v 1.138 2004/08/13 13:07:05 simonmar Exp $
 --
 -- GHC Driver program
 --
@@ -10,7 +10,7 @@
 -----------------------------------------------------------------------------
 
 -- with path so that ghc -M can find config.h
-#include "../includes/config.h"
+#include "../includes/ghcconfig.h"
 
 module Main (main) where
 
@@ -31,12 +31,12 @@ import Packages             ( showPackages, getPackageConfigMap, basePackage,
                          haskell98Package
                        )
 import DriverPipeline  ( staticLink, doMkDLL, runPipeline )
-import DriverState     ( buildCoreToDo, buildStgToDo,
+import DriverState     ( buildStgToDo,
                          findBuildTag, 
                          getPackageExtraGhcOpts, unregFlags, 
                          v_GhcMode, v_GhcModeFlag, GhcMode(..),
                          v_Keep_tmp_files, v_Ld_inputs, v_Ways, 
-                         v_OptLevel, v_Output_file, v_Output_hi, 
+                         v_Output_file, v_Output_hi, 
                          readPackageConf, verifyOutputFiles, v_NoLink,
                          v_Build_tag
                        )
@@ -44,7 +44,7 @@ import DriverFlags    ( buildStaticHscOpts,
                          dynamic_flags, processArgs, static_flags)
 
 import DriverMkDepend  ( beginMkDependHS, endMkDependHS )
-import DriverPhases    ( isSourceFile )
+import DriverPhases    ( isSourceFilename )
 
 import DriverUtil      ( add, handle, handleDyn, later, unknownFlagsErr )
 import CmdLineOpts     ( dynFlag, restoreDynFlags,
@@ -99,8 +99,7 @@ main =
                -- an IO exception probably isn't our fault, so don't panic
                IOException _ ->  hPutStrLn stderr (show exception)
                AsyncException StackOverflow ->
-                       hPutStrLn stderr "stack overflow: use +RTS -K<size> \ 
-                                        \to increase it"
+                       hPutStrLn stderr "stack overflow: use +RTS -K<size> to increase it"
                _other ->  hPutStr stderr (show (Panic (show exception)))
           exitWith (ExitFailure 1)
          ) $ do
@@ -141,10 +140,6 @@ main =
 
        -- -O and --interactive are not a good combination
        -- ditto with any kind of way selection
-   orig_opt_level <- readIORef v_OptLevel
-   when (orig_opt_level > 0 && isInteractive mode) $
-      do putStr "warning: -O conflicts with --interactive; -O turned off.\n"
-         writeIORef v_OptLevel 0
    orig_ways <- readIORef v_Ways
    when (notNull orig_ways && isInteractive mode) $
       do throwDyn (UsageError 
@@ -167,24 +162,18 @@ main =
    -- build the default DynFlags (these may be adjusted on a per
    -- module basis by OPTIONS pragmas and settings in the interpreter).
 
-   core_todo <- buildCoreToDo
    stg_todo  <- buildStgToDo
 
    -- set the "global" HscLang.  The HscLang can be further adjusted on a module
    -- by module basis, using only the -fvia-C and -fasm flags.  If the global
    -- HscLang is not HscC or HscAsm, -fvia-C and -fasm have no effect.
    dyn_flags <- getDynFlags
-   build_tag <- readIORef v_Build_tag
    let lang = case mode of 
                 DoInteractive  -> HscInterpreted
                 DoEval _       -> HscInterpreted
-                _other | build_tag /= "" -> HscC
-                       | otherwise       -> hscLang dyn_flags
-               -- for ways other that the normal way, we must 
-               -- compile via C.
+                _other         -> hscLang dyn_flags
 
-   setDynFlags (dyn_flags{ coreToDo = core_todo,
-                          stgToDo  = stg_todo,
+   setDynFlags (dyn_flags{ stgToDo  = stg_todo,
                           hscLang  = lang,
                           -- leave out hscOutName for now
                           hscOutName = panic "Main.main:hscOutName not set",
@@ -218,7 +207,7 @@ main =
       Everything else is considered to be a linker object, and passed
       straight through to the linker.
     -}
-    looks_like_an_input m =  isSourceFile m 
+    looks_like_an_input m =  isSourceFilename m 
                          || looksLikeModuleName m
                          || '.' `notElem` m
 
@@ -228,7 +217,9 @@ main =
     normal_fileish_paths = map normalisePath fileish_args
     (srcs, objs)         = partition looks_like_an_input normal_fileish_paths
 
-   mapM_ (add v_Ld_inputs) objs
+    -- Note: have v_Ld_inputs maintain the order in which 'objs' occurred on 
+    --       the command-line.
+   mapM_ (add v_Ld_inputs) (reverse objs)
 
        ---------------- Display banners and configuration -----------
    showBanners mode conf_file static_opts
@@ -338,9 +329,9 @@ doMake :: [String] -> IO ()
 doMake []    = throwDyn (UsageError "no input files")
 doMake srcs  = do 
     dflags <- getDynFlags 
-    state  <- cmInit Batch
-    graph  <- cmDepAnal state dflags srcs
-    (_, ok_flag, _) <- cmLoadModules state dflags graph
+    state  <- cmInit Batch dflags
+    graph  <- cmDepAnal state srcs
+    (_, ok_flag, _) <- cmLoadModules state graph
     when (failed ok_flag) (exitWith (ExitFailure 1))
     return ()