Fix Haddock errors.
[ghc-hetmet.git] / compiler / main / SysTools.lhs
index 9d53b81..3937aa4 100644 (file)
@@ -163,16 +163,14 @@ initSysTools mbMinusB dflags0
         ; let installed, installed_bin :: FilePath -> FilePath
               installed_bin pgm  = top_dir </> pgm
               installed     file = top_dir </> file
-              inplace dir   pgm  = let real_top_dir = foldr (</>) ""
-                                                    $ reverse
-                                                    $ drop 4
-                                                    $ reverse
-                                                    $ splitDirectories top_dir
-                                   in real_top_dir </> dir </> pgm
+              real_top_dir
+               | isWindowsHost = top_dir </> ".." </> ".."
+               | otherwise     = top_dir </> ".."
+              inplace dir   pgm  = real_top_dir </> dir </> pgm
 
         ; let pkgconfig_path
                 | am_installed = installed "package.conf"
-                | otherwise    = inplace cGHC_DRIVER_DIR_REL "package.conf.inplace"
+                | otherwise    = inplace "inplace-datadir" "package.conf"
 
               ghc_usage_msg_path
                 | am_installed = installed "ghc-usage.txt"
@@ -327,11 +325,14 @@ findTopDir :: Maybe String   -- Maybe TopDir path (without the '-B' prefix).
 
 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.
-       ; am_installed <- doesFileExist (top_dir </> "package.conf")
-
-       ; return (am_installed, top_dir)
+       ; exists1 <- doesFileExist (top_dir </> "package.conf")
+       ; exists2 <- doesFileExist (top_dir </> "inplace")
+       ; let amInplace = not exists1 -- On Windows, package.conf doesn't exist
+                                     -- when we are inplace
+                      || exists2 -- On Linux, the presence of inplace signals
+                                 -- that we are inplace
+
+       ; return (not amInplace, top_dir)
        }
   where
     -- get_proto returns a Unix-format path (relying on getBaseDir to do so too)
@@ -524,7 +525,13 @@ copyWithHeader dflags purpose maybe_header from to = do
 
 getExtraViaCOpts :: DynFlags -> IO [String]
 getExtraViaCOpts dflags = do
-  f <- readFile (topDir dflags </> "extra-gcc-opts")
+  (am_installed, top_dir) <- findTopDir (Just (topDir dflags))
+  let top_dir'
+       -- XXX Euch:
+       | isWindowsHost && not am_installed
+          = top_dir </> ".." </> ".." </> "inplace-datadir"
+       | otherwise = top_dir
+  f <- readFile (top_dir' </> "extra-gcc-opts")
   return (words f)
 \end{code}