Simplify the -B handling. The interface to the ghc library has changed slightly.

diff --git a/ghc/compiler/main/GHC.hs b/ghc/compiler/main/GHC.hs
index 6f6b7c8..85f62f3 100644 (file)
--- a/ghc/compiler/main/GHC.hs
+++ b/ghc/compiler/main/GHC.hs
@@ -11,7 +11,7 @@ module GHC (
        Session,
        defaultErrorHandler,
        defaultCleanupHandler,
-       init,
+       init, initFromArgs,
        newSession,
 
        -- * Flags and settings
@@ -308,24 +308,32 @@ defaultCleanupHandler dflags inner =
 
 
 -- | Initialises GHC.  This must be done /once/ only.  Takes the
--- command-line arguments.  All command-line arguments which aren't
--- understood by GHC will be returned.
+-- TopDir path without the '-B' prefix.
 
-init :: [String] -> IO [String]
-init args = do
+init :: Maybe String -> IO ()
+init mbMinusB = do
    -- catch ^C
    main_thread <- myThreadId
    putMVar interruptTargetThread [main_thread]
    installSignalHandlers
 
-   -- Grab the -B option if there is one
-   let (minusB_args, argv1) = partition (prefixMatch "-B") args
-   dflags0 <- initSysTools minusB_args defaultDynFlags
+   dflags0 <- initSysTools mbMinusB defaultDynFlags
    writeIORef v_initDynFlags dflags0
 
-   -- Parse the static flags
-   argv2 <- parseStaticFlags argv1
-   return argv2
+-- | Initialises GHC. This must be done /once/ only. Takes the
+-- command-line arguments.  All command-line arguments which aren't
+-- understood by GHC will be returned.
+
+initFromArgs :: [String] -> IO [String]
+initFromArgs args
+    = do init mbMinusB
+         return argv1
+    where -- Grab the -B option if there is one
+          (minusB_args, argv1) = partition (prefixMatch "-B") args
+          mbMinusB | null minusB_args
+                       = Nothing
+                   | otherwise
+                       = Just (drop 2 (last minusB_args))
 
 GLOBAL_VAR(v_initDynFlags, error "initDynFlags", DynFlags)
        -- stores the DynFlags between the call to init and subsequent

diff --git a/ghc/compiler/main/Main.hs b/ghc/compiler/main/Main.hs
index 8d6e30a..ec5a116 100644 (file)
--- a/ghc/compiler/main/Main.hs
+++ b/ghc/compiler/main/Main.hs
@@ -31,7 +31,7 @@ import Config         ( cProjectVersion, cBooterVersion, cProjectName )
 import Packages                ( dumpPackages, initPackages )
 import DriverPhases    ( Phase(..), isSourceFilename, anyHsc,
                          startPhase, isHaskellSrcFilename )
-import StaticFlags     ( staticFlags, v_Ld_inputs )
+import StaticFlags     ( staticFlags, v_Ld_inputs, parseStaticFlags )
 import DynFlags         ( defaultDynFlags )
 import BasicTypes      ( failed )
 import ErrUtils                ( Message, debugTraceMsg, putMsg )
@@ -65,7 +65,7 @@ main =
   GHC.defaultErrorHandler defaultDynFlags $ do
   
   argv0 <- getArgs
-  argv1 <- GHC.init argv0
+  argv1 <- parseStaticFlags =<< GHC.initFromArgs argv0
 
   -- 2. Parse the "mode" flags (--make, --interactive etc.)
   (cli_mode, argv2) <- parseModeFlags argv1

diff --git a/ghc/compiler/main/SysTools.lhs b/ghc/compiler/main/SysTools.lhs
index d6ed737..05153ce 100644 (file)
--- a/ghc/compiler/main/SysTools.lhs
+++ b/ghc/compiler/main/SysTools.lhs
@@ -198,7 +198,7 @@ getTopDir        = readIORef v_TopDir
 %************************************************************************
 
 \begin{code}
-initSysTools :: [String]       -- Command-line arguments starting "-B"
+initSysTools :: Maybe String   -- Maybe TopDir path (without the '-B' prefix)
 
             -> DynFlags
             -> IO DynFlags     -- Set all the mutable variables above, holding 
@@ -207,8 +207,8 @@ initSysTools :: [String]    -- Command-line arguments starting "-B"
                                --      (c) the GHC usage message
 
 
-initSysTools minusB_args dflags
-  = do  { (am_installed, top_dir) <- findTopDir minusB_args
+initSysTools mbMinusB dflags
+  = do  { (am_installed, top_dir) <- findTopDir mbMinusB
        ; writeIORef v_TopDir top_dir
                -- top_dir
                --      for "installed" this is the root of GHC's support files
@@ -399,9 +399,8 @@ foreign import stdcall unsafe "GetTempPathA" getTempPath :: Int -> CString -> IO
 --
 -- Plan of action:
 -- 1. Set proto_top_dir
---     a) look for (the last) -B flag, and use it
---     b) if there are no -B flags, get the directory 
---        where GHC is running (only on Windows)
+--     if there is no given TopDir path, get the directory 
+--     where GHC is running (only on Windows)
 --
 -- 2. If package.conf exists in proto_top_dir, we are running
 --     installed; and TopDir = proto_top_dir
@@ -412,11 +411,11 @@ foreign import stdcall unsafe "GetTempPathA" getTempPath :: Int -> CString -> IO
 --
 -- This is very gruesome indeed
 
-findTopDir :: [String]
-         -> IO (Bool,          -- True <=> am installed, False <=> in-place
-                String)        -- TopDir (in Unix format '/' separated)
+findTopDir :: Maybe String   -- Maybe TopDir path (without the '-B' prefix).
+           -> IO (Bool,      -- True <=> am installed, False <=> in-place
+                  String)    -- TopDir (in Unix format '/' separated)
 
-findTopDir minusbs
+findTopDir mbMinusB
   = do { top_dir <- get_proto
         -- Discover whether we're running in a build tree or in an installation,
        -- by looking for the package configuration file.
@@ -426,15 +425,14 @@ findTopDir minusbs
        }
   where
     -- get_proto returns a Unix-format path (relying on getBaseDir to do so too)
-    get_proto | notNull minusbs
-             = return (normalisePath (drop 2 (last minusbs)))  -- 2 for "-B"
-             | otherwise          
-             = do { maybe_exec_dir <- getBaseDir -- Get directory of executable
-                  ; case maybe_exec_dir of       -- (only works on Windows; 
-                                                 --  returns Nothing on Unix)
-                       Nothing  -> throwDyn (InstallationError "missing -B<dir> option")
-                       Just dir -> return dir
-                  }
+    get_proto = case mbMinusB of
+                  Just minusb -> return (normalisePath minusb)
+                  Nothing
+                      -> do maybe_exec_dir <- getBaseDir -- Get directory of executable
+                           case maybe_exec_dir of       -- (only works on Windows; 
+                                                         --  returns Nothing on Unix)
+                              Nothing  -> throwDyn (InstallationError "missing -B<dir> option")
+                              Just dir -> return dir
 \end{code}