[project @ 2001-06-18 08:56:09 by simonpj]

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

diff --git a/ghc/compiler/main/Main.hs b/ghc/compiler/main/Main.hs
index b0cbedd..ebafe83 100644 (file)
--- a/ghc/compiler/main/Main.hs
+++ b/ghc/compiler/main/Main.hs
@@ -1,6 +1,6 @@
 {-# OPTIONS -fno-warn-incomplete-patterns #-}
 -----------------------------------------------------------------------------
--- $Id: Main.hs,v 1.71 2001/06/14 15:42:35 simonpj Exp $
+-- $Id: Main.hs,v 1.73 2001/06/18 08:56:09 simonpj Exp $
 --
 -- GHC Driver program
 --
@@ -23,10 +23,11 @@ import InteractiveUI(ghciWelcomeMsg, interactiveUI)
 
 import Finder          ( initFinder )
 import CompManager     ( cmInit, cmLoadModule )
-import CmStaticInfo    ( GhciMode(..), PackageConfig(..) )
+import HscTypes                ( GhciMode(..) )
 import Config          ( cBooterVersion, cGhcUnregisterised, cProjectVersion )
 import SysTools                ( packageConfigPath, initSysTools, cleanTempFiles )
-import ParsePkgConf    ( parsePkgConf )
+import Packages                ( showPackages, mungePackagePaths )
+import ParsePkgConf    ( loadPackageConfig )
 
 import DriverPipeline  ( GhcMode(..), doLink, doMkDLL, genPipeline,
                          getGhcMode, pipeLoop, v_GhcMode
@@ -42,14 +43,13 @@ import DriverMkDepend       ( beginMkDependHS, endMkDependHS )
 import DriverPhases    ( Phase(Hsc, HCc), haskellish_src_file, objish_file )
 
 import DriverUtil      ( add, handle, handleDyn, later, splitFilename, unknownFlagErr, my_prefix_match )
-import CmdLineOpts     ( dynFlag,
-                         DynFlags(verbosity, stgToDo, hscOutName, hscLang, coreToDo),
-                         HscLang(HscInterpreted, HscC), 
-                         defaultDynFlags, restoreDynFlags, saveDynFlags, setDynFlags, 
+import CmdLineOpts     ( dynFlag, defaultDynFlags, restoreDynFlags, saveDynFlags, setDynFlags, 
+                         DynFlags(..), HscLang(..), 
                          v_Static_hsc_opts
                        )
 
 import Outputable
+import ErrUtils                ( dumpIfSet )
 import Util
 import Panic           ( GhcException(..), panic )
 
@@ -61,7 +61,8 @@ import Exception      ( throwDyn, Exception(DynException) )
 import System          ( getArgs, exitWith, ExitCode(..) )
 
 #ifndef mingw32_TARGET_OS
-import Concurrent      ( myThreadId, throwTo )
+import Concurrent      ( myThreadId )
+import Exception       ( throwTo )
 import Posix           ( Handler(Catch), installHandler, sigINT, sigQUIT )
 import Dynamic         ( toDyn )
 #endif
@@ -138,14 +139,11 @@ main =
    let (minusB_args, argv') = partition (prefixMatch "-B") argv
    top_dir <- initSysTools minusB_args
 
-       -- read the package configuration
-   conf_file <- packageConfigPath
-   r        <- parsePkgConf conf_file
-   case r of {
-       Left err -> throwDyn (InstallationError (showSDoc err));
-       Right pkg_details -> do
-
-   writeIORef v_Package_details (mungePackagePaths top_dir pkg_details)
+       -- 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
 
        -- find the phase to stop after (i.e. -E, -C, -c, -S flags)
    (flags2, mode, stop_flag) <- getGhcMode argv'
@@ -222,6 +220,7 @@ main =
        -- complain about any unknown flags
    mapM unknownFlagErr [ f | f@('-':_) <- srcs ]
 
+       -- Display details of the configuration in verbose mode
    verb <- dynFlag verbosity
 
    when (verb >= 2) 
@@ -236,6 +235,8 @@ main =
    when (verb >= 3) 
        (hPutStrLn stderr ("Hsc static flags: " ++ unwords static_opts))
 
+   showPackages pkg_details
+
        -- initialise the finder
    pkg_avails <- getPackageInfo
    initFinder pkg_avails
@@ -293,22 +294,7 @@ main =
    when (mode == DoMkDependHS) endMkDependHS
    when (mode == DoLink) (doLink o_files)
    when (mode == DoMkDLL) (doMkDLL o_files)
-  }
-
-
--- replace the string "$libdir" at the beginning of a path with the
--- current libdir (obtained from the -B option).
-mungePackagePaths top_dir ps = map munge_pkg ps
- where 
-  munge_pkg p = p{ import_dirs  = munge_paths (import_dirs p),
-                  include_dirs = munge_paths (include_dirs p),
-                  library_dirs = munge_paths (library_dirs p) }
-
-  munge_paths = map munge_path
 
-  munge_path p 
-         | Just p' <- my_prefix_match "$libdir" p = top_dir ++ p'
-         | otherwise = trace ("not: " ++ p) p
 
 
 beginMake :: [String] -> IO ()