[project @ 2001-08-14 13:40:07 by sewardj]

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

diff --git a/ghc/compiler/main/Main.hs b/ghc/compiler/main/Main.hs
index 5cf7ddf..b11326c 100644 (file)
--- a/ghc/compiler/main/Main.hs
+++ b/ghc/compiler/main/Main.hs
@@ -1,6 +1,7 @@
-{-# OPTIONS -fno-warn-incomplete-patterns #-}
+{-# OPTIONS -fno-warn-incomplete-patterns -optc-DNON_POSIX_SOURCE #-}
+
 -----------------------------------------------------------------------------
--- $Id: Main.hs,v 1.78 2001/06/29 15:30:49 simonmar Exp $
+-- $Id: Main.hs,v 1.87 2001/08/14 13:40:08 sewardj Exp $
 --
 -- GHC Driver program
 --
@@ -25,9 +26,8 @@ import Finder         ( initFinder )
 import CompManager     ( cmInit, cmLoadModule )
 import HscTypes                ( GhciMode(..) )
 import Config          ( cBooterVersion, cGhcUnregisterised, cProjectVersion )
-import SysTools                ( packageConfigPath, initSysTools, cleanTempFiles )
-import Packages                ( showPackages, mungePackagePaths )
-import ParsePkgConf    ( loadPackageConfig )
+import SysTools                ( getPackageConfigPath, initSysTools, cleanTempFiles )
+import Packages                ( showPackages )
 
 import DriverPipeline  ( GhcMode(..), doLink, doMkDLL, genPipeline,
                          getGhcMode, pipeLoop, v_GhcMode
@@ -36,7 +36,8 @@ import DriverState    ( buildCoreToDo, buildStgToDo, defaultHscLang,
                          findBuildTag, getPackageInfo, unregFlags, 
                          v_Cmdline_libraries, v_Keep_tmp_files, v_Ld_inputs,
                          v_OptLevel, v_Output_file, v_Output_hi, 
-                         v_Package_details, v_Ways, getPackageExtraGhcOpts
+                         v_Package_details, v_Ways, getPackageExtraGhcOpts,
+                         readPackageConf
                        )
 import DriverFlags     ( dynFlag, buildStaticHscOpts, dynamic_flags,
                          processArgs, static_flags)
@@ -45,7 +46,7 @@ import DriverMkDepend ( beginMkDependHS, endMkDependHS )
 import DriverPhases    ( Phase(Hsc, HCc), haskellish_src_file, objish_file )
 
 import DriverUtil      ( add, handle, handleDyn, later, splitFilename,
-                         unknownFlagErr )
+                         unknownFlagErr, getFileSuffix )
 import CmdLineOpts     ( dynFlag, defaultDynFlags, restoreDynFlags,
                          saveDynFlags, setDynFlags, 
                          DynFlags(..), HscLang(..), v_Static_hsc_opts
@@ -151,21 +152,13 @@ main =
    top_dir <- initSysTools minusB_args
 
        -- Read the package configuration
-   conf_file        <- packageConfigPath
-   proto_pkg_details <- loadPackageConfig conf_file
-   let pkg_details    = mungePackagePaths top_dir proto_pkg_details
-   writeIORef v_Package_details pkg_details
+   conf_file <- getPackageConfigPath
+   readPackageConf conf_file
 
        -- find the phase to stop after (i.e. -E, -C, -c, -S flags)
    (flags2, mode, stop_flag) <- getGhcMode argv'
    writeIORef v_GhcMode mode
 
-       -- Show the GHCi banner?
-#  ifdef GHCI
-   when (mode == DoInteractive) $
-      hPutStrLn stdout ghciWelcomeMsg
-#  endif
-
        -- process all the other arguments, and get the source files
    non_static <- processArgs static_flags flags2 []
 
@@ -233,9 +226,15 @@ main =
        -- complain about any unknown flags
    mapM unknownFlagErr [ f | f@('-':_) <- srcs ]
 
-       -- Display details of the configuration in verbose mode
    verb <- dynFlag verbosity
 
+       -- Show the GHCi banner
+#  ifdef GHCI
+   when (mode == DoInteractive && verb >= 1) $
+      hPutStrLn stdout ghciWelcomeMsg
+#  endif
+
+       -- Display details of the configuration in verbose mode
    when (verb >= 2) 
        (do hPutStr stderr "Glasgow Haskell Compiler, Version "
            hPutStr stderr cProjectVersion
@@ -245,11 +244,12 @@ main =
    when (verb >= 2) 
        (hPutStrLn stderr ("Using package config file: " ++ conf_file))
 
+   pkg_details <- readIORef v_Package_details
+   showPackages pkg_details
+
    when (verb >= 3) 
        (hPutStrLn stderr ("Hsc static flags: " ++ unwords static_opts))
 
-   showPackages pkg_details
-
        -- initialise the finder
    pkg_avails <- getPackageInfo
    initFinder pkg_avails
@@ -288,18 +288,20 @@ main =
          let (basename, suffix) = splitFilename src
 
          -- just preprocess (Haskell source only)
+         let src_and_suff = (src, getFileSuffix src)
          pp <- if not (haskellish_src_file src) || mode == StopBefore Hsc
-                       then return src else do
+                       then return src_and_suff else do
                phases <- genPipeline (StopBefore Hsc) stop_flag
-                           False{-not persistent-} defaultHscLang src
-               pipeLoop phases src False{-no linking-} False{-no -o flag-}
+                           False{-not persistent-} defaultHscLang
+                           src_and_suff
+               pipeLoop phases src_and_suff False{-no linking-} False{-no -o flag-}
                        basename suffix
 
          -- rest of compilation
          hsc_lang <- dynFlag hscLang
-         phases <- genPipeline mode stop_flag True hsc_lang pp
-         r <- pipeLoop phases pp (mode==DoLink || mode==DoMkDLL) True{-use -o flag-}
-                       basename suffix
+         phases   <- genPipeline mode stop_flag True hsc_lang pp
+         (r,_)    <- pipeLoop phases pp (mode==DoLink || mode==DoMkDLL)
+                                     True{-use -o flag-} basename suffix
          return r
 
    o_files <- mapM compileFile srcs
@@ -318,7 +320,8 @@ beginMake fileish_args
        case mods of
         []    -> throwDyn (UsageError "no input files")
         mod   -> do state <- cmInit Batch
-                    cmLoadModule state mods
+                    (_, ok, _) <- cmLoadModule state mods
+                    when (not ok) (exitWith (ExitFailure 1))
                     return ()