X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FMain.hs;h=fb1556c49926efeca7ba20add36bcb79954ffcdc;hb=d6afbe3ebd127ece764bc943c015e74290318b6a;hp=9db7ba3c9d1f89d9af6d19b63acf9157ead80fc4;hpb=110a35dc422a67e79baf1e101a19284dc7168908;p=ghc-hetmet.git

diff --git a/ghc/compiler/main/Main.hs b/ghc/compiler/main/Main.hs
index 9db7ba3..fb1556c 100644
--- 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.85 2001/08/08 08:44:47 simonmar Exp $
+-- $Id: Main.hs,v 1.91 2001/11/03 01:30:42 sof 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,13 +36,14 @@ 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)
 
 import DriverMkDepend	( beginMkDependHS, endMkDependHS )
-import DriverPhases	( Phase(Hsc, HCc), haskellish_src_file, objish_file )
+import DriverPhases	( Phase(HsPp, Hsc, HCc), haskellish_src_file, objish_file )
 
 import DriverUtil	( add, handle, handleDyn, later, splitFilename,
 			  unknownFlagErr, getFileSuffix )
@@ -112,6 +113,7 @@ import Dynamic		( toDyn )
 main =
   -- top-level exception handler: any unrecognised exception is a compiler bug.
   handle (\exception -> do
+  	   hFlush stdout
 	   case exception of
 		-- an IO exception probably isn't our fault, so don't panic
 		IOException _ ->  hPutStr stderr (show exception)
@@ -120,11 +122,13 @@ main =
          ) $ do
 
   -- all error messages are propagated as exceptions
-  handleDyn (\dyn -> case dyn of
-			  PhaseFailed _phase code -> exitWith code
-			  Interrupted -> exitWith (ExitFailure 1)
-			  _ -> do hPutStrLn stderr (show (dyn :: GhcException))
-			          exitWith (ExitFailure 1)
+  handleDyn (\dyn -> do
+  		hFlush stdout
+  		case dyn of
+		     PhaseFailed _phase code -> exitWith code
+		     Interrupted -> exitWith (ExitFailure 1)
+		     _ -> do hPutStrLn stderr (show (dyn :: GhcException))
+			     exitWith (ExitFailure 1)
 	    ) $ do
 
    -- make sure we clean up after ourselves
@@ -151,10 +155,8 @@ 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'
@@ -212,10 +214,7 @@ main =
 			  	 -- leave out hscOutName for now
 	                  	 hscOutName = panic "Main.main:hscOutName not set",
 
-			  	 verbosity = case mode of
-						DoInteractive -> 1
-						DoMake	      -> 1
-						_other        -> 0,
+			  	 verbosity = 1
 				})
 
 	-- the rest of the arguments are "dynamic"
@@ -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
@@ -260,7 +260,7 @@ main =
 	-- -ohi sanity checking
    ohi    <- readIORef v_Output_hi
    if (isJust ohi && 
-	(mode == DoMake || mode == DoInteractive || length srcs > 1))
+	(mode == DoMake || mode == DoInteractive || srcs `lengthExceeds` 1))
 	then throwDyn (UsageError "-ohi can only be used when compiling a single source file")
 	else do
 
@@ -270,7 +270,7 @@ main =
 
 	-- -o sanity checking
    o_file <- readIORef v_Output_file
-   if (length srcs > 1 && isJust o_file && mode /= DoLink && mode /= DoMkDLL)
+   if (srcs `lengthExceeds` 1 && isJust o_file && mode /= DoLink && mode /= DoMkDLL)
 	then throwDyn (UsageError "can't apply -o to multiple source files")
 	else do
 
@@ -289,11 +289,12 @@ main =
 
 	  -- just preprocess (Haskell source only)
    	  let src_and_suff = (src, getFileSuffix src)
-	  pp <- if not (haskellish_src_file src) || mode == StopBefore Hsc
+	  let not_hs_file  = not (haskellish_src_file src)
+	  pp <- if not_hs_file || mode == StopBefore Hsc || mode == StopBefore HsPp
 			then return src_and_suff else do
 		phases <- genPipeline (StopBefore Hsc) stop_flag
-			    False{-not persistent-} defaultHscLang
-			    src_and_suff
+				      False{-not persistent-} defaultHscLang
+				      src_and_suff
 	  	pipeLoop phases src_and_suff False{-no linking-} False{-no -o flag-}
 			basename suffix