[project @ 2001-07-05 13:31:09 by sewardj]
[ghc-hetmet.git] / ghc / compiler / main / SysTools.lhs
index ab18451..33ac91c 100644 (file)
@@ -120,6 +120,30 @@ Config.hs contains two sorts of things
                
 
 
+---------------------------------------------
+NOTES for an ALTERNATIVE scheme (i.e *not* what is currently implemented):
+
+Another hair-brained scheme for simplifying the current tool location
+nightmare in GHC: Simon originally suggested using another
+configuration file along the lines of GCC's specs file - which is fine
+except that it means adding code to read yet another configuration
+file.  What I didn't notice is that the current package.conf is
+general enough to do this:
+
+Package
+    {name = "tools",    import_dirs = [],  source_dirs = [],
+     library_dirs = [], hs_libraries = [], extra_libraries = [],
+     include_dirs = [], c_includes = [],   package_deps = [],
+     extra_ghc_opts = ["-pgmc/usr/bin/gcc","-pgml${libdir}/bin/unlit", ... etc.],
+     extra_cc_opts = [], extra_ld_opts = []}
+
+Which would have the advantage that we get to collect together in one
+place the path-specific package stuff with the path-specific tool
+stuff.
+               End of NOTES
+---------------------------------------------
+
+
 %************************************************************************
 %*                                                                     *
 \subsection{Global variables to contain system programs}
@@ -173,7 +197,8 @@ initSysTools minusB_args
                --      for "in-place" it is the root of the build tree
                -- NB: top_dir is assumed to be in standard Unix format '/' separated
 
-       ; let installed_bin pgm   =  pgmPath (top_dir `slash` "bin") pgm
+       ; let installed, installed_bin :: FilePath -> FilePath
+              installed_bin pgm   =  pgmPath (top_dir `slash` "extra-bin") pgm
              installed     file  =  pgmPath top_dir file
              inplace dir   pgm   =  pgmPath (top_dir `slash` dir) pgm
 
@@ -212,15 +237,23 @@ initSysTools minusB_args
        --      so when "installed" we look in TopDir/bin
        -- When "in-place" we look wherever the build-time configure 
        --      script found them
-       ; let cpp_path  | am_installed = installed cRAWCPP
-                       | otherwise    = cRAWCPP
-             gcc_path  | am_installed = installed cGCC
+       -- When "install" we tell gcc where its specs file + exes are (-B)
+       --      and also some places to pick up include files.  We need
+       --      to be careful to put all necessary exes in the -B place
+       --      (as, ld, cc1, etc) since if they don't get found there, gcc
+       --      then tries to run unadorned "as", "ld", etc, and will
+       --      pick up whatever happens to be lying around in the path,
+       --      possibly including those from a cygwin install on the target,
+       --      which is exactly what we're trying to avoid.
+       ; let gcc_path  | am_installed = installed_bin ("gcc -B" ++ installed "lib/gcc-lib/" 
+                                         ++ " -I" ++ installed "include/w32api:" 
+                                                  ++ installed "include/mingw")
                        | otherwise    = cGCC
-             perl_path | am_installed = installed cGHC_PERL
+             perl_path | am_installed = installed_bin cGHC_PERL
                        | otherwise    = cGHC_PERL
 
        -- 'touch' is a GHC util for Windows, and similarly unlit, mangle
-       ; let touch_path  | am_installed = installed cGHC_TOUCHY
+       ; let touch_path  | am_installed = installed_bin cGHC_TOUCHY
                          | otherwise    = inplace cGHC_TOUCHY_DIR cGHC_TOUCHY
 
        -- On Win32 we don't want to rely on #!/bin/perl, so we prepend 
@@ -234,8 +267,7 @@ initSysTools minusB_args
        -- On Unix, the "standard" tools are assumed to be
        -- in the same place whether we are running "in-place" or "installed"
        -- That place is wherever the build-time configure script found them.
-       ; let   cpp_path   = cRAWCPP
-               gcc_path   = cGCC
+       ; let   gcc_path   = cGCC
                touch_path = cGHC_TOUCHY
                mkdll_path = panic "Can't build DLLs on a non-Win32 system"
 
@@ -245,9 +277,11 @@ initSysTools minusB_args
        -- our knowledge of $(PERL) on the host system here.
        ; let split_path  = split_script
              mangle_path = mangle_script
-
 #endif
 
+       -- cpp is derived from gcc on all platforms
+        ; let cpp_path  = gcc_path ++ " -E " ++ cRAWCPP_FLAGS
+
        -- For all systems, copy and remove are provided by the host
        -- system; architecture-specific stuff is done when building Config.hs
        ; let   cp_path = cGHC_CP
@@ -308,7 +342,7 @@ setPgm pgm     = unknownFlagErr ("-pgm" ++ pgm)
 -- 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
+--        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
@@ -324,24 +358,23 @@ getTopDir :: [String]
                 String)        -- TopDir (in Unix format '/' separated)
 
 getTopDir minusbs
-  = do { top_dir1 <- get_proto
-       ; let top_dir2 = unDosifyPath top_dir1  -- Convert to standard internal form
-
-       -- Discover whether we're running in a build tree or in an installation,
+  = 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_dir2 `slash` "package.conf")
+       ; am_installed <- doesFileExist (top_dir `slash` "package.conf")
 
-       ; return (am_installed, top_dir2)
+       ; return (am_installed, top_dir)
        }
   where
-    get_proto | not (null minusbs) 
-             = return (drop 2 (last minusbs))  -- 2 for "-B"
+    -- get_proto returns a Unix-format path
+    get_proto | not (null minusbs)
+             = return (unDosifyPath (drop 2 (last minusbs)))   -- 2 for "-B"
              | otherwise          
              = do { maybe_exec_dir <- getExecDir -- 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 (remove_suffix dir)
+                       Just dir -> return (remove_suffix (unDosifyPath dir))
                   }
 
     -- In an installed tree, the ghc binary lives in $libexecdir, which
@@ -406,14 +439,15 @@ touch purpose arg =  do p <- readIORef v_Pgm_T
                        runSomething purpose p [arg]
 
 copy :: String -> String -> String -> IO ()
-copy purpose from to =
-    (do
-      h <- openFile to WriteMode
-      ls <- readFile from -- inefficient, but it'll do for now.
-                             -- ToDo: speed up via slurping.
-      hPutStrLn h ls
-      hClose h) `catchAllIO`
-                (\_ -> throwDyn (PhaseFailed purpose (ExitFailure 1)))
+copy purpose from to = do
+  verb <- dynFlag verbosity
+  when (verb >= 2) $ hPutStrLn stderr ("*** " ++ purpose)
+
+  h <- openFile to WriteMode
+  ls <- readFile from -- inefficient, but it'll do for now.
+                     -- ToDo: speed up via slurping.
+  hPutStr h ls
+  hClose h
 \end{code}
 
 \begin{code}
@@ -495,9 +529,11 @@ removeTmpFiles verb fs
             ("Deleting: " ++ unwords fs)
             (mapM_ rm fs)
   where
-    rm f = removeFile f `catchAllIO`
-               (\exn -> hPutStrLn stderr ("Warning: deleting non-existent " ++ f) >>
-                        return ())
+    rm f = removeFile f `catchAllIO` 
+               (\_ignored -> 
+                   when (verb >= 2) $
+                     hPutStrLn stderr ("Warning: deleting non-existent " ++ f)
+               )
 
 \end{code}